* merged everything except for version bumps from fixes_3_0 till 37113

  * merged merges into release_3_0_4 after branching (37120:37149)


git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_0_ios@37595 3ad0048d-3df7-0310-abae-a5850022a9f2

688 files changed, 98685 insertions, 11002 deletions

diff --git a/Makefile b/Makefile
index ff44e22c06..56620176a5 100644
--- a/Makefile
+++ b/Makefile
@@ -475,7 +475,7 @@ endif
 endif
 BuildOnlyBaseCPUs=jvm
 ifneq ($(wildcard utils),)
-NOUTILSTARGETS=embedded gba msdos $(BuildOnlyBaseCPUs)
+NOUTILSTARGETS=embedded gba nds msdos $(BuildOnlyBaseCPUs)
 ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
 ifdef BUILDFULLNATIVE
 UTILS=1
diff --git a/Makefile.fpc b/Makefile.fpc
index 2d0d585230..6c7996fdd8 100644
--- a/Makefile.fpc
+++ b/Makefile.fpc
@@ -206,7 +206,7 @@ endif
 BuildOnlyBaseCPUs=jvm
 
 ifneq ($(wildcard utils),)
-NOUTILSTARGETS=embedded gba msdos $(BuildOnlyBaseCPUs)
+NOUTILSTARGETS=embedded gba nds msdos $(BuildOnlyBaseCPUs)
 ifeq ($(findstring $(OS_TARGET),$(NOUTILSTARGETS)),)
 ifdef BUILDFULLNATIVE
 UTILS=1
diff --git a/compiler/COPYING.txt b/compiler/COPYING.txt
index 78bc9dfc53..3b83e3f560 100644
--- a/compiler/COPYING.txt
+++ b/compiler/COPYING.txt
@@ -305,7 +305,7 @@ the "copyright" line and a pointer to where the full notice is found.
 
     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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 
 Also add information on how to contact you by electronic and paper mail.
diff --git a/compiler/Makefile b/compiler/Makefile
index 0f90290e2a..da995621d5 100644
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -557,6 +557,9 @@ endif
 ifeq ($(OS_TARGET),msdos)
 NoNativeBinaries=1
 endif
+ifeq ($(OS_TARGET),nds)
+NoNativeBinaries=1
+endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_DIRS+=utils
 endif
@@ -4146,13 +4149,11 @@ cycle:
 	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR= BINUTILSPREFIX= CROSSCYCLEBOOTSTRAP=1 cycleclean compiler CYCLELEVEL=2
 ifndef CROSSINSTALL
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl CYCLELEVEL=3
-ifneq ($(OS_TARGET),embedded)
-ifneq ($(OS_TARGET),gba)
+ifndef NoNativeBinaries
 	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler CYCLELEVEL=3
 endif
 endif
 endif
-endif
 else
 cycle: override FPC=
 cycle:
diff --git a/compiler/Makefile.fpc b/compiler/Makefile.fpc
index 85af1a757c..5e1dbf51fb 100644
--- a/compiler/Makefile.fpc
+++ b/compiler/Makefile.fpc
@@ -329,6 +329,9 @@ endif
 ifeq ($(OS_TARGET),msdos)
 NoNativeBinaries=1
 endif
+ifeq ($(OS_TARGET),nds)
+NoNativeBinaries=1
+endif
 
 [rules]
 #####################################################################
@@ -688,14 +691,10 @@ cycle:
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl CYCLELEVEL=3
-# building a native compiler for embedded targets is not possible
-ifneq ($(OS_TARGET),embedded)
-# building a native compiler for the arm-gba target is not possible
-ifneq ($(OS_TARGET),gba)
+ifndef NoNativeBinaries
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler CYCLELEVEL=3
 endif
 endif
-endif
 
 endif
 
@@ -721,7 +720,6 @@ cycle:
 # ppc<ARCH> (target native)
 ifndef CROSSINSTALL
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(RTLOPT) $(CROSSOPT)' rtlclean rtl CYCLELEVEL=3
-# building a native compiler for JVM and embedded targets is not possible
 ifndef NoNativeBinaries
         $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(strip $(LOCALOPT) $(CROSSOPT))' cycleclean compiler CYCLELEVEL=3
 endif
diff --git a/compiler/arm/aoptcpu.pas b/compiler/arm/aoptcpu.pas
index 3fc493195b..e015ee9bba 100644
--- a/compiler/arm/aoptcpu.pas
+++ b/compiler/arm/aoptcpu.pas
@@ -2500,13 +2500,14 @@ Implementation
               hp3:=tai(p.Previous);
               hp5:=tai(p.next);
               asml.Remove(p);
-              { if there is a reg. dealloc instruction or address labels (e.g. for GOT-less PIC)
+              { if there is a reg. alloc/dealloc/sync instructions or address labels (e.g. for GOT-less PIC)
                 associated with p, move it together with p }
 
               { before the instruction? }
+              { find reg allocs,deallocs and PIC labels }
               while assigned(hp3) and (hp3.typ<>ait_instruction) do
                 begin
-                  if ( (hp3.typ=ait_regalloc) and (tai_regalloc(hp3).ratype in [ra_dealloc]) and
+                  if ( (hp3.typ=ait_regalloc) and (tai_regalloc(hp3).ratype in [ra_alloc, ra_dealloc]) and
                     RegInInstruction(tai_regalloc(hp3).reg,p) )
                     or ( (hp3.typ=ait_label) and (tai_label(hp3).labsym.typ=AT_ADDR) )
                   then
@@ -2514,7 +2515,7 @@ Implementation
                       hp4:=hp3;
                       hp3:=tai(hp3.Previous);
                       asml.Remove(hp4);
-                      list.Concat(hp4);
+                      list.Insert(hp4);
                     end
                   else
                     hp3:=tai(hp3.Previous);
@@ -2524,9 +2525,10 @@ Implementation
               SwapRegLive(taicpu(p),taicpu(hp1));
 
               { after the instruction? }
+              { find reg deallocs and reg syncs }
               while assigned(hp5) and (hp5.typ<>ait_instruction) do
                 begin
-                  if (hp5.typ=ait_regalloc) and (tai_regalloc(hp5).ratype in [ra_dealloc]) and
+                  if (hp5.typ=ait_regalloc) and (tai_regalloc(hp5).ratype in [ra_dealloc, ra_sync]) and
                     RegInInstruction(tai_regalloc(hp5).reg,p) then
                     begin
                       hp4:=hp5;
diff --git a/compiler/assemble.pas b/compiler/assemble.pas
index f807548ef6..feb007f368 100644
--- a/compiler/assemble.pas
+++ b/compiler/assemble.pas
@@ -1583,7 +1583,7 @@ Implementation
            MaybeNextList(hp);
          end;
         ObjData.afteralloc;
-        { leave if errors have occured }
+        { leave if errors have occurred }
         if errorcount>0 then
          goto doexit;
 
@@ -1604,7 +1604,7 @@ Implementation
         ObjData.createsection(sec_code);
         ObjData.afteralloc;
 
-        { leave if errors have occured }
+        { leave if errors have occurred }
         if errorcount>0 then
          goto doexit;
 
@@ -1625,7 +1625,7 @@ Implementation
         ObjData.createsection(sec_code);
         ObjData.afterwrite;
 
-        { don't write the .o file if errors have occured }
+        { don't write the .o file if errors have occurred }
         if errorcount=0 then
          begin
            { write objectfile }
@@ -1672,7 +1672,7 @@ Implementation
            ObjData.createsection(startsectype);
            TreePass0(hp);
            ObjData.afteralloc;
-           { leave if errors have occured }
+           { leave if errors have occurred }
            if errorcount>0 then
              break;
 
@@ -1684,7 +1684,7 @@ Implementation
            TreePass1(hp);
            ObjData.afteralloc;
 
-           { leave if errors have occured }
+           { leave if errors have occurred }
            if errorcount>0 then
              break;
 
@@ -1697,7 +1697,7 @@ Implementation
            hp:=TreePass2(hp);
            ObjData.afterwrite;
 
-           { leave if errors have occured }
+           { leave if errors have occurred }
            if errorcount>0 then
              break;
 
diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas
index 8e2034590d..142b51948f 100644
--- a/compiler/dbgdwarf.pas
+++ b/compiler/dbgdwarf.pas
@@ -3112,6 +3112,7 @@ implementation
         dbgname: string;
         vardatatype: ttypesym;
         bind: tasmsymbind;
+        lang: tdwarf_source_language;
       begin
         current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo;
         storefilepos:=current_filepos;
@@ -3160,12 +3161,16 @@ implementation
         { address size }
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint)));
 
+        if (ds_dwarf_cpp in current_settings.debugswitches) then
+          lang:=DW_LANG_C_plus_plus
+        else
+          lang:=DW_LANG_Pascal83;
         { first manadatory compilation unit TAG }
         append_entry(DW_TAG_compile_unit,true,[
           DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path+current_module.sourcefiles.get_file(1).name)+#0,
           DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0,
           DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0,
-          DW_AT_language,DW_FORM_data1,DW_LANG_Pascal83,
+          DW_AT_language,DW_FORM_data1,lang,
           DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]);
 
         { reference to line info section }
@@ -3989,8 +3994,16 @@ implementation
 
     procedure TDebugInfoDwarf3.appenddef_formal(list:TAsmList;def: tformaldef);
       begin
-        append_entry(DW_TAG_unspecified_type,false,[
-          ]);
+        if (ds_dwarf_cpp in current_settings.debugswitches) then
+          begin
+            // Do not use DW_TAG_unspecified_type for C++ simulation.
+            // At least LLDB 3.9.0 crashes in such case.
+            // Call the inherited DWARF 2 implementation, which works fine.
+            inherited;
+            exit;
+          end;
+
+        append_entry(DW_TAG_unspecified_type,false,[]);
         finish_entry;
       end;
 
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index a5f84054b4..80c8ac7a77 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -215,7 +215,10 @@ interface
           { for Stabs); not enabled by default, because otherwise once  }
           { support for calling methods has been added to gdb, you'd    }
           { always have to type classinstance.classname__methodname()   }
-          ds_dwarf_method_class_prefix
+          ds_dwarf_method_class_prefix,
+          { Simulate C++ debug information in DWARF. It can be used for }
+          { debuggers, which do not support Pascal.                     }
+          ds_dwarf_cpp
        );
        tdebugswitches = set of tdebugswitch;
 
@@ -327,7 +330,7 @@ interface
        );
 
        DebugSwitchStr : array[tdebugswitch] of string[22] = ('',
-         'DWARFSETS','STABSABSINCLUDES','DWARFMETHODCLASSPREFIX');
+         'DWARFSETS','STABSABSINCLUDES','DWARFMETHODCLASSPREFIX','DWARFCPP');
 
        TargetSwitchStr : array[ttargetswitch] of ttargetswitchinfo = (
          (name: '';                    hasvalue: false; isglobal: true ; define: ''),
diff --git a/compiler/i386/popt386.pas b/compiler/i386/popt386.pas
index 23849b41ff..5a671d5609 100644
--- a/compiler/i386/popt386.pas
+++ b/compiler/i386/popt386.pas
@@ -74,8 +74,12 @@ begin
   UpdateUsedRegs(UsedRegs, tai(p.Next));
   RegUsedAfterInstruction :=
     (supreg in UsedRegs) and
-    (not(getNextInstruction(p,p)) or
-     not(regLoadedWithNewValue(supreg,false,p)));
+    not(regLoadedWithNewValue(supreg,false,p)) and
+    (
+      not(GetNextInstruction(p,p)) or
+      RegReadByInstruction(supreg,p) or
+      not(regLoadedWithNewValue(supreg,false,p))
+    );
 end;
 
 
diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg
index b9b7a3918a..f485204405 100644
--- a/compiler/msg/errore.msg
+++ b/compiler/msg/errore.msg
@@ -3599,6 +3599,7 @@ J*2Cv_Var/out parameter copy-out checking
 *g3godwarfsets_ Enable DWARF 'set' type debug information (breaks gdb < 6.5)
 *g3gostabsabsincludes_ Store absolute/full include file paths in Stabs
 *g3godwarfmethodclassprefix_ Prefix method names in DWARF with class name
+*g3godwarfcpp_ Simulate C++ debug information in DWARF
 *g2gp_Preserve case in stabs symbol names
 *g2gs_Generate Stabs debug information
 *g2gt_Trash local variables (to detect uninitialized uses; multiple 't' changes the trashing value)
diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc
index aad86c43ae..9eb268367e 100644
--- a/compiler/msgtxt.inc
+++ b/compiler/msgtxt.inc
@@ -1223,7 +1223,7 @@ const msgtxt : array[0..000312,1..240] of char=(
   'le "$1"'#000+
   '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPC','DATE] for $F'+
   'PCCPU'#010+
-  'Copyright (c) 1993-2015 by Florian Klaempfl and others'#000+
+  'Copyright (c) 1993-2017 by Florian Klaempfl and others'#000+
   '11024_Free Pascal Compiler version $FPCVERSION'#010+
   #010+
   'Compiler date      : $FPCDATE'#010+
diff --git a/compiler/nadd.pas b/compiler/nadd.pas
index 36c9659981..d3ff790e6b 100644
--- a/compiler/nadd.pas
+++ b/compiler/nadd.pas
@@ -697,8 +697,12 @@ implementation
           an slash expresion would be first converted into a multiplication and later
           folded }
         if (nodetype=slashn) and
-          { do not mess with currency types }
-          (not(is_currency(right.resultdef))) and
+          { do not mess with currency and comp types }
+          (not(is_currency(right.resultdef)) and
+           not((right.resultdef.typ=floatdef) and
+               (tfloatdef(right.resultdef).floattype=s64comp)
+              )
+          ) and
           (((cs_opt_fastmath in current_settings.optimizerswitches) and (rt=ordconstn)) or
            ((cs_opt_fastmath in current_settings.optimizerswitches) and (rt=realconstn) and
             (bestrealrec(trealconstnode(right).value_real).SpecialType in [fsPositive,fsNegative])
diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas
index 9d8e618898..c78468ffba 100644
--- a/compiler/ncgrtti.pas
+++ b/compiler/ncgrtti.pas
@@ -652,6 +652,7 @@ implementation
                write_rtti_reference(def.elementdef,rt);
                { variant type }
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef));
+               maybe_write_align;
                { element type }
                if def.elementdef.needs_inittable then
                  write_rtti_reference(def.elementdef,rt)
diff --git a/compiler/nmem.pas b/compiler/nmem.pas
index 7b1022844d..462af76ddc 100644
--- a/compiler/nmem.pas
+++ b/compiler/nmem.pas
@@ -774,6 +774,10 @@ implementation
     procedure Tsubscriptnode.mark_write;
       begin
         include(flags,nf_write);
+        { if an element of a record is written, then the whole record is changed/it is written to it,
+          for data types being implicit pointers this does not apply as the object itself does not change }
+        if not(is_implicit_pointer_object_type(left.resultdef)) then
+          left.mark_write;
       end;
 
 
@@ -1077,6 +1081,9 @@ implementation
     procedure Tvecnode.mark_write;
       begin
         include(flags,nf_write);
+        { see comment in tsubscriptnode.mark_write }
+        if not(is_implicit_pointer_object_type(left.resultdef)) then
+          left.mark_write;
       end;
 
 
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index d5aee1d6c6..91bbcf7094 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -620,12 +620,12 @@ implementation
         case flag of
           uf_init :
             begin
-              result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
+              result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit$'),potype_unitinit,st);
               result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
             end;
           uf_finalize :
             begin
-              result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
+              result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit$'),potype_unitfinalize,st);
               result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               if (not current_module.is_unit) then
                 result.procdef.aliasnames.insert('PASCALFINALIZE');
@@ -952,7 +952,7 @@ type
                internalerror(200212285);
 
              { Compile the unit }
-             init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
+             init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init$'),potype_unitinit,current_module.localsymtable);
              init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
              init_procinfo.parse_body;
              { save file pos for debuginfo }
@@ -1084,7 +1084,7 @@ type
          if not current_module.interface_only and (token=_FINALIZATION) then
            begin
               { Compile the finalize }
-              finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
+              finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize$'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               finalize_procinfo.parse_body;
            end
@@ -2150,7 +2150,7 @@ type
          if token=_FINALIZATION then
            begin
               { Parse the finalize }
-              finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
+              finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize$'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE');
               finalize_procinfo.parse_body;
diff --git a/compiler/powerpc/agppcmpw.pas b/compiler/powerpc/agppcmpw.pas
index db9f809621..1937f23915 100644
--- a/compiler/powerpc/agppcmpw.pas
+++ b/compiler/powerpc/agppcmpw.pas
@@ -125,7 +125,7 @@ interface
       t32bitarray = array[0..3] of byte;
 
     function ReplaceForbiddenChars(var s: string):Boolean;
-         {Returns wheater a replacement has occured.}
+         {Returns wheater a replacement has occurred.}
 
         var
           i:Integer;
diff --git a/compiler/powerpc/cgcpu.pas b/compiler/powerpc/cgcpu.pas
index a6b55c92e1..657105cabb 100644
--- a/compiler/powerpc/cgcpu.pas
+++ b/compiler/powerpc/cgcpu.pas
@@ -771,7 +771,7 @@ const
      { one.                                                                     }
      { This procedure may be called before, as well as after g_return_from_proc }
      { is called. NOTE registers are not to be allocated through the register   }
-     { allocator here, because the register colouring has already occured !!    }
+     { allocator here, because the register colouring has already occurred !!    }
 
 
      var regcounter,firstregfpu,firstregint: TSuperRegister;
@@ -920,7 +920,7 @@ const
     procedure tcgppc.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean);
      { This procedure may be called before, as well as after g_stackframe_entry }
      { is called. NOTE registers are not to be allocated through the register   }
-     { allocator here, because the register colouring has already occured !!    }
+     { allocator here, because the register colouring has already occurred !!    }
 
       var
          regcounter,firstregfpu,firstregint: TsuperRegister;
diff --git a/compiler/powerpc64/cgcpu.pas b/compiler/powerpc64/cgcpu.pas
index 524936f6c9..6a3268fdcc 100644
--- a/compiler/powerpc64/cgcpu.pas
+++ b/compiler/powerpc64/cgcpu.pas
@@ -1099,7 +1099,7 @@ end;
  called by the current one
 
  IMPORTANT: registers are not to be allocated through the register
- allocator here, because the register colouring has already occured !!
+ allocator here, because the register colouring has already occurred !!
 }
 procedure tcgppc.g_proc_entry(list: TAsmList; localsize: longint;
   nostackframe: boolean);
@@ -1239,7 +1239,7 @@ end;
  is called.
 
  IMPORTANT: registers are not to be allocated through the register
- allocator here, because the register colouring has already occured !!
+ allocator here, because the register colouring has already occurred !!
 }
 procedure tcgppc.g_proc_exit(list: TAsmList; parasize: longint; nostackframe:
   boolean);
diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index 7ca08a031a..a92fc1061e 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -827,7 +827,7 @@ begin
 {$elseif defined(cpu32bitaddr)}
   result:=getlongint;
 {$elseif defined(cpu16bitaddr)}
-  result:=getword;
+  result:=asizeint(getword);
 {$endif}
 {$endif not generic_cpu}
 end;
diff --git a/compiler/script.pas b/compiler/script.pas
index e49b73a113..9285326639 100644
--- a/compiler/script.pas
+++ b/compiler/script.pas
@@ -269,10 +269,10 @@ Begin
   AddStart('@echo off');
   Add('goto end');
   Add(':asmend');
-  Add('echo An error occured while assembling %THEFILE%');
+  Add('echo An error occurred while assembling %THEFILE%');
   Add('goto end');
   Add(':linkend');
-  Add('echo An error occured while linking %THEFILE%');
+  Add('echo An error occurred while linking %THEFILE%');
   Add(':end');
   inherited WriteToDisk;
 end;
@@ -336,11 +336,11 @@ Begin
   Add('skip end');
   Add('lab asmend');
   Add('why');
-  Add('echo An error occured while assembling $THEFILE');
+  Add('echo An error occurred while assembling $THEFILE');
   Add('skip end');
   Add('lab linkend');
   Add('why');
-  Add('echo An error occured while linking $THEFILE');
+  Add('echo An error occurred while linking $THEFILE');
   Add('lab end');
   inherited WriteToDisk;
 end;
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 0ec8e51960..dc7efafa55 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -378,12 +378,14 @@ implementation
     procedure tstoredsymtable.insert(sym:TSymEntry;checkdup:boolean=true);
       begin
         inherited insert(sym,checkdup);
+        init_final_check_done:=false;
       end;
 
 
     procedure tstoredsymtable.delete(sym:TSymEntry);
       begin
         inherited delete(sym);
+        init_final_check_done:=false;
       end;
 
 
@@ -1708,7 +1710,7 @@ implementation
             { iso mode program parameters: staticvarsyms might have the same name as a program parameters,
               in this case, copy the isoindex and make the original symbol invisible }
             else if (m_iso in current_settings.modeswitches) and (hsym.typ=programparasym) and (sym.typ=staticvarsym)
-              and (tstaticvarsym(hsym).isoindex<>0) then
+              and (tprogramparasym(hsym).isoindex<>0) then
               begin
                 HideSym(hsym);
                 tstaticvarsym(sym).isoindex:=tprogramparasym(hsym).isoindex;
diff --git a/compiler/systems/i_morph.pas b/compiler/systems/i_morph.pas
index f86dba0c3b..c8bc5aab90 100644
--- a/compiler/systems/i_morph.pas
+++ b/compiler/systems/i_morph.pas
@@ -66,7 +66,7 @@ unit i_morph;
             link         : ld_none;
             linkextern   : ld_morphos;
             ar           : ar_gnu_ar;
-            res          : res_none;
+            res          : res_elf;
             dbg          : dbg_stabs;
             script       : script_amiga;
             endian       : endian_big;
diff --git a/compiler/systems/t_morph.pas b/compiler/systems/t_morph.pas
index c79d6583f8..e6d410b566 100644
--- a/compiler/systems/t_morph.pas
+++ b/compiler/systems/t_morph.pas
@@ -31,7 +31,7 @@ implementation
 
     uses
        SysUtils,
-       cutils,cfileutl,cclasses,
+       cutils,cfileutl,cclasses,rescmn,comprsrc,
        globtype,globals,systems,verbose,script,fmodule,i_morph,link;
 
     type
@@ -265,4 +265,5 @@ end;
 initialization
   RegisterLinker(ld_morphos,TLinkerMorphOS);
   RegisterTarget(system_powerpc_morphos_info);
+  RegisterRes(res_elf_info, TWinLikeResourceFile);
 end.
diff --git a/installer/install.dat b/installer/install.dat
index 82f02eb594..d31ed9438b 100644
--- a/installer/install.dat
+++ b/installer/install.dat
@@ -142,6 +142,8 @@ package=utils-lexyaccdos.zip[tplydos.zip],Compiler generator for TP and compatib
 package=units-ptcdos.zip[uptcdos.zip],Free portable framebuffer library
 # Dos-2 23
 package=utils-dxegendos.zip[dxegdos.zip],Generation of D~X~E modules loadable at runtime
+# Dos-2 24
+package=ufcl-pdfdos.zip[ufcpddos.zip],PDF generating and TTF file info library
 
 #
 # Win32 packages
@@ -365,6 +367,8 @@ package=utils-pas2fpmos2.zip[p2fmos2.zip],Generate fpmake.pp for Pascal source
 package=utils-pas2jnios2.zip[p2jnos2.zip],Generate JNI bridge for Pascal code
 # OS/2 31
 package=utils-pas2utos2.zip[p2utos2.zip],Pascal source to FPC Unit test generator
+# OS/2 32
+package=ufcl-pdfos2.zip[ufcpdos2.zip],PDF generating and TTF file info library
 
 #
 # OS/2 packages 2nd part
@@ -527,6 +531,8 @@ package=utils-pas2fpmemx.zip[p2fmemx.zip],Generate fpmake.pp for Pascal source
 package=utils-pas2jniemx.zip[p2jnemx.zip],Generate JNI bridge for Pascal code
 # EMX 31
 package=utils-pas2utemx.zip[p2utemx.zip],Pascal source to FPC Unit test generator
+# EMX 32
+package=ufcl-pdfemx.zip[ufcpdemx.zip],PDF generating and TTF file info library
 
 #
 # EMX packages 2nd part
@@ -701,7 +707,7 @@ filecheck=*.source.zip[*src.zip]
 # Source-2 1
 package=units-opengl.source.zip[uoglsrc.zip],OpenGL interface units sources
 # Source-2 2
-package=units-gtk1.source.zip[ugtksrc.zip],GTK1 interface units sources
+package=units-gtk1.source.zip[ugtk1src.zip],GTK1 interface units sources
 # Source-2 3
 package=units-odbc.source.zip[uodbcsrc.zip],ODBC interface units sources
 # Source-2 4
@@ -723,7 +729,7 @@ package=units-os2units.source.zip[uos2src.zip],Units interfacing libraries deliv
 #package=units-clkdll.source.zip[uclksrc.zip],CLKDLL interface unit (eCS 1.1+)
 # Source-2 9
 #package=units-lvm.source.zip[ulvmsrc.zip],OS/2 LVM interface unit sources
-package=units-gtk1.source.zip[ugtk1src.zip],Header to the GTK widgetset (v1)
+package=units-sdl.source.zip[usdlsrc.zip],SDL interface units sources
 # Source-2 10
 package=units-pasjpeg.source.zip[upjpsrc.zip],PasJPEG units sources
 # Source-2 11
@@ -760,6 +766,10 @@ package=fcl-js.source.zip[ufcjssrc.zip],Free Component Library (FCL)-Javascript
 package=units-ptc.source.zip[uptcsrc.zip],Free portable framebuffer library
 # Source-2 27
 package=units-x11.source.zip[ux11src.zip],X Window (X11) interface units
+# Source-2 29
+package=units-fcl-pdf.source.zip[ufcpdsrc.zip],PDF generating and TTF file info library
+# Source-2 30
+package=units-dblib.source.zip,Headers for the MS SQL Server RDBMS
 
 
 #
@@ -802,26 +812,28 @@ package=units-httpd-2.0.source.zip[uhd20src.zip],HTTPD 2.0 interface units sourc
 # Source-3 17
 package=units-httpd-2.2.source.zip[uhd22src.zip],HTTPD 2.2 interface units sources
 # Source-3 18
-package=units-oggvorbis.source.zip[uoggvsrc.zip],OGG Vorbis interface units sources
+package=units-httpd-2.4.source.zip[uhd24src.zip],HTTPD 2.4 interface units sources
 # Source-3 19
-package=units-openal.source.zip[uoalsrc.zip],OpenAL interface units sources
+package=units-oggvorbis.source.zip[uoggvsrc.zip],OGG Vorbis interface units sources
 # Source-3 20
-package=units-openssl.source.zip[uosslsrc.zip],OpenSSL interface units sources
+package=units-openal.source.zip[uoalsrc.zip],OpenAL interface units sources
 # Source-3 21
-package=units-fcl-sound.source.zip[ufsndsrc.zip],Free Component Library (FCL)-sound files sources
+package=units-openssl.source.zip[uosslsrc.zip],OpenSSL interface units sources
 # Source-3 22
-package=units-fcl-sdo.source.zip[ufcsdsrc.zip],Free Component Library (FCL)-Service Data Objects
+package=units-fcl-sound.source.zip[ufsndsrc.zip],Free Component Library (FCL)-sound files sources
 # Source-3 23
-package=units-fcl-stl.source.zip[ufcstsrc.zip],Free Component Library (FCL)-generic container library
+package=units-fcl-sdo.source.zip[ufcsdsrc.zip],Free Component Library (FCL)-Service Data Objects
 # Source-3 24
-package=units-libtar.source.zip[ultarsrc.zip],Unit for .tar file handling
+package=units-fcl-stl.source.zip[ufcstsrc.zip],Free Component Library (FCL)-generic container library
 # Source-3 25
-package=units-rtl-console.source.zip[urtlcsrc.zip],RTL-console abstraction (keyboard, video & mouse)
+package=units-libtar.source.zip[ultarsrc.zip],Unit for .tar file handling
 # Source-3 26
-package=units-rtl-extra.source.zip[urtlesrc.zip],RTL-additional units not needed for bootstrapping
+package=units-rtl-console.source.zip[urtlcsrc.zip],RTL-console abstraction (keyboard, video & mouse)
 # Source-3 27
-package=units-rtl-objpas.source.zip[urtlosrc.zip],RTL-Object Pascal units (e.g. Delphi compatibility)
+package=units-rtl-extra.source.zip[urtlesrc.zip],RTL-additional units not needed for bootstrapping
 # Source-3 28
+package=units-rtl-objpas.source.zip[urtlosrc.zip],RTL-Object Pascal units (e.g. Delphi compatibility)
+# Source-3 29
 package=units-rtl-unicode.source.zip[urtlusrc.zip],RTL-miscellaneous Unicode support units
 
 defaultcfg=
diff --git a/installer/install.pas b/installer/install.pas
index 785bf1f5dc..6ef1a0d52c 100644
--- a/installer/install.pas
+++ b/installer/install.pas
@@ -1331,6 +1331,9 @@ end;
               messagebox('Please, choose the directory for installation first.',nil,mferror+mfokbutton)
             else
              begin
+               Data.BasePath := FExpand (Data.BasePath);
+               if Data.BasePath [Length (Data.BasePath)] = DirSep then
+                 Dec (Data.BasePath [0]);
                found:=false;
                for j:=1 to cfg.packs do
                 if data.packmask[j]>0 then
@@ -1362,9 +1365,7 @@ end;
                     end;
                   WriteLog ('Diskspace needed: ' + DotStr (DSize) + ' Kb');
 
-                  S := FExpand (Data.BasePath);
-                  if S [Length (S)] = DirSep then
-                   Dec (S [0]);
+                  S := Data.BasePath;
                   Space := DiskFree (byte (Upcase(S [1])) - 64);
                   { -1 means that the drive is invalid }
                   if Space=-1 then
diff --git a/packages/ami-extra/fpmake.pp b/packages/ami-extra/fpmake.pp
index 6ab2485724..0534c2969c 100644
--- a/packages/ami-extra/fpmake.pp
+++ b/packages/ami-extra/fpmake.pp
@@ -30,6 +30,8 @@ begin
     P.SourcePath.Add('src');
 
     P.OSes:=AllAmigaLikeOSes;
+    if Defaults.CPU=powerpc then
+      P.OSes:=P.OSes-[amiga];
 
     T:=P.Targets.AddUnit('cliputils.pas');
 
diff --git a/packages/amunits/src/coreunits/amigalib.pas b/packages/amunits/src/coreunits/amigalib.pas
index e0e76f3db3..c67488d0ef 100644
--- a/packages/amunits/src/coreunits/amigalib.pas
+++ b/packages/amunits/src/coreunits/amigalib.pas
@@ -360,12 +360,9 @@ begin
 end;
 
 function DoMethodA(obj : pObject_; msg : APTR): ulong;
-var
-    o : p_Object;
 begin
     if assigned(obj) then begin
-       o := p_Object(obj);
-       DoMethodA := CallHookPkt(@o^.o_Class^.cl_Dispatcher, obj,msg);
+       DoMethodA := CallHookPkt(@THook(OCLASS(obj)^.cl_Dispatcher), obj, msg);
     end else DoMethodA := 0;
 end;
 
diff --git a/packages/aspell/LICENSE b/packages/aspell/LICENSE
index b8f990b7c4..73874bbdb7 100644
--- a/packages/aspell/LICENSE
+++ b/packages/aspell/LICENSE
@@ -464,7 +464,7 @@ convey the exclusion of warranty; and each file should have at least the
 
     You should have received a copy of the GNU Library General Public
     License along with this library; if not, write to the Free
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 Also add information on how to contact you by electronic and paper mail.
 
diff --git a/packages/bfd/src/bfd.pas b/packages/bfd/src/bfd.pas
index 0e6286668b..d266efdc02 100644
--- a/packages/bfd/src/bfd.pas
+++ b/packages/bfd/src/bfd.pas
@@ -52,7 +52,7 @@ 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  *)
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  *)
 
 (* bfd.h -- The only header file required by users of the bfd library
 
diff --git a/packages/bzip2/src/bzip2.pas b/packages/bzip2/src/bzip2.pas
index cbbb62b08d..f2b21cec04 100644
--- a/packages/bzip2/src/bzip2.pas
+++ b/packages/bzip2/src/bzip2.pas
@@ -417,7 +417,7 @@ begin
             end;
           while es>0 do
             begin
-              tt^[t]:=n;
+              tt^[t]:=ntole(cardinal(n));
               dec(es);
               inc(t);
             end;
@@ -462,7 +462,7 @@ begin
                 move_mtf_block;
             end;
           inc(cftab[seq_to_unseq[n]]);
-          tt^[t]:=cardinal(seq_to_unseq[n]);
+          tt^[t]:=ntole(cardinal(seq_to_unseq[n]));
           inc(t);
           if t>100000*blocksize then
             begin
@@ -497,9 +497,9 @@ begin
   q:=p+tt_count;
   while p<>q do
     begin
-      r:=@tt^[cftab[p^ and $ff]];
-      inc(cftab[p^ and $ff]);
-      r^:=r^ or a;
+      r:=@tt^[cftab[ntole(p^) and $ff]];
+      inc(cftab[ntole(p^) and $ff]);
+      r^:=r^ or ntole(a);
       inc(a,256);
       inc(p);
     end;
@@ -567,7 +567,7 @@ procedure Tbzip2_decode_stream.new_block;
 
 begin
   if decode_block then
-    nextrle:=@tt^[tt^[block_origin] shr 8]
+    nextrle:=@tt^[ntole(tt^[block_origin]) shr 8]
   else
     begin
       error(streaderror,bzip2_endoffile);
@@ -582,7 +582,7 @@ procedure Tbzip2_decode_stream.consume_rle;inline;
 
 begin
 {  Pcardinal(nextrle)^:=Pcardinal(nextrle)^ shr 8;}
-  nextrle:=@tt^[Pcardinal(nextrle)^ shr 8];
+  nextrle:=@tt^[ntole(Pcardinal(nextrle)^) shr 8];
   dec(decode_available);
   if decode_available=0 then
     new_block;
@@ -660,7 +660,7 @@ begin
           error(streaderror,bzip2_endoffile);
           nextrle:=nil;
         end;
-      nextrle:=@tt^[tt^[block_origin] shr 8];
+      nextrle:=@tt^[ntole(tt^[block_origin]) shr 8];
     end;
   rle_read(bufptr,count);
 end;
diff --git a/packages/bzip2/src/bzip2stream.pp b/packages/bzip2/src/bzip2stream.pp
index 19b453935e..fa02644632 100644
--- a/packages/bzip2/src/bzip2stream.pp
+++ b/packages/bzip2/src/bzip2stream.pp
@@ -426,7 +426,7 @@ begin
             error(SDecodingError,bzip2_data_error);
           while es>0 do
             begin
-              tt^[t]:=n;
+              tt^[t]:=ntole(cardinal(n));
               dec(es);
               inc(t);
             end;
@@ -471,7 +471,7 @@ begin
                 move_mtf_block;
             end;
           inc(cftab[seq_to_unseq[n]]);
-          tt^[t]:=cardinal(seq_to_unseq[n]);
+          tt^[t]:=ntole(cardinal(seq_to_unseq[n]));
           inc(t);
           if t>100000*blocksize then
             error(SDecodingError,bzip2_data_error);
@@ -503,9 +503,9 @@ begin
   q:=p+tt_count;
   while p<>q do
     begin
-      r:=@tt^[cftab[p^ and $ff]];
-      inc(cftab[p^ and $ff]);
-      r^:=r^ or a;
+      r:=@tt^[cftab[ntole(p^) and $ff]];
+      inc(cftab[ntole(p^) and $ff]);
+      r^:=r^ or ntole(a);
       inc(a,256);
       inc(p);
     end;
@@ -563,7 +563,7 @@ Function TDecompressBzip2Stream.new_block : Boolean;
 begin
   Result:=decode_block;
   If result then
-    nextrle:=@tt^[tt^[block_origin] shr 8]
+    nextrle:=@tt^[ntole(tt^[block_origin]) shr 8]
   else
     nextrle:=nil;
 end;
@@ -575,7 +575,7 @@ Function TDecompressBzip2Stream.consume_rle : Boolean;inline;
 
 begin
 {  Pcardinal(nextrle)^:=Pcardinal(nextrle)^ shr 8;}
-  nextrle:=@tt^[Pcardinal(nextrle)^ shr 8];
+  nextrle:=@tt^[ntole(Pcardinal(nextrle)^) shr 8];
   dec(decode_available);
   if decode_available=0 then
     Result:=new_block
@@ -652,7 +652,7 @@ begin
         nextrle:=nil;
         error(SDecodingError,bzip2_endoffile);
         end;
-      nextrle:=@tt^[tt^[block_origin] shr 8];
+      nextrle:=@tt^[ntole(tt^[block_origin]) shr 8];
     end;
   Result:=rle_read(bufptr,count);
 end;
diff --git a/packages/chm/src/chmfilewriter.pas b/packages/chm/src/chmfilewriter.pas
index 7b6341ae21..29c6e8422c 100644
--- a/packages/chm/src/chmfilewriter.pas
+++ b/packages/chm/src/chmfilewriter.pas
@@ -717,8 +717,8 @@ begin
 end;
 
 const
-   protocols   : array[0..3] of string = ('HTTP:','FTP:','MS-ITS:', 'MAILTO:');
-   protocollen : array[0..3] of integer= ( 5 ,4 ,7, 7);
+   protocols   : array[0..4] of string = ('HTTP:','HTTPS:','FTP:','MS-ITS:', 'MAILTO:');
+   protocollen : array[0..4] of integer= ( 5 ,6, 4 ,7, 7);
 
 function TChmProject.SanitizeURL(const basepath,instring,localpath,localname:string;var outstring:String):Boolean;
 var i,j,len : integer;
@@ -813,7 +813,8 @@ end;
 function scantags(prnt:TDomNode; const localname: string; filelist:TStringlist):TDomNode;
 // Seach first matching tag in siblings
 var chld: TDomNode;
-    s   : ansistring;
+    s,
+    att : ansistring;
     i   : Integer;
 begin
   result:=nil;
@@ -831,6 +832,11 @@ begin
                   //printattributes(chld,'');
                   checkattributes(chld,'HREF',localname,filelist);
                 end;
+              if s='SCRIPT' then
+                begin
+                  //printattributes(chld,'');
+                  checkattributes(chld,'SRC',localname,filelist);
+                end;
              if s='IMG'then
                begin
                   //printattributes(chld,'');
@@ -840,19 +846,24 @@ begin
                begin
                   //printattributes(chld,'');
                   checkattributes(chld,'HREF',localname,filelist);
-                  s := findattribute(chld,'NAME');
+                  att := 'NAME';
+                  s := findattribute(chld, att);
+                  if s = '' then begin
+                     att := 'ID';
+                     s := findattribute(chld, att);
+                  end;
                   if s <> '' then
                     begin
                       i := fAnchorList.IndexOf(localname+'#'+s);
                       if i < 0 then begin
                         fAnchorList.Add(localname+'#'+s);
-                        Error(ChmNote,'New Anchor with name '+s+' found while scanning '+localname,1);
+                        Error(ChmNote,'New Anchor with '+att+' '+s+' found while scanning '+localname,1);
                       end else if fAnchorList.Objects[i] = nil then
-                        Error(chmwarning,'Duplicate anchor definitions with name '+s+' found while scanning '+localname,1)
+                        Error(chmwarning,'Duplicate anchor definitions with '+att+' '+s+' found while scanning '+localname,1)
                       else begin
                         fAnchorList.Objects[i].Free;
                         fAnchorList.Objects[i] := nil;
-                        Error(ChmNote,'Anchor with name '+s+' defined while scanning '+localname,1);
+                        Error(ChmNote,'Anchor with '+att+' '+s+' defined while scanning '+localname,1);
                       end;
                     end;
                 end;
diff --git a/packages/chm/src/paslzxcomp.pas b/packages/chm/src/paslzxcomp.pas
index a771fb7cd6..43be2eb662 100644
--- a/packages/chm/src/paslzxcomp.pas
+++ b/packages/chm/src/paslzxcomp.pas
@@ -61,7 +61,7 @@ uses paslznonslide;
   
       You should have received a copy of the GNU Lesser General Public License
       along with this program; if not, write to the Free Software
-      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+      Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
    }
    type
   PPlzx_data = ^Plzx_data;
diff --git a/packages/dblib/src/dblib.pp b/packages/dblib/src/dblib.pp
index 944ce33772..39f358dd1b 100644
--- a/packages/dblib/src/dblib.pp
+++ b/packages/dblib/src/dblib.pp
@@ -22,6 +22,7 @@
                     7.1 - MS SQL Server 2000 (*default*)
                     7.2 - MS SQL Server 2005
                     7.3 - MS SQL Server 2008
+                    7.4 - MS SQL Server 2012/2014
       tds version can be set using env.var. TDSVER or in freetds.conf or .freetds.conf
 }
 unit dblib;
@@ -59,6 +60,7 @@ const
   DBVERSION_71 = 5;
   DBVERSION_72 = 6;
   DBVERSION_73 = 7;
+  DBVERSION_74 = 8;
 
   //DBTDS_xxx are returned by DBTDS()
   DBTDS_UNKNOWN= 0;
@@ -68,6 +70,7 @@ const
   DBTDS_71     = 9;  // Microsoft SQL Server 2000
   DBTDS_72     = 10; // Microsoft SQL Server 2005
   DBTDS_73     = 11; // Microsoft SQL Server 2008
+  DBTDS_74     = 12; // Microsoft SQL Server 2012/2014
 
   //from sqlfront.h , sybdb.h for FreeTDS
   DBSETHOST=1;
@@ -102,6 +105,9 @@ const
   DBANSItoOEM  = 14;
   DBOEMtoANSI  = 15;
   DBQUOTEDIDENT= {$IFDEF freetds}35{$ELSE}18{$ENDIF};
+  // settings from here are purely FreeTDS extensions:
+  DBSETUTF16   = 1001;
+  DBSETNTLMV2  = 1002;
 
   TIMEOUT_IGNORE=-1;
   TIMEOUT_INFINITE=0;
@@ -173,7 +179,9 @@ const
 
   // Error codes:
   SYBEFCON = 20002;      // SQL Server connection failed
+  SYBEWRIT = 20006;      // Write to SQL Server failed.
   SYBESMSG = 20018;      // General SQL Server error: Check messages from the SQL Server.
+  SYBEDDNE = 20047;      // DBPROCESS is dead or not enabled.
 
 type
   PLOGINREC=Pointer;
@@ -195,6 +203,9 @@ type
   DBSMALLINT=smallint;   // 16-bit int (short)
   DBUSMALLINT=word;      // 16-bit unsigned int (unsigned short)
   DBINT=longint;         // 32-bit int (int)
+  DBUINT=longword;       // 32-bit unsigned int
+  DBBIGINT=int64;        // 64-bit integer
+  DBUBIGINT=qword;       // 64-bit unsigned
   DBFLT8=double;         // 64-bit real (double)
   DBBINARY=byte;
 
@@ -206,9 +217,9 @@ type
   PDBDATETIME=^DBDATETIME;
 
   DBDATETIMEALL=record
-    time: qword;         // time, 7 digit precision (64-bit unsigned)
-    date: longint;       // date, 0 = 1900-01-01 (32-bit int)
-    offset: smallint;    // time offset (16-bit int)
+    time: DBUBIGINT;     // time, 7 digit precision (64-bit unsigned)
+    date: DBINT;         // date, 0 = 1900-01-01 (32-bit int)
+    offset: DBSMALLINT;  // time offset (16-bit int)
     info: word;          // unsigned short time_prec:3;
                          // unsigned short _res:10;
                          // unsigned short has_time:1;
@@ -249,11 +260,27 @@ type
       minute: INT;      // 0 - 59
       second: INT;      // 0 - 59
       millisecond: INT; // 0 - 999
-      tzone: INT;       // 0 - 127 (Sybase only!)
+      tzone: INT;       // -840 - 840
     );
   end;
   PDBDATEREC=^DBDATEREC;
 
+  DBDATEREC2 = record
+    year: DBINT;        // 1753 - 9999
+    quarter: DBINT;     // 1 - 4
+    month: DBINT;       // 1 - 12
+    day: DBINT;         // 1 - 31
+    dayofyear: DBINT;   // 1 - 366
+    week: DBINT;        // 1 - 54 (for leap years)
+    weekday: DBINT;     // 1 - 7 (Mon. - Sun.)
+    hour: DBINT;        // 0 - 23
+    minute: DBINT;      // 0 - 59
+    second: DBINT;      // 0 - 59
+    nanosecond: DBINT;  // 0 - 999999999
+    tzone: DBINT;       // 0 - 127  (Sybase only)
+  end;
+  PDBDATEREC2=^DBDATEREC2;
+
   DBMONEY=record
     mnyhigh: DBINT;
     mnylow: ULONG;
@@ -336,6 +363,7 @@ var
   function dbiscount(dbproc:PDBPROCESS):BOOL; cdecl; external DBLIBDLL;
   function dbcancel(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
   function dbcanquery(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
+  function dbdead(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
   function dbhasretstat(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
   function dbretstatus(dbproc:PDBPROCESS):DBINT; cdecl; external DBLIBDLL;
   procedure dbfreelogin(login:PLOGINREC); cdecl; external DBLIBDLL {$IFDEF freetds}name 'dbloginfree'{$ENDIF};
@@ -385,6 +413,7 @@ var
   dbiscount: function(dbproc:PDBPROCESS):BOOL; cdecl;
   dbcancel: function(dbproc:PDBPROCESS):RETCODE; cdecl;
   dbcanquery: function(dbproc:PDBPROCESS):RETCODE; cdecl;
+  dbdead: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
   dbhasretstat: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
   dbretstatus: function(dbproc:PDBPROCESS):DBINT; cdecl;
   dbexit: procedure(); cdecl;
@@ -396,6 +425,7 @@ var
   {$ENDIF}
   {$IFDEF freetds}
   tdsdbopen: function(login:PLOGINREC; servername:PAnsiChar; msdblib:INT):PDBPROCESS; cdecl;
+  dbanydatecrack: function(dbproc:PDBPROCESS; di: PDBDATEREC2; typ: INT; data: pointer):RETCODE; cdecl;
   dbtablecolinfo: function(dbproc:PDBPROCESS; column:DBINT; dbcol:PDBCOL):RETCODE; cdecl;
   dbtds: function(dbproc:PDBPROCESS):INT; cdecl;
   dbsetlversion: function(login:PLOGINREC; version:BYTE):RETCODE; cdecl;
@@ -484,6 +514,7 @@ begin
    pointer(dbiscount) := GetProcedureAddress(DBLibLibraryHandle,'dbiscount');
    pointer(dbcancel) := GetProcedureAddress(DBLibLibraryHandle,'dbcancel');
    pointer(dbcanquery) := GetProcedureAddress(DBLibLibraryHandle,'dbcanquery');
+   pointer(dbdead) := GetProcedureAddress(DBLibLibraryHandle,'dbdead');
    pointer(dbhasretstat) := GetProcedureAddress(DBLibLibraryHandle,'dbhasretstat');
    pointer(dbretstatus) := GetProcedureAddress(DBLibLibraryHandle,'dbretstatus');
    pointer(dbexit) := GetProcedureAddress(DBLibLibraryHandle,'dbexit');
diff --git a/packages/fcl-base/examples/README.txt b/packages/fcl-base/examples/README.txt
index e6fdb1e2a6..4a89f33250 100644
--- a/packages/fcl-base/examples/README.txt
+++ b/packages/fcl-base/examples/README.txt
@@ -75,3 +75,4 @@ daemon.pp    Test for daemonapp (MVC)
 testtimer.pp Test for TFPTimer (MVC)
 testini.pp   Test/Demo for inifiles, ReadSectionValues.
 contit.pp    Test/Demo for iterators in contnr.pp
+csvbom.pp    Test/Demo for BOM detection in CSV document. (needs databom.txt)
diff --git a/packages/fcl-base/examples/csvbom.pp b/packages/fcl-base/examples/csvbom.pp
new file mode 100644
index 0000000000..a16adf582a
--- /dev/null
+++ b/packages/fcl-base/examples/csvbom.pp
@@ -0,0 +1,53 @@
+program csvbom;
+
+{$APPTYPE Console}
+{$mode objfpc}{$H+}
+
+uses
+  sysutils, classes, dateutils, csvreadwrite;
+
+type
+  TDataRec = record
+    FDate: TDate;
+    FNumber: Integer;
+    FText: String;
+  end;
+
+const
+  FILENAME = 'databom.txt';
+
+var
+  parser: TCSVParser;
+  stream: TFileStream;
+  data: array of TDataRec;
+  s: String;
+  i: Integer;
+begin
+  parser := TCSVParser.Create;
+  try
+    parser.Delimiter := ',';
+    parser.DetectBOM := true;     // uncomment for running with patched version
+    stream := TFileStream.Create(FILENAME, fmOpenRead);
+    parser.SetSource(stream);
+    SetLength(data, 0);
+    while parser.ParseNextCell do begin
+      if parser.CurrentRow > High(data) then
+        SetLength(data, parser.CurrentRow + 1);
+      s := parser.CurrentCellText;
+      case parser.CurrentCol of
+        0: data[High(data)].FDate := ScanDateTime('yyyy-mm-dd', s);
+        1: data[High(data)].FNumber := StrToInt(s);
+        2: data[High(data)].FText := s;
+      end;
+    end;
+
+    for i:=0 to High(data) do
+      WriteLn(DateToStr(data[i].FDate), '; ', data[i].FNumber, '; ', data[i].FText);
+    Writeln('Press enter to quit program');
+    Readln;
+  finally
+    stream.Free;
+    parser.Free;
+  end;
+end.
+
diff --git a/packages/fcl-base/examples/databom.txt b/packages/fcl-base/examples/databom.txt
new file mode 100644
index 0000000000..4316a46865
--- /dev/null
+++ b/packages/fcl-base/examples/databom.txt
@@ -0,0 +1,2 @@
+2016-01-01,100,ABC
+2016-01-02,110,DEF
diff --git a/packages/fcl-base/examples/testapp.pp b/packages/fcl-base/examples/testapp.pp
index b61b834327..625f2bfc42 100644
--- a/packages/fcl-base/examples/testapp.pp
+++ b/packages/fcl-base/examples/testapp.pp
@@ -6,9 +6,9 @@ program testapp;
 uses custapp,classes;
 
 Const
-  ShortOpts = 'abc:d:012';
-  Longopts : Array[1..6] of String = (
-    'add:','append','delete:','verbose','create:','file:');
+  ShortOpts = 'iabc:d:012';
+  Longopts : Array[1..7] of String = (
+    'insensitive','add:','append','delete:','verbose','create:','file:');
 
 Type
   TTestApp = Class(TCustomApplication)
@@ -23,6 +23,7 @@ Var
   Opts,FN,Args : TStrings;
 
 begin
+  CaseSensitiveOptions:=not HasOption('i','insensitive'); 
   Writeln('Exe name            : ',ExeName);
   Writeln('Help file           : ',HelpFile);
   Writeln('Terminated          : ',Terminated);
@@ -60,6 +61,7 @@ begin
     Writeln('Option append found: ',HasOption('append'));
     Writeln('Option a or append found: ',HasOption('a','append'));
     Writeln('-----------------------');
+    Opts.Clear;
     GetEnvironmentList(Opts,True);
     Writeln('Found ',Opts.Count,' environment variables');
     For I:=0 to Opts.Count-1 do
diff --git a/packages/fcl-base/fpmake.pp b/packages/fcl-base/fpmake.pp
index f2c2a48fc6..ce71764ad7 100644
--- a/packages/fcl-base/fpmake.pp
+++ b/packages/fcl-base/fpmake.pp
@@ -124,7 +124,7 @@ begin
       end;
     T:=P.Targets.addUnit('advancedipc.pp');
       T.ResourceStrings:=true;
-    T:=P.Targets.addUnit('advancedsingleinstance.pp');
+    T:=P.Targets.addUnit('advancedsingleinstance.pas');
       T.ResourceStrings:=true;	  
     // Additional sources
     P.Sources.AddSrcFiles('src/win/fclel.*', P.Directory);
diff --git a/packages/fcl-base/src/csvdocument.pp b/packages/fcl-base/src/csvdocument.pp
index b0a6d7006d..d6562411ab 100644
--- a/packages/fcl-base/src/csvdocument.pp
+++ b/packages/fcl-base/src/csvdocument.pp
@@ -32,7 +32,7 @@
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 unit csvdocument;
diff --git a/packages/fcl-base/src/csvreadwrite.pp b/packages/fcl-base/src/csvreadwrite.pp
index 4c68f151ff..0a72e1633d 100644
--- a/packages/fcl-base/src/csvreadwrite.pp
+++ b/packages/fcl-base/src/csvreadwrite.pp
@@ -32,7 +32,7 @@
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 unit csvreadwrite;
@@ -92,12 +92,16 @@ Type
 
   { TCSVParser }
 
+  TCSVByteOrderMark = (bomNone, bomUTF8, bomUTF16LE, bomUTF16BE);
+
   TCSVParser = class(TCSVHandler)
   private
     FFreeStream: Boolean;
     // fields
     FSourceStream: TStream;
     FStrStreamWrapper: TStringStream;
+    FBOM: TCSVByteOrderMark;
+    FDetectBOM: Boolean;
     // parser state
     EndOfFile: Boolean;
     EndOfLine: Boolean;
@@ -140,6 +144,10 @@ Type
     property MaxColCount: Integer read FMaxColCount;
     // Does the parser own the stream ? If true, a previous stream is freed when set or when parser is destroyed.
     Property FreeStream : Boolean Read FFreeStream Write FFreeStream;
+    // Return BOM found in file
+    property BOM: TCSVByteOrderMark read FBOM;
+    // Detect whether a BOM marker is present. If set to True, then BOM can be used to see what BOM marker there was.
+    property DetectBOM: Boolean read FDetectBOM write FDetectBOM default false;
   end;
 
   // Sequential output to CSV stream
@@ -441,9 +449,32 @@ begin
 end;
 
 procedure TCSVParser.ResetParser;
+var
+  b: packed array[0..2] of byte;
+  n: Integer;
 begin
   ClearOutput;
   FSourceStream.Seek(0, soFromBeginning);
+  if FDetectBOM then
+  begin
+    FSourceStream.ReadBuffer(b[0], 3);
+    if (b[0] = $EF) and (b[1] = $BB) and (b[2] = $BF) then begin
+      FBOM := bomUTF8;
+      n := 3;
+    end else
+    if (b[0] = $FE) and (b[1] = $FF) then begin
+      FBOM := bomUTF16BE;
+      n := 2;
+    end else
+    if (b[0] = $FF) and (b[1] = $FE) then begin
+      FBOM := bomUTF16LE;
+      n := 2;
+    end else begin
+      FBOM := bomNone;
+      n := 0;
+    end;
+    FSourceStream.Seek(n, soFromBeginning);
+  end;
   EndOfFile := False;
   NextChar;
 end;
diff --git a/packages/fcl-base/src/custapp.pp b/packages/fcl-base/src/custapp.pp
index d186bac37c..5949233a78 100644
--- a/packages/fcl-base/src/custapp.pp
+++ b/packages/fcl-base/src/custapp.pp
@@ -285,7 +285,7 @@ begin
   except
     On E : Exception do
       Log(etError,Format('Error formatting message "%s" with %d arguments: %s',[Fmt,Length(Args),E.Message]));
-  end  
+  end
 end;
 
 constructor TCustomApplication.Create(AOwner: TComponent);
@@ -362,15 +362,14 @@ end;
 
 procedure TCustomApplication.Terminate;
 begin
-  Terminate(0);
+  Terminate(ExitCode);
 end;
 
 procedure TCustomApplication.Terminate(AExitCode : Integer) ;
 
 begin
   FTerminated:=True;
-  If (AExitCode<>0) then
-    ExitCode:=AExitCode;
+  ExitCode:=AExitCode;
 end;
 
 function TCustomApplication.GetOptionAtIndex(AIndex : Integer; IsLong: Boolean): String;
@@ -597,7 +596,7 @@ begin
     If (Length(O)=0) or (O[1]<>FOptionChar) then
       begin
       If Assigned(NonOpts) then
-        NonOpts.Add(O)
+        NonOpts.Add(O);
       end
     else
       begin
@@ -623,7 +622,7 @@ begin
           If FindLongopt(O) then
             begin
             If HaveArg then
-              AddToResult(Format(SErrNoOptionAllowed,[I,O]))
+              AddToResult(Format(SErrNoOptionAllowed,[I,O]));
             end
           else
             begin // Required argument
@@ -643,23 +642,21 @@ begin
           begin
           HaveArg:=(I<ParamCount) and (Length(ParamStr(I+1))>0) and (ParamStr(I+1)[1]<>FOptionChar);
           UsedArg:=False;
-          If HaveArg then
-            OV:=Paramstr(I+1);
           If Not CaseSensitiveOptions then
             O:=LowerCase(O);
           L:=Length(O);
           J:=2;
           While ((Result='') or AllErrors) and (J<=L) do
             begin
-            P:=Pos(O[J],ShortOptions);
+            P:=Pos(O[J],SO);
             If (P=0) or (O[j]=':') then
               AddToResult(Format(SErrInvalidOption,[I,O[J]]))
             else
               begin
-              If (P<Length(ShortOptions)) and (Shortoptions[P+1]=':') then
+              If (P<Length(SO)) and (SO[P+1]=':') then
                 begin
                 // Required argument
-                If ((P+1)=Length(ShortOptions)) or (Shortoptions[P+2]<>':') Then
+                If ((P+1)=Length(SO)) or (SO[P+2]<>':') Then
                   If (J<L) or not haveArg then // Must be last in multi-opt !!
                     AddToResult(Format(SErrOptionNeeded,[I,O[J]]));
                 O:=O[j]; // O is added to arguments.
@@ -668,10 +665,11 @@ begin
               end;
             Inc(J);
             end;
-          If HaveArg and UsedArg then
+          HaveArg:=HaveArg and UsedArg;
+          If HaveArg then
             begin
             Inc(I); // Skip argument.
-            O:=O[Length(O)]; // O is added to arguments !
+            OV:=Paramstr(I);
             end;
           end;
         If HaveArg and ((Result='') or AllErrors) then
diff --git a/packages/fcl-base/src/fpexprpars.pp b/packages/fcl-base/src/fpexprpars.pp
index 956d026809..5629300690 100644
--- a/packages/fcl-base/src/fpexprpars.pp
+++ b/packages/fcl-base/src/fpexprpars.pp
@@ -27,15 +27,15 @@ Type
   TTokenType = (ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv,
                 ttMul, ttLeft, ttRight, ttLessThanEqual, ttLargerThanEqual,
                 ttunequal, ttNumber, ttString, ttIdentifier,
-                ttComma, ttand, ttOr,ttXor,ttTrue,ttFalse,ttnot,ttif,
-                ttCase,ttEOF);
+                ttComma, ttAnd, ttOr, ttXor, ttTrue, ttFalse, ttNot, ttif,
+                ttCase, ttPower, ttEOF); // keep ttEOF last
 
   TExprFloat = Double;
 
 Const
   ttDelimiters = [ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv,
                   ttMul, ttLeft, ttRight, ttLessThanEqual, ttLargerThanEqual,
-                  ttunequal];
+                  ttunequal, ttPower];
   ttComparisons = [ttLargerThan,ttLessthan,
                    ttLargerThanEqual,ttLessthanEqual,
                    ttEqual,ttUnequal];
@@ -44,6 +44,8 @@ Type
 
   TFPExpressionParser = Class;
   TExprBuiltInManager = Class;
+  TFPExprFunction = Class;
+  TFPExprFunctionClass = Class of TFPExprFunction;
 
   { TFPExpressionScanner }
 
@@ -106,6 +108,10 @@ Type
     Procedure GetNodeValue(var Result : TFPExpressionResult); virtual; abstract;
   Public
     Procedure Check; virtual; abstract;
+    Procedure InitAggregate; virtual;
+    Procedure UpdateAggregate; virtual;
+    Class Function IsAggregate : Boolean; virtual;
+    Function HasAggregate : Boolean; virtual;
     Function NodeType : TResultType; virtual; abstract;
     Function NodeValue : TFPExpressionResult;
     Function AsString : string; virtual; abstract;
@@ -123,6 +129,9 @@ Type
   Public
     Constructor Create(ALeft,ARight : TFPExprNode);
     Destructor Destroy; override;
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    Function HasAggregate : Boolean; override;
     Procedure Check; override;
     Property left : TFPExprNode Read FLeft;
     Property Right : TFPExprNode Read FRight;
@@ -245,6 +254,9 @@ Type
     Procedure GetNodeValue(var Result : TFPExpressionResult); override;
   Public
     Procedure Check; override;
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    Function HasAggregate : Boolean; override;
     Function NodeType : TResultType; override;
     Constructor Create(ACondition,ALeft,ARight : TFPExprNode);
     Destructor destroy; override;
@@ -262,6 +274,9 @@ Type
     Procedure GetNodeValue(var Result : TFPExpressionResult); override;
   Public
     Procedure Check; override;
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    function HasAggregate: Boolean; override;
     Function NodeType : TResultType; override;
     Constructor Create(Args : TExprArgumentArray);
     Destructor destroy; override;
@@ -314,6 +329,16 @@ Type
     Procedure GetNodeValue(var Result : TFPExpressionResult); override;
   end;
 
+  { TFPPowerOperation }
+  TFPPowerOperation = class(TMathOperation)
+  public
+    Procedure Check; override;
+    Function AsString : string ; override;
+    Function NodeType : TResultType; override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult); override;
+  end;
+
+
   { TFPUnaryOperator }
 
   TFPUnaryOperator = Class(TFPExprNode)
@@ -322,6 +347,9 @@ Type
   Public
     Constructor Create(AOperand : TFPExprNode);
     Destructor Destroy; override;
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    Function HasAggregate : Boolean; override;
     Procedure Check; override;
     Property Operand : TFPExprNode Read FOperand;
   end;
@@ -401,14 +429,19 @@ Type
   end;
 
 
-  TIdentifierType = (itVariable,itFunctionCallBack,itFunctionHandler);
+  TIdentifierType = (itVariable,itFunctionCallBack,itFunctionHandler,itFunctionNode);
   TFPExprFunctionCallBack = Procedure (Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
   TFPExprFunctionEvent = Procedure (Var Result : TFPExpressionResult; Const Args : TExprParameterArray) of object;
+  TFPExprVariableCallBack = Procedure (Var Result : TFPExpressionResult; ConstRef AName : ShortString);
+  TFPExprVariableEvent = Procedure (Var Result : TFPExpressionResult; ConstRef AName : ShortString) of Object;
 
   { TFPExprIdentifierDef }
 
   TFPExprIdentifierDef = Class(TCollectionItem)
   private
+    FNodeType: TFPExprFunctionClass;
+    FOnGetVarValue: TFPExprVariableEvent;
+    FOnGetVarValueCB: TFPExprVariableCallBack;
     FStringValue : String;
     FValue : TFPExpressionResult;
     FArgumentTypes: String;
@@ -435,15 +468,18 @@ Type
   Protected
     Procedure CheckResultType(Const AType : TResultType);
     Procedure CheckVariable;
+    Procedure FetchValue;
   Public
     Function ArgumentCount : Integer;
     Procedure Assign(Source : TPersistent); override;
+    Function EventBasedVariable : Boolean; Inline;
     Property AsFloat : TExprFloat Read GetAsFloat Write SetAsFloat;
     Property AsInteger : Int64 Read GetAsInteger Write SetAsInteger;
     Property AsString : String Read GetAsString Write SetAsString;
     Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
     Property AsDateTime : TDateTime Read GetAsDateTime Write SetAsDateTime;
     Property OnGetFunctionValueCallBack : TFPExprFunctionCallBack Read FOnGetValueCB Write FOnGetValueCB;
+    Property OnGetVariableValueCallBack : TFPExprVariableCallBack Read FOnGetVarValueCB Write FOnGetVarValueCB;
   Published
     Property IdentifierType : TIdentifierType Read FIDType Write FIDType;
     Property Name : ShortString Read FName Write SetName;
@@ -451,10 +487,12 @@ Type
     Property ParameterTypes : String Read FArgumentTypes Write SetArgumentTypes;
     Property ResultType : TResultType Read GetResultType Write SetResultType;
     Property OnGetFunctionValue : TFPExprFunctionEvent Read FOnGetValue Write FOnGetValue;
+    Property OnGetVariableValue : TFPExprVariableEvent Read FOnGetVarValue Write FOnGetVarValue;
+    Property NodeType : TFPExprFunctionClass Read FNodeType Write FNodeType;
   end;
 
 
-  TBuiltInCategory = (bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser);
+  TBuiltInCategory = (bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser,bcAggregate);
   TBuiltInCategories = Set of TBuiltInCategory;
 
   { TFPBuiltInExprIdentifierDef }
@@ -482,6 +520,8 @@ Type
     Function IndexOfIdentifier(Const AName : ShortString) : Integer;
     Function FindIdentifier(Const AName : ShortString) : TFPExprIdentifierDef;
     Function IdentifierByName(Const AName : ShortString) : TFPExprIdentifierDef;
+    Function AddVariable(Const AName : ShortString; AResultType : TResultType; ACallback : TFPExprVariableCallBack) : TFPExprIdentifierDef;
+    Function AddVariable(Const AName : ShortString; AResultType : TResultType; ACallback : TFPExprVariableEvent) : TFPExprIdentifierDef;
     Function AddVariable(Const AName : ShortString; AResultType : TResultType; AValue : String) : TFPExprIdentifierDef;
     Function AddBooleanVariable(Const AName : ShortString; AValue : Boolean) : TFPExprIdentifierDef;
     Function AddIntegerVariable(Const AName : ShortString; AValue : Integer) : TFPExprIdentifierDef;
@@ -490,6 +530,7 @@ Type
     Function AddDateTimeVariable(Const AName : ShortString; AValue : TDateTime) : TFPExprIdentifierDef;
     Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPExprIdentifierDef;
     Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionEvent) : TFPExprIdentifierDef;
+    Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ANodeClass : TFPExprFunctionClass) : TFPExprIdentifierDef;
     property Identifiers[AIndex : Integer] : TFPExprIdentifierDef Read GetI Write SetI; Default;
   end;
 
@@ -531,6 +572,62 @@ Type
     Function AsString : String; override;
   end;
 
+  { TAggregateExpr }
+
+  TAggregateExpr = Class(TFPExprFunction)
+  Protected
+    FResult : TFPExpressionResult;
+    Class Function IsAggregate : Boolean; override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
+  end;
+
+  { TAggregateMin }
+
+  TAggregateMin = Class(TAggregateExpr)
+  Public
+    FFirst: Boolean;
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+  end;
+
+  { TAggregateMax }
+
+  TAggregateMax = Class(TAggregateExpr)
+  Public
+    FFirst: Boolean;
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+  end;
+
+  { TAggregateSum }
+
+  TAggregateSum = Class(TAggregateExpr)
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+  end;
+
+  { TAggregateAvg }
+
+  TAggregateAvg = Class(TAggregateSum)
+  Protected
+    FCount : Integer;
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
+  end;
+
+  { TAggregateCount }
+
+  TAggregateCount = Class(TAggregateExpr)
+  Public
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+  end;
+
   { TFPFunctionCallBack }
 
   TFPFunctionCallBack = Class(TFPExprFunction)
@@ -586,6 +683,7 @@ Type
     Function Level4 : TFPExprNode;
     Function Level5 : TFPExprNode;
     Function Level6 : TFPExprNode;
+    Function Level7 : TFPExprNode;
     Function Primitive : TFPExprNode;
     function GetToken: TTokenType;
     Function TokenType : TTokenType;
@@ -600,8 +698,12 @@ Type
     Function IdentifierByName(const AName : ShortString) : TFPExprIdentifierDef; virtual;
     Procedure Clear;
     Procedure EvaluateExpression(Var Result : TFPExpressionResult);
+    function ExtractNode(var N: TFPExprNode): Boolean;
     Function Evaluate : TFPExpressionResult;
     Function ResultType : TResultType;
+    Function HasAggregate : Boolean;
+    Procedure InitAggregate;
+    Procedure UpdateAggregate;
     Property AsFloat : TExprFloat Read GetAsFloat;
     Property AsInteger : Int64 Read GetAsInteger;
     Property AsString : String Read GetAsString;
@@ -637,22 +739,23 @@ Type
     Function AddDateTimeVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : TDateTime) : TFPBuiltInExprIdentifierDef;
     Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPBuiltInExprIdentifierDef;
     Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionEvent) : TFPBuiltInExprIdentifierDef;
+    Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ANodeClass : TFPExprFunctionClass) : TFPBuiltInExprIdentifierDef;
     Property IdentifierCount : Integer Read GetCount;
     Property Identifiers[AIndex : Integer] :TFPBuiltInExprIdentifierDef Read GetI;
   end;
 
   EExprParser = Class(Exception);
 
+Const
+  AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser,bcAggregate];
 
 Function TokenName (AToken : TTokenType) : String;
 Function ResultTypeName (AResult : TResultType) : String;
 Function CharToResultType(C : Char) : TResultType;
 Function BuiltinIdentifiers : TExprBuiltInManager;
-Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
+Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager; Categories : TBuiltInCategories = AllBuiltIns);
 function ArgToFloat(Arg: TFPExpressionResult): TExprFloat;
 
-Const
-  AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser];
 
 
 implementation
@@ -667,9 +770,9 @@ const
 
   Digits        = ['0'..'9','.'];
   WhiteSpace    = [' ',#13,#10,#9];
-  Operators     = ['+','-','<','>','=','/','*'];
+  Operators     = ['+','-','<','>','=','/','*','^'];
   Delimiters    = Operators+[',','(',')'];
-  Symbols       = ['%','^']+Delimiters;
+  Symbols       = ['%']+Delimiters;
   WordDelimiters = WhiteSpace + Symbols;
 
 Resourcestring
@@ -689,6 +792,7 @@ Resourcestring
   SErrCommaExpected =  'Expected comma (,) at position %d, but got %s';
   SErrInvalidNumberChar = 'Unexpected character in number : %s';
   SErrInvalidNumber = 'Invalid numerical value : %s';
+  SErrUnterminatedIdentifier = 'Unterminated quoted identifier: %s';
   SErrNoOperand = 'No operand for unary operation %s';
   SErrNoleftOperand = 'No left operand for binary operation %s';
   SErrNoRightOperand = 'No right operand for binary operation %s';
@@ -727,13 +831,13 @@ begin
   Raise EExprParser.CreateFmt(Fmt,Args);
 end;
 
-Function TokenName (AToken : TTokenType) : String;
+function TokenName(AToken: TTokenType): String;
 
 begin
   Result:=GetEnumName(TypeInfo(TTokenType),Ord(AToken));
 end;
 
-Function ResultTypeName (AResult : TResultType) : String;
+function ResultTypeName(AResult: TResultType): String;
 
 begin
   Result:=GetEnumName(TypeInfo(TResultType),Ord(AResult));
@@ -755,7 +859,7 @@ end;
 Var
   BuiltIns : TExprBuiltInManager;
 
-Function BuiltinIdentifiers : TExprBuiltInManager;
+function BuiltinIdentifiers: TExprBuiltInManager;
 
 begin
   If (BuiltIns=Nil) then
@@ -769,6 +873,157 @@ begin
   FreeAndNil(Builtins);
 end;
 
+{ TAggregateMax }
+
+procedure TAggregateMax.InitAggregate;
+begin
+  inherited InitAggregate;
+  FFirst:=True;
+  FResult.ResultType:=rtFloat;
+  FResult.resFloat:=0;
+end;
+
+procedure TAggregateMax.UpdateAggregate;
+
+Var
+  OK : Boolean;
+  N : TFPExpressionResult;
+
+begin
+  FArgumentNodes[0].GetNodeValue(N);
+  if FFirst then
+    begin
+    FFirst:=False;
+    OK:=True;
+    end
+  else
+    Case N.ResultType of
+      rtFloat: OK:=N.ResFloat>FResult.ResFloat;
+      rtinteger: OK:=N.ResInteger>FResult.ResFloat;
+    end;
+  if OK then
+    Case N.ResultType of
+      rtFloat: FResult.ResFloat:=N.ResFloat;
+      rtinteger: FResult.ResFloat:=N.ResInteger;
+    end;
+end;
+
+{ TAggregateMin }
+
+procedure TAggregateMin.InitAggregate;
+begin
+  inherited InitAggregate;
+  FFirst:=True;
+  FResult.ResultType:=rtFloat;
+  FResult.resFloat:=0;
+end;
+
+procedure TAggregateMin.UpdateAggregate;
+
+Var
+  OK : Boolean;
+  N : TFPExpressionResult;
+
+begin
+  FArgumentNodes[0].GetNodeValue(N);
+  if FFirst then
+    begin
+    FResult.ResultType:=N.ResultType;
+    FFirst:=False;
+    OK:=True;
+    end
+  else
+    Case N.ResultType of
+      rtFloat: OK:=N.ResFloat<FResult.ResFloat;
+      rtinteger: OK:=N.ResInteger<FResult.ResFloat;
+    end;
+  if OK then
+    Case FResult.ResultType of
+      rtFloat: FResult.ResFloat:=N.ResFloat;
+      rtinteger: FResult.ResFloat:=N.ResInteger;
+    end;
+  inherited UpdateAggregate;
+end;
+
+{ TAggregateAvg }
+
+procedure TAggregateAvg.InitAggregate;
+begin
+  inherited InitAggregate;
+  FCount:=0;
+end;
+
+procedure TAggregateAvg.UpdateAggregate;
+begin
+  inherited UpdateAggregate;
+  Inc(FCount);
+end;
+
+procedure TAggregateAvg.GetNodeValue(var Result: TFPExpressionResult);
+begin
+  inherited GetNodeValue(Result);
+  Result.ResultType:=rtFloat;
+  if FCount=0 then
+    Result.ResFloat:=0
+  else
+    Case FResult.ResultType of
+      rtInteger:
+        Result.ResFloat:=FResult.ResInteger/FCount;
+      rtFloat:
+        Result.ResFloat:=FResult.ResFloat/FCount;
+    end;
+end;
+
+{ TAggregateCount }
+
+procedure TAggregateCount.InitAggregate;
+begin
+  FResult.ResultType:=rtInteger;
+  FResult.ResInteger:=0;
+end;
+
+procedure TAggregateCount.UpdateAggregate;
+begin
+  Inc(FResult.ResInteger);
+end;
+
+{ TAggregateExpr }
+
+class function TAggregateExpr.IsAggregate: Boolean;
+begin
+  Result:=True;
+end;
+
+procedure TAggregateExpr.GetNodeValue(var Result: TFPExpressionResult);
+begin
+  Result:=FResult;
+end;
+
+{ TAggregateSum }
+
+
+procedure TAggregateSum.InitAggregate;
+begin
+  FResult.ResultType:=FArgumentNodes[0].NodeType;
+  Case FResult.ResultType of
+    rtFloat: FResult.ResFloat:=0.0;
+    rtinteger: FResult.ResInteger:=0;
+  end;
+end;
+
+procedure TAggregateSum.UpdateAggregate;
+
+Var
+  R : TFPExpressionResult;
+
+begin
+  FArgumentNodes[0].GetNodeValue(R);
+  Case FResult.ResultType of
+    rtFloat: FResult.ResFloat:=FResult.ResFloat+R.ResFloat;
+    rtinteger: FResult.ResInteger:=FResult.ResInteger+R.ResInteger;
+  end;
+end;
+
 { ---------------------------------------------------------------------
   TFPExpressionScanner
   ---------------------------------------------------------------------}
@@ -863,6 +1118,7 @@ begin
       '(' : Result := ttLeft;
       ')' : Result := ttRight;
       ',' : Result := ttComma;
+      '^' : Result := ttPower;
     else
       ScanError(Format(SUnknownDelimiter,[D]));
     end;
@@ -925,7 +1181,7 @@ Var
 begin
   C:=CurrentChar;
   prevC := #0;
-  while (not IsWordDelim(C) or (prevC='E')) and (C<>cNull) do
+  while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do
     begin
     If Not ( IsDigit(C)
              or ((FToken<>'') and (Upcase(C)='E'))
@@ -952,7 +1208,19 @@ begin
   C:=CurrentChar;
   while (not IsWordDelim(C)) and (C<>cNull) do
     begin
-    FToken:=FToken+C;
+    if (C<>'"') then
+      FToken:=FToken+C
+    else
+      begin
+      C:=NextPos;
+      While Not (C in [cNull,'"']) do
+        begin
+        FToken:=FToken+C;
+        C:=NextPos;
+        end;
+      if (C<>'"') then
+        ScanError(Format(SErrUnterminatedIdentifier,[FToken]));
+      end;
     C:=NextPos;
     end;
   S:=LowerCase(Token);
@@ -993,7 +1261,7 @@ begin
     Result:=DoString
   else if IsDigit(C) then
     Result:=DoNumber
-  else if IsAlpha(C) then
+  else if IsAlpha(C) or (C='"') then
     Result:=DoIdentifier
   else
     ScanError(Format(SErrUnknownCharacter,[FPos,C]))  ;
@@ -1004,7 +1272,7 @@ end;
   TFPExpressionParser
   ---------------------------------------------------------------------}
 
-Function TFPExpressionParser.TokenType : TTokenType;
+function TFPExpressionParser.TokenType: TTokenType;
 
 begin
   Result:=FScanner.TokenType;
@@ -1075,13 +1343,13 @@ begin
   inherited Destroy;
 end;
 
-Function TFPExpressionParser.GetToken : TTokenType;
+function TFPExpressionParser.GetToken: TTokenType;
 
 begin
   Result:=FScanner.GetToken;
 end;
 
-Procedure TFPExpressionParser.CheckEOF;
+procedure TFPExpressionParser.CheckEOF;
 
 begin
   If (TokenType=ttEOF) then
@@ -1103,14 +1371,23 @@ begin
   FExprNode.GetNodeValue(Result);
 end;
 
+function TFPExpressionParser.ExtractNode(Var N : TFPExprNode) : Boolean;
+begin
+  Result:=Assigned(FExprNode);
+  if Result then
+    begin
+    N:=FExprNode;
+    FExprNode:=Nil;
+    FExpression:='';
+    end;
+end;
+
 procedure TFPExpressionParser.ParserError(Msg: String);
 begin
   Raise EExprParser.Create(Msg);
 end;
 
 function TFPExpressionParser.ConvertNode(Todo : TFPExprNode; ToType : TResultType): TFPExprNode;
-
-
 begin
   Result:=ToDo;
   Case ToDo.NodeType of
@@ -1214,7 +1491,7 @@ end;
   if the result types differ, they are converted to a common type if possible.
 }
 
-Procedure TFPExpressionParser.CheckNodes(Var Left,Right : TFPExprNode);
+procedure TFPExpressionParser.CheckNodes(var Left, Right: TFPExprNode);
 
 begin
   Left:=MatchNodes(Left,Right);
@@ -1228,7 +1505,7 @@ begin
   FDirty:=True;
 end;
 
-Function TFPExpressionParser.Level1 : TFPExprNode;
+function TFPExpressionParser.Level1: TFPExprNode;
 
 var
   tt: TTokenType;
@@ -1379,8 +1656,28 @@ begin
 end;
 
 function TFPExpressionParser.Level6: TFPExprNode;
+var
+  right: TFPExprNode;
 begin
-{$ifdef debugexpr}  Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
+{$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
+  Result := Level7;
+  try
+    while (TokenType = ttPower) do
+    begin
+      GetToken;
+      right := Level5;           // Accept '(', unary '+', '-' as next tokens
+      CheckNodes(Result, right);
+      Result := TFPPowerOperation.Create(Result, right);
+    end;
+  except
+    Result.Free;
+    Raise;
+  end;
+end;
+
+function TFPExpressionParser.Level7: TFPExprNode;
+begin
+{$ifdef debugexpr}  Writeln('Level 7 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
   if (TokenType=ttLeft) then
     begin
     GetToken;
@@ -1448,7 +1745,7 @@ begin
       ACount:=3
     else if IfC then
       ACount:=-4
-    else if (ID.IdentifierType in [itFunctionCallBack,itFunctionHandler]) then
+    else if (ID.IdentifierType in [itFunctionCallBack,itFunctionHandler,itFunctionNode]) then
       ACount:=ID.ArgumentCount
     else
       ACount:=0;
@@ -1500,6 +1797,7 @@ begin
         itVariable         : Result:= TFPExprVariable.CreateIdentifier(ID);
         itFunctionCallBack : Result:= TFPFunctionCallback.CreateFunction(ID,Args);
         itFunctionHandler  : Result:= TFPFunctionEventHandler.CreateFunction(ID,Args);
+        itFunctionNode     : Result:= ID.NodeType.CreateFunction(ID,Args);
       end;
     end;
   GetToken;
@@ -1547,7 +1845,24 @@ function TFPExpressionParser.ResultType: TResultType;
 begin
   if not Assigned(FExprNode) then
     ParserError(SErrInExpression);
-  Result:=FExprNode.NodeType;;
+  Result:=FExprNode.NodeType;
+end;
+
+function TFPExpressionParser.HasAggregate: Boolean;
+begin
+  Result:=Assigned(FExprNode) and FExprNode.HasAggregate;
+end;
+
+procedure TFPExpressionParser.InitAggregate;
+begin
+  If Assigned(FExprNode) then
+    FExprNode.InitAggregate;
+end;
+
+procedure TFPExpressionParser.UpdateAggregate;
+begin
+  If Assigned(FExprNode) then
+    FExprNode.UpdateAggregate;
 end;
 
 { ---------------------------------------------------------------------
@@ -1601,7 +1916,29 @@ begin
     RaiseParserError(SErrUnknownIdentifier,[AName]);
 end;
 
-function TFPExprIdentifierDefs.AddVariable(Const AName: ShortString;
+function TFPExprIdentifierDefs.AddVariable(const AName: ShortString;
+  AResultType: TResultType; ACallback: TFPExprVariableCallBack
+  ): TFPExprIdentifierDef;
+begin
+  Result:=Add as TFPExprIdentifierDef;
+  Result.IdentifierType:=itVariable;
+  Result.Name:=AName;
+  Result.ResultType:=AResultType;
+  Result.OnGetVariableValueCallBack:=ACallBack
+end;
+
+function TFPExprIdentifierDefs.AddVariable(const AName: ShortString;
+  AResultType: TResultType; ACallback: TFPExprVariableEvent
+  ): TFPExprIdentifierDef;
+begin
+  Result:=Add as TFPExprIdentifierDef;
+  Result.IdentifierType:=itVariable;
+  Result.Name:=AName;
+  Result.ResultType:=AResultType;
+  Result.OnGetVariableValue:=ACallBack
+end;
+
+function TFPExprIdentifierDefs.AddVariable(const AName: ShortString;
   AResultType: TResultType; AValue: String): TFPExprIdentifierDef;
 begin
   Result:=Add as TFPExprIdentifierDef;
@@ -1611,8 +1948,8 @@ begin
   Result.Value:=AValue;
 end;
 
-function TFPExprIdentifierDefs.AddBooleanVariable(Const AName: ShortString; AValue: Boolean
-  ): TFPExprIdentifierDef;
+function TFPExprIdentifierDefs.AddBooleanVariable(const AName: ShortString;
+  AValue: Boolean): TFPExprIdentifierDef;
 begin
   Result:=Add as TFPExprIdentifierDef;
   Result.IdentifierType:=itVariable;
@@ -1621,8 +1958,8 @@ begin
   Result.FValue.ResBoolean:=AValue;
 end;
 
-function TFPExprIdentifierDefs.AddIntegerVariable(Const AName: ShortString; AValue: Integer
-  ): TFPExprIdentifierDef;
+function TFPExprIdentifierDefs.AddIntegerVariable(const AName: ShortString;
+  AValue: Integer): TFPExprIdentifierDef;
 begin
   Result:=Add as TFPExprIdentifierDef;
   Result.IdentifierType:=itVariable;
@@ -1631,8 +1968,8 @@ begin
   Result.FValue.ResInteger:=AValue;
 end;
 
-function TFPExprIdentifierDefs.AddFloatVariable(Const AName: ShortString; AValue: TExprFloat
-  ): TFPExprIdentifierDef;
+function TFPExprIdentifierDefs.AddFloatVariable(const AName: ShortString;
+  AValue: TExprFloat): TFPExprIdentifierDef;
 begin
   Result:=Add as TFPExprIdentifierDef;
   Result.IdentifierType:=itVariable;
@@ -1641,8 +1978,8 @@ begin
   Result.FValue.ResFloat:=AValue;
 end;
 
-function TFPExprIdentifierDefs.AddStringVariable(Const AName: ShortString; AValue: String
-  ): TFPExprIdentifierDef;
+function TFPExprIdentifierDefs.AddStringVariable(const AName: ShortString;
+  AValue: String): TFPExprIdentifierDef;
 begin
   Result:=Add as TFPExprIdentifierDef;
   Result.IdentifierType:=itVariable;
@@ -1651,8 +1988,8 @@ begin
   Result.FValue.ResString:=AValue;
 end;
 
-function TFPExprIdentifierDefs.AddDateTimeVariable(Const AName: ShortString; AValue: TDateTime
-  ): TFPExprIdentifierDef;
+function TFPExprIdentifierDefs.AddDateTimeVariable(const AName: ShortString;
+  AValue: TDateTime): TFPExprIdentifierDef;
 begin
   Result:=Add as TFPExprIdentifierDef;
   Result.IdentifierType:=itVariable;
@@ -1685,6 +2022,18 @@ begin
   Result.FOnGetValue:=ACallBack;
 end;
 
+function TFPExprIdentifierDefs.AddFunction(const AName: ShortString;
+  const AResultType: Char; const AParamTypes: String;
+  ANodeClass: TFPExprFunctionClass): TFPExprIdentifierDef;
+begin
+  Result:=Add as TFPExprIdentifierDef;
+  Result.Name:=Aname;
+  Result.IdentifierType:=itFunctionNode;
+  Result.ParameterTypes:=AParamTypes;
+  Result.ResultType:=CharToResultType(AResultType);
+  Result.FNodeType:=ANodeClass;
+end;
+
 { ---------------------------------------------------------------------
   TFPExprIdentifierDef
   ---------------------------------------------------------------------}
@@ -1739,6 +2088,8 @@ procedure TFPExprIdentifierDef.CheckVariable;
 begin
   If Identifiertype<>itvariable then
     RaiseParserError(SErrNotVariable,[Name]);
+  if EventBasedVariable then
+    FetchValue;
 end;
 
 function TFPExprIdentifierDef.ArgumentCount: Integer;
@@ -1762,6 +2113,8 @@ begin
     FName:=EID.FName;
     FOnGetValue:=EID.FOnGetValue;
     FOnGetValueCB:=EID.FOnGetValueCB;
+    FOnGetVarValue:=EID.FOnGetVarValue;
+    FOnGetVarValueCB:=EID.FOnGetVarValueCB;
     end
   else
     inherited Assign(Source);
@@ -1828,6 +2181,46 @@ begin
   end;
 end;
 
+procedure TFPExprIdentifierDef.FetchValue;
+
+Var
+  RT,RT2 : TResultType;
+  I : Integer;
+
+begin
+  RT:=FValue.ResultType;
+  if Assigned(FOnGetVarValue) then
+    FOnGetVarValue(FValue,FName)
+  else
+    FOnGetVarValueCB(FValue,FName);
+  RT2:=FValue.ResultType;
+  if RT2<>RT then
+    begin
+    // Automatically convert integer to float.
+    if (rt2=rtInteger) and (rt=rtFLoat) then
+      begin
+      FValue.ResultType:=RT;
+      I:=FValue.resInteger;
+      FValue.resFloat:=I;
+      end
+    else
+      begin
+      // Restore
+      FValue.ResultType:=RT;
+      Raise EExprParser.CreateFmt('Value handler for variable %s returned wrong type, expected "%s", got "%s"',[
+        FName,
+        GetEnumName(TypeInfo(TResultType),Ord(rt)),
+        GetEnumName(TypeInfo(TResultType),Ord(rt2))
+        ]);
+      end;
+    end;
+end;
+
+function TFPExprIdentifierDef.EventBasedVariable: Boolean;
+begin
+  Result:=Assigned(FOnGetVarValue) or Assigned(FOnGetVarValueCB);
+end;
+
 function TFPExprIdentifierDef.GetResultType: TResultType;
 begin
   Result:=FValue.ResultType;
@@ -1977,6 +2370,14 @@ begin
   Result.Category:=ACategory;
 end;
 
+function TExprBuiltInManager.AddFunction(const ACategory: TBuiltInCategory;
+  const AName: ShortString; const AResultType: Char; const AParamTypes: String;
+  ANodeClass: TFPExprFunctionClass): TFPBuiltInExprIdentifierDef;
+begin
+  Result:=TFPBuiltInExprIdentifierDef(FDefs.AddFunction(AName,AResultType,AParamTypes,ANodeClass));
+  Result. Category:=ACategory;
+end;
+
 
 { ---------------------------------------------------------------------
   Various Nodes
@@ -2010,6 +2411,33 @@ begin
   inherited Destroy;
 end;
 
+procedure TFPBinaryOperation.InitAggregate;
+begin
+  inherited InitAggregate;
+  if Assigned(Left) then
+    Left.InitAggregate;
+  if Assigned(Right) then
+    Right.InitAggregate;
+end;
+
+procedure TFPBinaryOperation.UpdateAggregate;
+begin
+  inherited UpdateAggregate;
+  if Assigned(Left) then
+    Left.UpdateAggregate;
+  if Assigned(Right) then
+    Right.UpdateAggregate;
+end;
+
+function TFPBinaryOperation.HasAggregate: Boolean;
+begin
+  Result:=inherited HasAggregate;
+  if Assigned(Left) then
+    Result:=Result or Left.HasAggregate;
+  if Assigned(Right) then
+    Result:=Result or Right.HasAggregate;
+end;
+
 procedure TFPBinaryOperation.Check;
 begin
   If Not Assigned(Left) then
@@ -2031,6 +2459,28 @@ begin
   inherited Destroy;
 end;
 
+procedure TFPUnaryOperator.InitAggregate;
+begin
+  inherited InitAggregate;
+  if Assigned(FOperand) then
+    FOperand.InitAggregate;
+
+end;
+
+procedure TFPUnaryOperator.UpdateAggregate;
+begin
+  inherited UpdateAggregate;
+  if Assigned(FOperand) then
+    FOperand.UpdateAggregate;
+end;
+
+function TFPUnaryOperator.HasAggregate: Boolean;
+begin
+  Result:=inherited HasAggregate;
+  if Assigned(FOperand) then
+    Result:=Result or FOperand.HasAggregate;
+end;
+
 procedure TFPUnaryOperator.Check;
 begin
   If Not Assigned(Operand) then
@@ -2184,6 +2634,26 @@ begin
     end;
 end;
 
+procedure TFPExprNode.InitAggregate;
+begin
+  // Do nothing
+end;
+
+procedure TFPExprNode.UpdateAggregate;
+begin
+  // Do nothing
+end;
+
+function TFPExprNode.HasAggregate: Boolean;
+begin
+  Result:=IsAggregate;
+end;
+
+class function TFPExprNode.IsAggregate: Boolean;
+begin
+  Result:=False;
+end;
+
 function TFPExprNode.NodeValue: TFPExpressionResult;
 begin
   GetNodeValue(Result);
@@ -2289,6 +2759,27 @@ begin
   CheckSameNodeTypes;
 end;
 
+procedure TIfOperation.InitAggregate;
+begin
+  inherited InitAggregate;
+  If Assigned(FCondition) then
+    fCondition.InitAggregate;
+end;
+
+procedure TIfOperation.UpdateAggregate;
+begin
+  inherited UpdateAggregate;
+  If Assigned(FCondition) then
+    FCondition.UpdateAggregate;
+end;
+
+function TIfOperation.HasAggregate: Boolean;
+begin
+  Result:=inherited HasAggregate;
+  if Assigned(Condition) then
+    Result:=Result or Condition.HasAggregate;
+end;
+
 function TIfOperation.NodeType: TResultType;
 begin
   Result:=Left.NodeType;
@@ -2367,6 +2858,45 @@ begin
     end;
 end;
 
+procedure TCaseOperation.InitAggregate;
+
+Var
+  I : Integer;
+
+begin
+  inherited InitAggregate;
+  if Assigned(FCondition) then
+    FCondition.InitAggregate;
+  For I:=0 to Length(Fargs)-1 do
+    FArgs[i].InitAggregate;
+end;
+
+procedure TCaseOperation.UpdateAggregate;
+Var
+  I : Integer;
+begin
+  inherited UpdateAggregate;
+  if Assigned(FCondition) then
+    FCondition.UpdateAggregate;
+  For I:=0 to Length(Fargs)-1 do
+    FArgs[i].InitAggregate;
+end;
+
+Function  TCaseOperation.HasAggregate : Boolean;
+
+Var
+  I,L : Integer;
+begin
+  Result:=inherited HasAggregate;
+  L:=Length(Fargs);
+  I:=0;
+  While (Not Result) and (I<L) do
+    begin
+    Result:=Result or FArgs[i].HasAggregate;
+    Inc(I)
+    end;
+end;
+
 function TCaseOperation.NodeType: TResultType;
 begin
   Result:=FArgs[1].NodeType;
@@ -2692,6 +3222,55 @@ begin
   Result.ResultType:=rtFloat;
 end;
 
+{ TFPPowerOperation }
+
+procedure TFPPowerOperation.Check;
+const
+  AllowedTypes = [rtInteger, rtFloat];
+begin
+  CheckNodeType(Left, AllowedTypes);
+  CheckNodeType(Right, AllowedTypes);
+end;
+
+function TFPPowerOperation.AsString: String;
+begin
+  Result := Left.AsString + '^' + Right.AsString;
+end;
+
+function TFPPowerOperation.NodeType: TResultType;
+begin
+  Result := rtFloat;
+end;
+
+function power(base,exponent: TExprFloat): TExprFloat;
+// Adapted from unit "math"
+var
+  ex: Integer;
+begin
+  if Exponent = 0.0 then
+    result := 1.0
+  else if (base = 0.0) and (exponent > 0.0) then
+    result := 0.0
+  else if (base < 0.0) and (frac(exponent) = 0.0) then
+  begin
+    ex := round(exponent);
+    result := exp( exponent * ln(-base));
+    if odd(ex) then result := -result;
+  end
+  else
+    result := exp( exponent * ln(base) );
+end;
+
+procedure TFPPowerOperation.GetNodeValue(var Result: TFPExpressionResult);
+var
+  RRes: TFPExpressionResult;
+begin
+  Left.GetNodeValue(Result);
+  Right.GetNodeValue(RRes);
+  Result.ResFloat := power(ArgToFloat(Result), ArgToFloat(RRes));
+  Result.ResultType := rtFloat;
+end;
+
 { TFPConvertNode }
 
 function TFPConvertNode.AsString: String;
@@ -2771,6 +3350,8 @@ end;
 
 Procedure TFPExprIdentifierNode.GetNodeValue(var Result : TFPExpressionResult);
 begin
+  if Identifier.EventBasedVariable then
+    Identifier.FetchValue;
   Result:=PResult^;
   Result.ResultType:=FResultType;
 end;
@@ -2796,7 +3377,9 @@ Var
 
 begin
   For I:=0 to Length(FArgumentParams)-1 do
+    begin
     FArgumentNodes[i].GetNodeValue(FArgumentParams[i]);
+    end;
 end;
 
 procedure TFPExprFunction.Check;
@@ -2817,7 +3400,7 @@ begin
       // Automatically convert integers to floats in functions that return
       // a float
       if (rta = rtInteger) and (rtp = rtFloat) then begin
-        FArgumentNodes[i] := TIntToFloatNode(FArgumentNodes[i]);
+        FArgumentNodes[i] := TIntToFloatNode.Create(FArgumentNodes[i]);
         exit;
       end;
 
@@ -2877,6 +3460,7 @@ Procedure TFPFunctionCallBack.GetNodeValue(var Result : TFPExpressionResult);
 begin
   If Length(FArgumentParams)>0 then
     CalcParams;
+
   FCallBack(Result,FArgumentParams);
   Result.ResultType:=NodeType;
 end;
@@ -3336,80 +3920,103 @@ begin
     Result.resDateTime:=Args[2].resDateTime
 end;
 
-Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
+procedure RegisterStdBuiltins(AManager: TExprBuiltInManager;  Categories: TBuiltInCategories = AllBuiltIns);
 
 begin
   With AManager do
     begin
-    AddFloatVariable(bcMath,'pi',Pi);
-    // Math functions
-    AddFunction(bcMath,'cos','F','F',@BuiltinCos);
-    AddFunction(bcMath,'sin','F','F',@BuiltinSin);
-    AddFunction(bcMath,'arctan','F','F',@BuiltinArctan);
-    AddFunction(bcMath,'abs','F','F',@BuiltinAbs);
-    AddFunction(bcMath,'sqr','F','F',@BuiltinSqr);
-    AddFunction(bcMath,'sqrt','F','F',@BuiltinSqrt);
-    AddFunction(bcMath,'exp','F','F',@BuiltinExp);
-    AddFunction(bcMath,'ln','F','F',@BuiltinLn);
-    AddFunction(bcMath,'log','F','F',@BuiltinLog);
-    AddFunction(bcMath,'frac','F','F',@BuiltinFrac);
-    AddFunction(bcMath,'int','F','F',@BuiltinInt);
-    AddFunction(bcMath,'round','I','F',@BuiltinRound);
-    AddFunction(bcMath,'trunc','I','F',@BuiltinTrunc);
-    // String
-    AddFunction(bcStrings,'length','I','S',@BuiltinLength);
-    AddFunction(bcStrings,'copy','S','SII',@BuiltinCopy);
-    AddFunction(bcStrings,'delete','S','SII',@BuiltinDelete);
-    AddFunction(bcStrings,'pos','I','SS',@BuiltinPos);
-    AddFunction(bcStrings,'lowercase','S','S',@BuiltinLowercase);
-    AddFunction(bcStrings,'uppercase','S','S',@BuiltinUppercase);
-    AddFunction(bcStrings,'stringreplace','S','SSSBB',@BuiltinStringReplace);
-    AddFunction(bcStrings,'comparetext','I','SS',@BuiltinCompareText);
-    // Date/Time
-    AddFunction(bcDateTime,'date','D','',@BuiltinDate);
-    AddFunction(bcDateTime,'time','D','',@BuiltinTime);
-    AddFunction(bcDateTime,'now','D','',@BuiltinNow);
-    AddFunction(bcDateTime,'dayofweek','I','D',@BuiltinDayofweek);
-    AddFunction(bcDateTime,'extractyear','I','D',@BuiltinExtractYear);
-    AddFunction(bcDateTime,'extractmonth','I','D',@BuiltinExtractMonth);
-    AddFunction(bcDateTime,'extractday','I','D',@BuiltinExtractDay);
-    AddFunction(bcDateTime,'extracthour','I','D',@BuiltinExtractHour);
-    AddFunction(bcDateTime,'extractmin','I','D',@BuiltinExtractMin);
-    AddFunction(bcDateTime,'extractsec','I','D',@BuiltinExtractSec);
-    AddFunction(bcDateTime,'extractmsec','I','D',@BuiltinExtractMSec);
-    AddFunction(bcDateTime,'encodedate','D','III',@BuiltinEncodedate);
-    AddFunction(bcDateTime,'encodetime','D','IIII',@BuiltinEncodeTime);
-    AddFunction(bcDateTime,'encodedatetime','D','IIIIIII',@BuiltinEncodeDateTime);
-    AddFunction(bcDateTime,'shortdayname','S','I',@BuiltinShortDayName);
-    AddFunction(bcDateTime,'shortmonthname','S','I',@BuiltinShortMonthName);
-    AddFunction(bcDateTime,'longdayname','S','I',@BuiltinLongDayName);
-    AddFunction(bcDateTime,'longmonthname','S','I',@BuiltinLongMonthName);
-    AddFunction(bcDateTime,'formatdatetime','S','SD',@BuiltinFormatDateTime);
-    // Boolean
-    AddFunction(bcBoolean,'shl','I','II',@BuiltinShl);
-    AddFunction(bcBoolean,'shr','I','II',@BuiltinShr);
-    AddFunction(bcBoolean,'IFS','S','BSS',@BuiltinIFS);
-    AddFunction(bcBoolean,'IFF','F','BFF',@BuiltinIFF);
-    AddFunction(bcBoolean,'IFD','D','BDD',@BuiltinIFD);
-    AddFunction(bcBoolean,'IFI','I','BII',@BuiltinIFI);
-    // Conversion
-    AddFunction(bcConversion,'inttostr','S','I',@BuiltInIntToStr);
-    AddFunction(bcConversion,'strtoint','I','S',@BuiltInStrToInt);
-    AddFunction(bcConversion,'strtointdef','I','SI',@BuiltInStrToIntDef);
-    AddFunction(bcConversion,'floattostr','S','F',@BuiltInFloatToStr);
-    AddFunction(bcConversion,'strtofloat','F','S',@BuiltInStrToFloat);
-    AddFunction(bcConversion,'strtofloatdef','F','SF',@BuiltInStrToFloatDef);
-    AddFunction(bcConversion,'booltostr','S','B',@BuiltInBoolToStr);
-    AddFunction(bcConversion,'strtobool','B','S',@BuiltInStrToBool);
-    AddFunction(bcConversion,'strtobooldef','B','SB',@BuiltInStrToBoolDef);
-    AddFunction(bcConversion,'datetostr','S','D',@BuiltInDateToStr);
-    AddFunction(bcConversion,'timetostr','S','D',@BuiltInTimeToStr);
-    AddFunction(bcConversion,'strtodate','D','S',@BuiltInStrToDate);
-    AddFunction(bcConversion,'strtodatedef','D','SD',@BuiltInStrToDateDef);
-    AddFunction(bcConversion,'strtotime','D','S',@BuiltInStrToTime);
-    AddFunction(bcConversion,'strtotimedef','D','SD',@BuiltInStrToTimeDef);
-    AddFunction(bcConversion,'strtodatetime','D','S',@BuiltInStrToDateTime);
-    AddFunction(bcConversion,'strtodatetimedef','D','SD',@BuiltInStrToDateTimeDef);
+    if bcMath in Categories then
+      begin
+      AddFloatVariable(bcMath,'pi',Pi);
+      // Math functions
+      AddFunction(bcMath,'cos','F','F',@BuiltinCos);
+      AddFunction(bcMath,'sin','F','F',@BuiltinSin);
+      AddFunction(bcMath,'arctan','F','F',@BuiltinArctan);
+      AddFunction(bcMath,'abs','F','F',@BuiltinAbs);
+      AddFunction(bcMath,'sqr','F','F',@BuiltinSqr);
+      AddFunction(bcMath,'sqrt','F','F',@BuiltinSqrt);
+      AddFunction(bcMath,'exp','F','F',@BuiltinExp);
+      AddFunction(bcMath,'ln','F','F',@BuiltinLn);
+      AddFunction(bcMath,'log','F','F',@BuiltinLog);
+      AddFunction(bcMath,'frac','F','F',@BuiltinFrac);
+      AddFunction(bcMath,'int','F','F',@BuiltinInt);
+      AddFunction(bcMath,'round','I','F',@BuiltinRound);
+      AddFunction(bcMath,'trunc','I','F',@BuiltinTrunc);
+      end;
+    if bcStrings in Categories then
+      begin
+      // String
+      AddFunction(bcStrings,'length','I','S',@BuiltinLength);
+      AddFunction(bcStrings,'copy','S','SII',@BuiltinCopy);
+      AddFunction(bcStrings,'delete','S','SII',@BuiltinDelete);
+      AddFunction(bcStrings,'pos','I','SS',@BuiltinPos);
+      AddFunction(bcStrings,'lowercase','S','S',@BuiltinLowercase);
+      AddFunction(bcStrings,'uppercase','S','S',@BuiltinUppercase);
+      AddFunction(bcStrings,'stringreplace','S','SSSBB',@BuiltinStringReplace);
+      AddFunction(bcStrings,'comparetext','I','SS',@BuiltinCompareText);
+      end;
+    if bcDateTime in Categories then
+      begin
+      // Date/Time
+      AddFunction(bcDateTime,'date','D','',@BuiltinDate);
+      AddFunction(bcDateTime,'time','D','',@BuiltinTime);
+      AddFunction(bcDateTime,'now','D','',@BuiltinNow);
+      AddFunction(bcDateTime,'dayofweek','I','D',@BuiltinDayofweek);
+      AddFunction(bcDateTime,'extractyear','I','D',@BuiltinExtractYear);
+      AddFunction(bcDateTime,'extractmonth','I','D',@BuiltinExtractMonth);
+      AddFunction(bcDateTime,'extractday','I','D',@BuiltinExtractDay);
+      AddFunction(bcDateTime,'extracthour','I','D',@BuiltinExtractHour);
+      AddFunction(bcDateTime,'extractmin','I','D',@BuiltinExtractMin);
+      AddFunction(bcDateTime,'extractsec','I','D',@BuiltinExtractSec);
+      AddFunction(bcDateTime,'extractmsec','I','D',@BuiltinExtractMSec);
+      AddFunction(bcDateTime,'encodedate','D','III',@BuiltinEncodedate);
+      AddFunction(bcDateTime,'encodetime','D','IIII',@BuiltinEncodeTime);
+      AddFunction(bcDateTime,'encodedatetime','D','IIIIIII',@BuiltinEncodeDateTime);
+      AddFunction(bcDateTime,'shortdayname','S','I',@BuiltinShortDayName);
+      AddFunction(bcDateTime,'shortmonthname','S','I',@BuiltinShortMonthName);
+      AddFunction(bcDateTime,'longdayname','S','I',@BuiltinLongDayName);
+      AddFunction(bcDateTime,'longmonthname','S','I',@BuiltinLongMonthName);
+      AddFunction(bcDateTime,'formatdatetime','S','SD',@BuiltinFormatDateTime);
+      end;
+    if bcBoolean in Categories then
+      begin
+      // Boolean
+      AddFunction(bcBoolean,'shl','I','II',@BuiltinShl);
+      AddFunction(bcBoolean,'shr','I','II',@BuiltinShr);
+      AddFunction(bcBoolean,'IFS','S','BSS',@BuiltinIFS);
+      AddFunction(bcBoolean,'IFF','F','BFF',@BuiltinIFF);
+      AddFunction(bcBoolean,'IFD','D','BDD',@BuiltinIFD);
+      AddFunction(bcBoolean,'IFI','I','BII',@BuiltinIFI);
+      end;
+    if (bcConversion in Categories) then
+      begin
+      // Conversion
+      AddFunction(bcConversion,'inttostr','S','I',@BuiltInIntToStr);
+      AddFunction(bcConversion,'strtoint','I','S',@BuiltInStrToInt);
+      AddFunction(bcConversion,'strtointdef','I','SI',@BuiltInStrToIntDef);
+      AddFunction(bcConversion,'floattostr','S','F',@BuiltInFloatToStr);
+      AddFunction(bcConversion,'strtofloat','F','S',@BuiltInStrToFloat);
+      AddFunction(bcConversion,'strtofloatdef','F','SF',@BuiltInStrToFloatDef);
+      AddFunction(bcConversion,'booltostr','S','B',@BuiltInBoolToStr);
+      AddFunction(bcConversion,'strtobool','B','S',@BuiltInStrToBool);
+      AddFunction(bcConversion,'strtobooldef','B','SB',@BuiltInStrToBoolDef);
+      AddFunction(bcConversion,'datetostr','S','D',@BuiltInDateToStr);
+      AddFunction(bcConversion,'timetostr','S','D',@BuiltInTimeToStr);
+      AddFunction(bcConversion,'strtodate','D','S',@BuiltInStrToDate);
+      AddFunction(bcConversion,'strtodatedef','D','SD',@BuiltInStrToDateDef);
+      AddFunction(bcConversion,'strtotime','D','S',@BuiltInStrToTime);
+      AddFunction(bcConversion,'strtotimedef','D','SD',@BuiltInStrToTimeDef);
+      AddFunction(bcConversion,'strtodatetime','D','S',@BuiltInStrToDateTime);
+      AddFunction(bcConversion,'strtodatetimedef','D','SD',@BuiltInStrToDateTimeDef);
+      end;
+    if bcAggregate in Categories then
+      begin
+      AddFunction(bcAggregate,'count','I','',TAggregateCount);
+      AddFunction(bcAggregate,'sum','F','F',TAggregateSum);
+      AddFunction(bcAggregate,'avg','F','F',TAggregateAvg);
+      AddFunction(bcAggregate,'min','F','F',TAggregateMin);
+      AddFunction(bcAggregate,'max','F','F',TAggregateMax);
+      end;
     end;
 end;
 
diff --git a/packages/fcl-base/src/fptimer.pp b/packages/fcl-base/src/fptimer.pp
index 39d70994dc..cd31f83760 100644
--- a/packages/fcl-base/src/fptimer.pp
+++ b/packages/fcl-base/src/fptimer.pp
@@ -334,6 +334,7 @@ Var
   Diff: Extended;
    
 begin
+  Result:=False;
     { Use Counter*fInterval to avoid numerical errors resulting from adding
       small values (AInterval/cMilliSecs) to a large real number (TDateTime),
       even when using Extended precision }
diff --git a/packages/fcl-base/src/inifiles.pp b/packages/fcl-base/src/inifiles.pp
index 4a1d9e1cd4..89d9f95953 100644
--- a/packages/fcl-base/src/inifiles.pp
+++ b/packages/fcl-base/src/inifiles.pp
@@ -165,7 +165,7 @@ type
     procedure WriteString(const Section, Ident, Value: String); virtual; abstract;
     function ReadInteger(const Section, Ident: string; Default: Longint): Longint; virtual;
     procedure WriteInteger(const Section, Ident: string; Value: Longint); virtual;
-    function ReadInt64(const Section, Ident: string; Default: Int64): Longint; virtual;
+    function ReadInt64(const Section, Ident: string; Default: Int64): Int64; virtual;
     procedure WriteInt64(const Section, Ident: string; Value: Int64); virtual;
     function ReadBool(const Section, Ident: string; Default: Boolean): Boolean; virtual;
     procedure WriteBool(const Section, Ident: string; Value: Boolean); virtual;
@@ -220,7 +220,7 @@ type
     procedure ReadSection(const Section: string; Strings: TStrings); override;
     procedure ReadSectionRaw(const Section: string; Strings: TStrings);
     procedure ReadSections(Strings: TStrings); override;
-    procedure ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = []); overload; override;
+    procedure ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = [svoIncludeInvalid]); overload; override;
     procedure EraseSection(const Section: string); override;
     procedure DeleteKey(const Section, Ident: String); override;
     procedure UpdateFile; override;
@@ -337,7 +337,10 @@ begin
   if not FValueHashValid then
     UpdateValueHash;
 
-  I := FValueHash.FindIndexOf(S);
+  if CaseSensitive then
+    I := FValueHash.FindIndexOf(S)
+  else
+    I := FValueHash.FindIndexOf(AnsiUpperCase(S));
   if I >= 0 then
     Result := Integer(FValueHash[I])-1
   else
@@ -351,7 +354,10 @@ begin
   if not FNameHashValid then
     UpdateNameHash;
 
-  I := FNameHash.FindIndexOf(Name);
+  if CaseSensitive then
+    I := FNameHash.FindIndexOf(Name)
+  else
+    I := FNameHash.FindIndexOf(AnsiUpperCase(Name));
   if I >= 0 then
     Result := Integer(FNameHash[I])-1
   else
@@ -374,7 +380,10 @@ begin
   else
     FValueHash.Clear;
   for I := 0 to Count - 1 do
-    FValueHash.Add(Strings[I], Pointer(I+1));
+    if CaseSensitive then
+      FValueHash.Add(Strings[I], Pointer(I+1))
+    else
+      FValueHash.Add(AnsiUpperCase(Strings[I]), Pointer(I+1));
   FValueHashValid := True;
 end;
 
@@ -387,7 +396,10 @@ begin
   else
     FNameHash.Clear;
   for I := 0 to Count - 1 do
-    FNameHash.Add(Names[I], Pointer(I+1));
+    if CaseSensitive then
+      FNameHash.Add(Names[I], Pointer(I+1))
+    else
+      FNameHash.Add(AnsiUpperCase(Names[I]), Pointer(I+1));
   FNameHashValid := True;
 end;
 
@@ -608,7 +620,7 @@ begin
 end;
 
 function TCustomIniFile.ReadInt64(const Section, Ident: string; Default: Int64
-  ): Longint;
+  ): Int64;
 begin
   Result := StrToInt64Def(ReadString(Section, Ident, ''), Default);
 end;
@@ -820,7 +832,7 @@ end;
 procedure TCustomIniFile.ReadSectionValues(const Section: string;
   Strings: TStrings);
 begin
-  ReadSectionValues(Section,Strings,[]);
+  ReadSectionValues(Section,Strings,[svoIncludeInvalid]);
 end;
 
 { TIniFile }
@@ -1101,7 +1113,7 @@ begin
   end;
 end;
 
-procedure TIniFile.ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = []);
+procedure TIniFile.ReadSectionValues(const Section: string; Strings: TStrings; AOptions : TSectionValuesOptions = [svoIncludeInvalid]);
 var
   oSection: TIniFileSection;
   s: string;
diff --git a/packages/fcl-base/src/streamex.pp b/packages/fcl-base/src/streamex.pp
index 58b0087a21..756f089496 100644
--- a/packages/fcl-base/src/streamex.pp
+++ b/packages/fcl-base/src/streamex.pp
@@ -86,13 +86,14 @@ type
    { TTextReader }
 
    TTextReader = class(TObject)
+   Protected
+     function IsEof: Boolean; virtual; abstract;
    public
      constructor Create; virtual;
      procedure Reset; virtual; abstract;
      procedure Close; virtual; abstract;
-     function IsEof: Boolean; virtual; abstract;
      procedure ReadLine(out AString: string); virtual; abstract; overload;
-     function ReadLine: string; virtual; abstract; overload;
+     function ReadLine: string; overload;
      property Eof: Boolean read IsEof;
    end;
 
@@ -102,10 +103,13 @@ type
    private
      FBufferRead: Integer;
      FBufferPosition: Integer;
+     FClosed,
      FOwnsStream: Boolean;
      FStream: TStream;
      FBuffer: array of Byte;
      procedure FillBuffer;
+   Protected  
+     function IsEof: Boolean; override;
    public
      constructor Create(AStream: TStream; ABufferSize: Integer;
        AOwnsStream: Boolean); virtual;
@@ -113,9 +117,7 @@ type
      destructor Destroy; override;
      procedure Reset; override;
      procedure Close; override;
-     function IsEof: Boolean; override;
      procedure ReadLine(out AString: string); override; overload;
-     function ReadLine: string; override; overload;
      property BaseStream: TStream read FStream;
      property OwnsStream: Boolean read FOwnsStream write FOwnsStream;
    end;
@@ -125,15 +127,15 @@ type
    TStringReader = class(TTextReader)
    private
      FReader: TTextReader;
+   Protected  
+     function IsEof: Boolean; override;
    public
      constructor Create(const AString: string; ABufferSize: Integer); virtual;
      constructor Create(const AString: string); virtual;
      destructor Destroy; override;
      procedure Reset; override;
      procedure Close; override;
-     function IsEof: Boolean; override;
      procedure ReadLine(out AString: string); override; overload;
-     function ReadLine: string; override; overload;
    end;
 
    { TFileReader }
@@ -141,6 +143,8 @@ type
    TFileReader = class(TTextReader)
    private
      FReader: TTextReader;
+   Protected
+     function IsEof: Boolean; override;
    public
      constructor Create(const AFileName: TFileName; AMode: Word;
        ARights: Cardinal; ABufferSize: Integer); virtual;
@@ -151,9 +155,7 @@ type
      destructor Destroy; override;
      procedure Reset; override;
      procedure Close; override;
-     function IsEof: Boolean; override;
      procedure ReadLine(out AString: string); override; overload;
-     function ReadLine: string; override; overload;
    end;
 
   { allows you to represent just a small window of a bigger stream as a substream. 
@@ -331,6 +333,12 @@ begin
   inherited Create;
 end;
 
+function TTextReader.ReadLine: string;
+
+begin
+  ReadLine(Result);
+end;
+
 { TStreamReader }
 
 constructor TStreamReader.Create(AStream: TStream; ABufferSize: Integer;
@@ -341,6 +349,7 @@ begin
     raise EArgumentException.CreateFmt(SParamIsNil, ['AStream']);
   FStream := AStream;
   FOwnsStream := AOwnsStream;
+  FClosed:=False;
   if ABufferSize >= MIN_BUFFER_SIZE then
     SetLength(FBuffer, ABufferSize)
   else
@@ -360,9 +369,17 @@ end;
 
 procedure TStreamReader.FillBuffer;
 begin
-  FBufferRead := FStream.Read(FBuffer[0], Pred(Length(FBuffer)));
-  FBuffer[FBufferRead] := 0;
-  FBufferPosition := 0;
+  if FClosed then 
+    begin
+    FBufferRead:=0;
+    FBufferPosition:=0;
+    end
+  else  
+    begin
+    FBufferRead := FStream.Read(FBuffer[0], Pred(Length(FBuffer)));
+    FBuffer[FBufferRead] := 0;
+    FBufferPosition := 0;
+    end;
 end;
 
 procedure TStreamReader.Reset;
@@ -376,15 +393,13 @@ end;
 procedure TStreamReader.Close;
 begin
   if FOwnsStream then
-  begin
-    FStream.Free;
-    FStream := nil;
-  end;
+    FreeAndNil(FStream);
+  FClosed:=True;
 end;
 
 function TStreamReader.IsEof: Boolean;
 begin
-  if not Assigned(FStream) then
+  if FClosed or not Assigned(FStream) then
     Exit(True);
   Result := FBufferPosition >= FBufferRead;
   if Result then
@@ -401,6 +416,7 @@ var
 begin
   VPosition := FBufferPosition;
   SetLength(AString, 0);
+  if FClosed then exit;
   repeat
     VPByte := @FBuffer[FBufferPosition];
     while (FBufferPosition < FBufferRead) and not (VPByte^ in [10, 13]) do
@@ -441,10 +457,6 @@ begin
   end;
 end;
 
-function TStreamReader.ReadLine: string;
-begin
-  ReadLine(Result);
-end;
 
 { TStringReader }
 
@@ -485,11 +497,6 @@ begin
   FReader.ReadLine(AString);
 end;
 
-function TStringReader.ReadLine: string;
-begin
-  ReadLine(Result);
-end;
-
 { TFileReader }
 
 constructor TFileReader.Create(const AFileName: TFileName; AMode: Word;
@@ -542,11 +549,6 @@ begin
   FReader.ReadLine(AString);
 end;
 
-function TFileReader.ReadLine: string;
-begin
-  ReadLine(Result);
-end;
-
 { TStreamHelper }
 
 function TStreamHelper.readwordLE:word;
diff --git a/packages/fcl-base/src/syncobjs.pp b/packages/fcl-base/src/syncobjs.pp
index f46a6e1e2b..47f00af3ba 100644
--- a/packages/fcl-base/src/syncobjs.pp
+++ b/packages/fcl-base/src/syncobjs.pp
@@ -28,6 +28,10 @@ const
   INFINITE = Cardinal(-1);
 
 type
+   ESyncObjectException = Class(Exception);
+   ELockException = Class(ESyncObjectException);
+   ELockRecursionException = Class(ESyncObjectException);
+   
    TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
 
    TSynchroObject = class(TObject)
@@ -79,6 +83,9 @@ type
 
 implementation
 
+Resourcestring
+  SErrEventCreateFailed = 'Failed to create OS basic event with name "%s"'; 
+
 { ---------------------------------------------------------------------
     Real syncobjs implementation
   ---------------------------------------------------------------------}
@@ -150,6 +157,8 @@ constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
 
 begin
   FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name);
+  if (FHandle=Nil) then
+    Raise ESyncObjectException.CreateFmt(SErrEventCreateFailed,[Name]);
   FManualReset:=AManualReset;
 end;
 
diff --git a/packages/fcl-base/tests/fclbase-unittests.lpi b/packages/fcl-base/tests/fclbase-unittests.lpi
index babd8c6440..225b475c27 100644
--- a/packages/fcl-base/tests/fclbase-unittests.lpi
+++ b/packages/fcl-base/tests/fclbase-unittests.lpi
@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -6,7 +6,6 @@
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
-        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -31,35 +30,35 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <CommandLineParams Value="--suite=TTestParserVariables.TestVariable31"/>
       </local>
     </RunParams>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
         <Filename Value="fclbase-unittests.pp"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="fclbase_unittests"/>
       </Unit0>
       <Unit1>
         <Filename Value="tchashlist.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tchashlist"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="testexprpars.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="project1"/>
+      <Filename Value="fclbase-unittests"/>
     </Target>
     <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <MsgFileName Value=""/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-base/tests/fclbase-unittests.pp b/packages/fcl-base/tests/fclbase-unittests.pp
index 19bd30e3bc..0add823423 100644
--- a/packages/fcl-base/tests/fclbase-unittests.pp
+++ b/packages/fcl-base/tests/fclbase-unittests.pp
@@ -10,6 +10,8 @@ var
   Application: TTestRunner;
 
 begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
   Application := TTestRunner.Create(nil);
   Application.Initialize;
   Application.Title := 'FCL-Base unittests';
diff --git a/packages/fcl-base/tests/testexprpars.pp b/packages/fcl-base/tests/testexprpars.pp
index 7528c76534..7526a96a4d 100644
--- a/packages/fcl-base/tests/testexprpars.pp
+++ b/packages/fcl-base/tests/testexprpars.pp
@@ -20,7 +20,7 @@ unit testexprpars;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars;
+  Classes, SysUtils, fpcunit, testutils, testregistry, math, fpexprpars;
 
 type
 
@@ -31,6 +31,7 @@ type
     FP : TFPExpressionScanner;
     FInvalidString : String;
     procedure DoInvalidNumber(AString: String);
+    procedure TestIdentifier(const ASource, ATokenName: string);
     procedure TestInvalidNumber;
   protected
     procedure SetUp; override; 
@@ -46,6 +47,7 @@ type
     Procedure TestInvalidCharacter;
     Procedure TestUnterminatedString;
     Procedure TestQuotesInString;
+    Procedure TestIdentifiers;
   end;
 
   { TMyFPExpressionParser }
@@ -412,6 +414,27 @@ type
     Procedure TestAsString;
   end;
 
+  { TTestPowerNode }
+
+  TTestPowerNode = Class(TTestBaseParser)
+  Private
+    FN : TFPPowerOperation;
+    FE : TFPExpressionParser;
+  Protected
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    procedure Calc(AExpr: String; Expected: Double = NaN);
+  Published
+    Procedure TestCreateInteger;
+    Procedure TestCreateFloat;
+    Procedure TestCreateDateTime;
+    Procedure TestCreateString;
+    Procedure TestCreateBoolean;
+    Procedure TestDestroy;
+    Procedure TestAsString;
+    Procedure TestCalc;
+  end;
+
   { TTestDivideNode }
 
   TTestDivideNode = Class(TTestBaseParser)
@@ -701,6 +724,12 @@ type
   TTestParserVariables = Class(TTestExpressionParser)
   private
     FAsWrongType : TResultType;
+    FEventName: String;
+    FBoolValue : Boolean;
+    FTest33 : TFPExprIdentifierDef;
+    procedure DoGetBooleanVar(var Res: TFPExpressionResult; ConstRef AName: ShortString);
+    procedure DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
+    procedure DoTestVariable33;
     procedure TestAccess(Skip: TResultType);
   Protected
     procedure AddVariabletwice;
@@ -741,6 +770,10 @@ type
     procedure TestVariable28;
     procedure TestVariable29;
     procedure TestVariable30;
+    procedure TestVariable31;
+    procedure TestVariable32;
+    procedure TestVariable33;
+    procedure TestVariable34;
   end;
 
   { TTestParserFunctions }
@@ -782,6 +815,45 @@ type
     procedure TestFunction29;
   end;
 
+  { TAggregateNode }
+
+  TAggregateNode = Class(TFPExprNode)
+  Public
+    InitCount : Integer;
+    UpdateCount : Integer;
+    Class Function IsAggregate: Boolean; override;
+    Function NodeType: TResultType; override;
+    Procedure InitAggregate; override;
+    Procedure UpdateAggregate; override;
+    procedure GetNodeValue(var Result: TFPExpressionResult); override;
+  end;
+
+  { TTestParserAggregate }
+
+  TTestParserAggregate = Class(TTestExpressionParser)
+  private
+    FVarValue : Integer;
+    FLeft : TAggregateNode;
+    FRight : TAggregateNode;
+    FFunction : TFPExprIdentifierDef;
+    FFunction2 : TFPExprIdentifierDef;
+  Protected
+    Procedure Setup; override;
+    Procedure TearDown; override;
+  public
+    procedure GetVar(var Result: TFPExpressionResult; ConstRef AName: ShortString);
+  Published
+    Procedure TestIsAggregate;
+    Procedure TestHasAggregate;
+    Procedure TestBinaryAggregate;
+    Procedure TestUnaryAggregate;
+    Procedure TestCountAggregate;
+    Procedure TestSumAggregate;
+    Procedure TestSumAggregate2;
+    Procedure TestAvgAggregate;
+    Procedure TestAvgAggregate2;
+    Procedure TestAvgAggregate3;
+  end;
   { TTestBuiltinsManager }
 
   TTestBuiltinsManager = Class(TTestExpressionParser)
@@ -804,8 +876,11 @@ type
 
   TTestBuiltins = Class(TTestExpressionParser)
   private
+    FValue : Integer;
     FM : TExprBuiltInManager;
     FExpr : String;
+    procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
+    procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
   Protected
     procedure Setup; override;
     procedure Teardown; override;
@@ -817,6 +892,8 @@ type
     procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
     procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
     procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
+    procedure AssertAggregateExpression(Const AExpression : String; AResult : Int64; AUpdateCount : integer);
+    procedure AssertAggregateExpression(Const AExpression : String; AResult : TExprFloat; AUpdateCount : integer);
   Published
     procedure TestRegister;
     Procedure TestVariablepi;
@@ -883,12 +960,337 @@ type
     Procedure TestFunctionstrtotimedef;
     Procedure TestFunctionstrtodatetime;
     Procedure TestFunctionstrtodatetimedef;
+    Procedure TestFunctionAggregateSum;
+    Procedure TestFunctionAggregateCount;
+    Procedure TestFunctionAggregateAvg;
+    Procedure TestFunctionAggregateMin;
+    Procedure TestFunctionAggregateMax;
   end;
 
 implementation
 
 uses typinfo;
 
+{ TTestParserAggregate }
+
+procedure TTestParserAggregate.Setup;
+begin
+  inherited Setup;
+  FVarValue:=0;
+  FFunction:=TFPExprIdentifierDef.Create(Nil);
+  FFunction.Name:='Count';
+  FFunction2:=TFPExprIdentifierDef.Create(Nil);
+  FFunction2.Name:='MyVar';
+  FFunction2.ResultType:=rtInteger;
+  FFunction2.IdentifierType:=itVariable;
+  FFunction2.OnGetVariableValue:=@GetVar;
+  FLeft:=TAggregateNode.Create;
+  FRight:=TAggregateNode.Create;
+end;
+
+procedure TTestParserAggregate.TearDown;
+begin
+  FreeAndNil(FFunction);
+  FreeAndNil(FLeft);
+  FreeAndNil(FRight);
+  inherited TearDown;
+end;
+
+procedure TTestParserAggregate.GetVar(var Result: TFPExpressionResult; ConstRef
+  AName: ShortString);
+begin
+  Result.ResultType:=FFunction2.ResultType;
+  Case Result.ResultType of
+    rtInteger : Result.ResInteger:=FVarValue;
+    rtFloat : Result.ResFloat:=FVarValue / 2;
+  end;
+end;
+
+procedure TTestParserAggregate.TestIsAggregate;
+begin
+  AssertEquals('ExprNode',False,TFPExprNode.IsAggregate);
+  AssertEquals('TAggregateExpr',True,TAggregateExpr.IsAggregate);
+  AssertEquals('TAggregateExpr',False,TFPBinaryOperation.IsAggregate);
+end;
+
+procedure TTestParserAggregate.TestHasAggregate;
+
+Var
+  N :  TFPExprNode;
+
+begin
+  N:=TFPExprNode.Create;
+  try
+    AssertEquals('ExprNode',False,N.HasAggregate);
+  finally
+    N.Free;
+  end;
+  N:=TAggregateExpr.Create;
+  try
+    AssertEquals('ExprNode',True,N.HasAggregate);
+  finally
+    N.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestBinaryAggregate;
+
+Var
+  B :  TFPBinaryOperation;
+
+begin
+  B:=TFPBinaryOperation.Create(Fleft,TFPConstExpression.CreateInteger(1));
+  try
+    FLeft:=Nil;
+    AssertEquals('Binary',True,B.HasAggregate);
+  finally
+    B.Free;
+  end;
+  B:=TFPBinaryOperation.Create(TFPConstExpression.CreateInteger(1),FRight);
+  try
+    FRight:=Nil;
+    AssertEquals('Binary',True,B.HasAggregate);
+  finally
+    B.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestUnaryAggregate;
+Var
+  B : TFPUnaryOperator;
+
+begin
+  B:=TFPUnaryOperator.Create(Fleft);
+  try
+    FLeft:=Nil;
+    AssertEquals('Unary',True,B.HasAggregate);
+  finally
+    B.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestCountAggregate;
+
+Var
+  C : TAggregateCount;
+  I : Integer;
+  R : TFPExpressionResult;
+
+begin
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='';
+  C:=TAggregateCount.CreateFunction(FFunction,Nil);
+  try
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 11 do
+      C.UpdateAggregate;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtInteger,R.ResultType);
+    AssertEquals('Correct value',11,R.ResInteger);
+  finally
+    C.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestSumAggregate;
+
+Var
+  C : TAggregateSum;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+
+begin
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='I';
+  FFunction.Name:='SUM';
+  FFunction2.ResultType:=rtInteger;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateSum.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtInteger,R.ResultType);
+    AssertEquals('Correct value',55,R.ResInteger);
+  finally
+    C.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestSumAggregate2;
+Var
+  C : TAggregateSum;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+
+begin
+  FFunction.ResultType:=rtFloat;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='SUM';
+  FFunction2.ResultType:=rtFloat;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateSum.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',55/2,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestAvgAggregate;
+
+Var
+  C : TAggregateAvg;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+
+begin
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='AVG';
+  FFunction2.ResultType:=rtInteger;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateAvg.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',5.5,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestAvgAggregate2;
+
+Var
+  C : TAggregateAvg;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+
+begin
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='AVG';
+  FFunction2.ResultType:=rtFloat;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateAvg.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    For I:=1 to 10 do
+      begin
+      FVarValue:=I;
+      C.UpdateAggregate;
+      end;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',5.5/2,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+procedure TTestParserAggregate.TestAvgAggregate3;
+Var
+  C : TAggregateAvg;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+
+begin
+  FFunction.ResultType:=rtInteger;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='AVG';
+  FFunction2.ResultType:=rtFloat;
+  C:=Nil;
+  V:=TFPExprVariable.CreateIdentifier(FFunction2);
+  try
+    SetLength(A,1);
+    A[0]:=V;
+    C:=TAggregateAvg.CreateFunction(FFunction,A);
+    C.Check;
+    C.InitAggregate;
+    C.GetNodeValue(R);
+    AssertEquals('Correct type',rtFloat,R.ResultType);
+    AssertEquals('Correct value',0.0,R.ResFloat,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
+{ TAggregateNode }
+
+class function TAggregateNode.IsAggregate: Boolean;
+begin
+  Result:=True
+end;
+
+function TAggregateNode.NodeType: TResultType;
+begin
+  Result:=rtInteger;
+end;
+
+procedure TAggregateNode.InitAggregate;
+begin
+  inherited InitAggregate;
+  inc(InitCount)
+end;
+
+procedure TAggregateNode.UpdateAggregate;
+begin
+  inherited UpdateAggregate;
+  inc(UpdateCount);
+end;
+
+procedure TAggregateNode.GetNodeValue(var Result: TFPExpressionResult);
+begin
+  Result.ResultType:=rtInteger;
+  Result.ResInteger:=updateCount;
+end;
+
 procedure TTestExpressionScanner.TestCreate;
 begin
   AssertEquals('Empty source','',FP.Source);
@@ -921,7 +1323,7 @@ Const
     = ('+','-','<','>','=','/',
        '*','(',')','<=','>=',
        '<>','1','''abc''','abc',',','and',
-       'or','xor','true','false','not','if','case','');
+       'or','xor','true','false','not','if','case','^','');
 
 var
   t : TTokenType;
@@ -941,28 +1343,27 @@ procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
 
 begin
   FInvalidString:=AString;
-  AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber);
+  AssertException('Invalid number "'+AString+'" ',EExprScanner,@TestInvalidNumber);
 end;
 
 procedure TTestExpressionScanner.TestNumber;
 begin
-  TestString('123',ttNumber);
+  {TestString('123',ttNumber);
   TestString('123.4',ttNumber);
   TestString('123.E4',ttNumber);
   TestString('1.E4',ttNumber);
   TestString('1e-2',ttNumber);
   DoInvalidNumber('1..1');
+}
   DoInvalidNumber('1.E--1');
-  DoInvalidNumber('.E-1');
+//  DoInvalidNumber('.E-1');
 end;
 
 procedure TTestExpressionScanner.TestInvalidCharacter;
 begin
   DoInvalidNumber('~');
-  DoInvalidNumber('^');
   DoInvalidNumber('#');
   DoInvalidNumber('$');
-  DoInvalidNumber('^');
 end;
 
 procedure TTestExpressionScanner.TestUnterminatedString;
@@ -977,6 +1378,27 @@ begin
   TestString('''s it''''''',ttString);
 end;
 
+procedure TTestExpressionScanner.TestIdentifier(Const ASource,ATokenName : string);
+
+begin
+  FP.Source:=ASource;
+  AssertEquals('Token type',ttIdentifier,FP.GetToken);
+  AssertEquals('Token name',ATokenName,FP.Token);
+end;
+
+procedure TTestExpressionScanner.TestIdentifiers;
+begin
+  TestIdentifier('a','a');
+  TestIdentifier(' a','a');
+  TestIdentifier('a ','a');
+  TestIdentifier('a^b','a');
+  TestIdentifier('a-b','a');
+  TestIdentifier('a.b','a.b');
+  TestIdentifier('"a b"','a b');
+  TestIdentifier('c."a b"','c.a b');
+  TestIdentifier('c."ab"','c.ab');
+end;
+
 procedure TTestExpressionScanner.SetUp; 
 begin
   FP:=TFPExpressionScanner.Create;
@@ -1118,15 +1540,16 @@ end;
 procedure TTestConstExprNode.TestCreateFloat;
 
 Var
-  S : String;
+  F : Double;
+  C : Integer;
 
 begin
   FN:=TFPConstExpression.CreateFloat(2.34);
   AssertEquals('Correct type',rtFloat,FN.NodeType);
   AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
   AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
-  Str(TExprFLoat(2.34),S);
-  AssertEquals('AsString ok',S,FN.AsString);
+  Val(FN.AsString,F,C);
+  AssertEquals('AsString ok',2.34,F,0.001);
 end;
 
 procedure TTestConstExprNode.TestCreateBoolean;
@@ -2026,6 +2449,130 @@ begin
 end;
 
 
+{ TTestPowerNode }
+
+procedure TTestPowerNode.TearDown;
+begin
+  FreeAndNil(FN);
+  inherited TearDown;
+end;
+
+procedure TTestPowerNode.Setup;
+begin
+  inherited ;
+  FE:=TFpExpressionParser.Create(Nil);
+  FE.Builtins := [bcMath];
+end;
+
+procedure TTestPowerNode.Calc(AExpr: String; Expected: Double =NaN);
+const
+  EPS = 1e-9;
+var
+  res: TFpExpressionResult;
+  x: Double;
+begin
+  FE.Expression := AExpr;
+  res:=FE.Evaluate;
+  x:= ArgToFloat(res);
+  if not IsNaN(Expected) then 
+    AssertEquals('Expression '+AExpr+' result',Expected,X,Eps);
+end;
+
+procedure TTestPowerNode.TestCalc;
+
+begin
+  Calc('2^2', Power(2, 2));
+  Calc('2^-2', Power(2, -2));
+  Calc('2^(-2)', Power(2, -2));
+  Calc('sqrt(3)^2', Power(sqrt(3), 2));
+  Calc('-sqrt(3)^2', -Power(sqrt(3), 2));
+  Calc('-2^2', -Power(2, 2));
+  Calc('(-2.0)^2', Power(-2.0, 2));
+  Calc('(-2.0)^-2', Power(-2.0, -2));
+  // Odd integer exponent
+  Calc('2^3', Power(2, 3));
+  Calc('-2^3', -Power(2, 3));
+  Calc('-2^-3', -Power(2, -3));
+  Calc('-2^(-3)', -Power(2, -3));
+  Calc('(-2.0)^3', Power(-2.0, 3));
+  Calc('(-2.0)^-3', Power(-2.0, -3));
+  // Fractional exponent
+  Calc('10^2.5', power(10, 2.5));
+  Calc('10^-2.5', Power(10, -2.5));
+  // Expressions
+  Calc('(1+1)^3', Power(1+1, 3));
+  Calc('1+2^3', 1 + Power(2, 3));
+  calc('2^3+1', Power(2, 3) + 1);
+  Calc('2^3*2', Power(2, 3) * 2);
+  Calc('2^3*-2', Power(2, 3) * -2);
+  Calc('2^(1+1)', Power(2, 1+1));
+  Calc('2^-(1+1)', Power(2, -(1+1)));
+  WriteLn;
+  // Special cases
+  Calc('0^0', power(0, 0));
+  calc('0^1', power(0, 1));
+  Calc('0^2.5', Power(0, 2.5));
+  calc('2.5^0', power(2.5, 0));
+  calc('2^3^4', 2417851639229258349412352);  // according to Wolfram Alpha, 2^(3^4)
+
+  // These expressions should throw expections
+
+  //Calc('(-10)^2.5', NaN);  // base must be positive in case of fractional exponent
+  //Calc('0^-2', NaN);       // is 1/0^2 = 1/0
+end;
+
+procedure TTestPowerNode.TestCreateInteger;
+begin
+  FN:=TFPPowerOperation.Create(CreateIntNode(4),CreateIntNode(2));
+  AssertEquals('Power has correct type',rtfloat,FN.NodeType);
+  AssertEquals('Power has correct result',16.0,FN.NodeValue.ResFloat);
+end;
+
+procedure TTestPowerNode.TestCreateFloat;
+begin
+  FN:=TFPPowerOperation.Create(CreateFloatNode(2.0),CreateFloatNode(3.0));
+  AssertEquals('Power has correct type',rtFloat,FN.NodeType);
+  AssertEquals('Power has correct result',8.0,FN.NodeValue.ResFloat);
+end;
+
+procedure TTestPowerNode.TestCreateDateTime;
+
+Var
+  D,T : TDateTime;
+
+begin
+  D:=Date;
+  T:=Time;
+  FN:=TFPPowerOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
+  AssertNodeNotOK('No datetime Power',FN);
+end;
+
+procedure TTestPowerNode.TestCreateString;
+begin
+  FN:=TFPPowerOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
+  AssertNodeNotOK('No string Power',FN);
+end;
+
+procedure TTestPowerNode.TestCreateBoolean;
+begin
+  FN:=TFPPowerOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
+  AssertNodeNotOK('No boolean Power',FN);
+end;
+
+procedure TTestPowerNode.TestDestroy;
+begin
+  FN:=TFPPowerOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
+  FreeAndNil(FN);
+  AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
+end;
+
+procedure TTestPowerNode.TestAsString;
+begin
+  FN:=TFPPowerOperation.Create(CreateIntNode(1),CreateIntNode(2));
+  AssertEquals('Asstring works ok','1^2',FN.AsString);
+end;
+
+
 { TTestDivideNode }
 
 procedure TTestDivideNode.TearDown;
@@ -4196,6 +4743,114 @@ begin
   AssertEquals('Correct value',False,I.AsBoolean);
 end;
 
+procedure TTestParserVariables.DoGetBooleanVar(var Res: TFPExpressionResult;
+  ConstRef AName: ShortString);
+
+begin
+  FEventName:=AName;
+  Res.ResBoolean:=FBoolValue;
+end;
+
+procedure TTestParserVariables.TestVariable31;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar);
+  AssertEquals('Correct name','a',i.Name);
+  AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
+  AssertSame(TMethod(I.OnGetVariableValue).Code,TMethod(@DoGetBooleanVar).Code);
+  FBoolValue:=True;
+  FEventName:='';
+  AssertEquals('Correct value 1',True,I.AsBoolean);
+  AssertEquals('Correct name passed','a',FEventName);
+  FBoolValue:=False;
+  FEventName:='';
+  AssertEquals('Correct value 2',False,I.AsBoolean);
+  AssertEquals('Correct name passed','a',FEventName);
+end;
+
+Var
+  FVarCallBackName:String;
+  FVarBoolValue : Boolean;
+
+procedure DoGetBooleanVar2(var Res: TFPExpressionResult; ConstRef AName: ShortString);
+
+begin
+  FVarCallBackName:=AName;
+  Res.ResBoolean:=FVarBoolValue;
+end;
+
+procedure TTestParserVariables.DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
+
+begin
+  FEventName:=AName;
+  Res.ResultType:=rtInteger;
+  Res.ResInteger:=33;
+end;
+
+procedure TTestParserVariables.TestVariable32;
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2);
+  AssertEquals('Correct name','a',i.Name);
+  AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
+  AssertSame(I.OnGetVariableValueCallBack,@DoGetBooleanVar2);
+  FVarBoolValue:=True;
+  FVarCallBackName:='';
+  AssertEquals('Correct value 1',True,I.AsBoolean);
+  AssertEquals('Correct name passed','a',FVarCallBackName);
+  FVarBoolValue:=False;
+  FVarCallBackName:='';
+  AssertEquals('Correct value 2',False,I.AsBoolean);
+  AssertEquals('Correct name passed','a',FVarCallBackName);
+end;
+
+procedure TTestParserVariables.DoTestVariable33;
+
+Var
+  B : Boolean;
+
+begin
+  B:=FTest33.AsBoolean;
+end;
+
+procedure TTestParserVariables.TestVariable33;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVarWrong);
+  FTest33:=I;
+  AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
+  AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
+end;
+
+
+procedure DoGetBooleanVar2Wrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
+
+begin
+  FVarCallBackName:=AName;
+  Res.ResultType:=rtInteger;
+  Res.ResInteger:=34;
+end;
+
+procedure TTestParserVariables.TestVariable34;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2Wrong);
+  FTest33:=I;
+  AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
+  AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
+end;
+
 
 
 Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
@@ -4937,6 +5592,7 @@ procedure TTestBuiltins.Setup;
 begin
   inherited Setup;
   FM:=TExprBuiltInManager.Create(Nil);
+  FValue:=0;
 end;
 
 procedure TTestBuiltins.Teardown;
@@ -4945,7 +5601,7 @@ begin
   inherited Teardown;
 end;
 
-procedure TTestBuiltins.SetExpression(Const AExpression : String);
+procedure TTestBuiltins.SetExpression(const AExpression: String);
 
 Var
   Msg : String;
@@ -5030,11 +5686,41 @@ begin
   AssertDatetimeResult(AResult);
 end;
 
+procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
+  AResult: Int64; AUpdateCount: integer);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
+  FP.InitAggregate;
+  While AUpdateCount>0 do
+    begin
+    FP.UpdateAggregate;
+    Dec(AUpdateCount);
+    end;
+  AssertResult(AResult);
+end;
+
+procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
+  AResult: TExprFloat; AUpdateCount: integer);
+begin
+  FP.BuiltIns:=AllBuiltIns;
+  SetExpression(AExpression);
+  AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
+  FP.InitAggregate;
+  While AUpdateCount>0 do
+    begin
+    FP.UpdateAggregate;
+    Dec(AUpdateCount);
+    end;
+  AssertResult(AResult);
+end;
+
 procedure TTestBuiltins.TestRegister;
 
 begin
   RegisterStdBuiltins(FM);
-  AssertEquals('Correct number of identifiers',64,FM.IdentifierCount);
+  AssertEquals('Correct number of identifiers',69,FM.IdentifierCount);
   Assertvariable('pi',rtFloat);
   AssertFunction('cos','F','F',bcMath);
   AssertFunction('sin','F','F',bcMath);
@@ -5099,6 +5785,11 @@ begin
   AssertFunction('strtotimedef','D','SD',bcConversion);
   AssertFunction('strtodatetime','D','S',bcConversion);
   AssertFunction('strtodatetimedef','D','SD',bcConversion);
+  AssertFunction('sum','F','F',bcAggregate);
+  AssertFunction('count','I','',bcAggregate);
+  AssertFunction('avg','F','F',bcAggregate);
+  AssertFunction('min','F','F',bcAggregate);
+  AssertFunction('max','F','F',bcAggregate);
 end;
 
 procedure TTestBuiltins.TestVariablepi;
@@ -5549,6 +6240,59 @@ begin
   AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
 end;
 
+procedure TTestBuiltins.TestFunctionAggregateSum;
+begin
+  FP.Identifiers.AddIntegerVariable('S',2);
+  AssertAggregateExpression('sum(S)',10.0,5);
+end;
+
+procedure TTestBuiltins.TestFunctionAggregateCount;
+begin
+  AssertAggregateExpression('count',5,5);
+end;
+
+
+procedure TTestBuiltins.DoAverage(var Result: TFPExpressionResult; ConstRef
+  AName: ShortString);
+
+begin
+  Inc(FValue);
+  Result.ResInteger:=FValue;
+  Result.ResultType:=rtInteger;
+end;
+
+procedure TTestBuiltins.DoSeries(var Result: TFPExpressionResult; ConstRef
+  AName: ShortString);
+
+Const
+  Values : Array[1..10] of double =
+  (1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
+
+
+begin
+  Inc(FValue);
+  Result.ResFloat:=Values[FValue];
+  Result.ResultType:=rtFloat;
+end;
+
+procedure TTestBuiltins.TestFunctionAggregateAvg;
+begin
+  FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
+  AssertAggregateExpression('avg(S)',5.5,10);
+end;
+
+procedure TTestBuiltins.TestFunctionAggregateMin;
+begin
+  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
+  AssertAggregateExpression('Min(S)',1.1,10);
+end;
+
+procedure TTestBuiltins.TestFunctionAggregateMax;
+begin
+  FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
+  AssertAggregateExpression('Max(S)',9.9,10);
+end;
+
 { TTestNotNode }
 
 procedure TTestNotNode.TearDown;
@@ -5989,12 +6733,13 @@ initialization
                  TTestLessThanNode,TTestLessThanEqualNode,
                  TTestLargerThanNode,TTestLargerThanEqualNode,
                  TTestAddNode,TTestSubtractNode,
-                 TTestMultiplyNode,TTestDivideNode,
+                 TTestMultiplyNode,TTestDivideNode,TTestPowerNode,
                  TTestIntToFloatNode,TTestIntToDateTimeNode,
                  TTestFloatToDateTimeNode,
                  TTestParserExpressions, TTestParserBooleanOperations,
                  TTestParserOperands, TTestParserTypeMatch,
                  TTestParserVariables,TTestParserFunctions,
+                 TTestParserAggregate,
                  TTestBuiltinsManager,TTestBuiltins]);
 end.
 
diff --git a/packages/fcl-db/fpmake.pp b/packages/fcl-db/fpmake.pp
index 92cca7bc59..32312c4d6a 100644
--- a/packages/fcl-db/fpmake.pp
+++ b/packages/fcl-db/fpmake.pp
@@ -14,7 +14,6 @@ const
   SqliteOSes          = [aix,beos,haiku,linux,freebsd,darwin,iphonesim,netbsd,openbsd,solaris,win32,win64,wince,android,dragonfly];
   DBaseOSes           = [aix,beos,haiku,linux,freebsd,darwin,iphonesim,netbsd,openbsd,solaris,win32,win64,wince,android,os2,dragonfly];
   MSSQLOSes           = [beos,haiku,linux,freebsd,netbsd,openbsd,solaris,win32,win64,android,dragonfly];
-  SqldbWithoutOracleOSes   = [win64];
 
 
 Var
@@ -47,7 +46,7 @@ begin
     P.SourcePath.Add('src/sqldb/mysql', SqldbConnectionOSes);
     P.SourcePath.Add('src/sqldb/odbc', SqldbConnectionOSes);
     P.SourcePath.Add('src/sqldb/examples', SqldbConnectionOSes);
-    P.SourcePath.Add('src/sqldb/oracle', SqldbConnectionOSes-SqldbWithoutOracleOSes);
+    P.SourcePath.Add('src/sqldb/oracle', SqldbConnectionOSes);
     P.SourcePath.Add('src/sqldb/mssql', MSSQLOSes);
     P.SourcePath.Add('src/sdf');
     P.SourcePath.Add('src/json');
@@ -74,7 +73,7 @@ begin
     P.Dependencies.Add('ibase', SqldbConnectionOSes);
     P.Dependencies.Add('mysql', SqldbConnectionOSes);
     P.Dependencies.Add('odbc', SqldbConnectionOSes);
-    P.Dependencies.Add('oracle', SqldbConnectionOSes-SqldbWithoutOracleOSes);
+    P.Dependencies.Add('oracle', SqldbConnectionOSes);
     P.Dependencies.Add('postgres', SqldbConnectionOSes);
     P.Dependencies.Add('sqlite', SqldbConnectionOSes+SqliteOSes);
     P.Dependencies.Add('dblib', MSSQLOSes);
@@ -450,7 +449,7 @@ begin
           AddUnit('fpddsqldb');
           AddUnit('odbcconn');
         end;
-    T:=P.Targets.AddUnit('fpddoracle.pp', DatadictOSes-SqldbWithoutOracleOSes);
+    T:=P.Targets.AddUnit('fpddoracle.pp', DatadictOSes);
       with T.Dependencies do
         begin
           AddUnit('sqldb');
@@ -474,7 +473,7 @@ begin
           AddUnit('fpddsqldb');
           AddUnit('mssqlconn');
         end;
-    T:=P.Targets.AddUnit('fpddregstd.pp', (DatadictOSes*MSSQLOses)-SqldbWithoutOracleOSes);
+    T:=P.Targets.AddUnit('fpddregstd.pp', (DatadictOSes*MSSQLOses));
       with T.Dependencies do
         begin
           AddUnit('fpdatadict');
@@ -693,7 +692,7 @@ begin
           AddUnit('bufdataset');
           AddUnit('dbconst');
         end;
-    T:=P.Targets.AddUnit('oracleconnection.pp', SqldbConnectionOSes-SqldbWithoutOracleOSes);
+    T:=P.Targets.AddUnit('oracleconnection.pp', SqldbConnectionOSes);
     T.ResourceStrings:=true;
       with T.Dependencies do
         begin
@@ -817,7 +816,3 @@ begin
   Installer.Run;
 end.
 {$endif ALLPACKAGES}
-
-
-
-
diff --git a/packages/fcl-db/src/Dataset.txt b/packages/fcl-db/src/Dataset.txt
index a9058eb124..9d7e3dd862 100644
--- a/packages/fcl-db/src/Dataset.txt
+++ b/packages/fcl-db/src/Dataset.txt
@@ -43,7 +43,7 @@ The following constants are userd when handling this array:
 
 FBufferCount :   The number of buffers allocated, minus one.
 FRecordCount :   The number of buffers that is actually filled in.
-FActiveBuffer :  The index of the active record in TDataset.
+FActiveRecord :  The index of the active record in TDataset.
 FCurrentRecord : The index of the supposedly active record in the underlying
                  dataset (ie. the index in the last call to SetToInternalRecord)
                  Call CursorPosChanged to reset FCurrentRecord if the active
@@ -60,7 +60,7 @@ So the following picture follows from this:
    ...
 |               |
 +---------------+
-| FActivebuffer |
+| FActiveRecord |
 +---------------+
 |               |
     ...
diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas
index ff34c5259c..8f36e76626 100644
--- a/packages/fcl-db/src/base/bufdataset.pas
+++ b/packages/fcl-db/src/base/bufdataset.pas
@@ -159,7 +159,7 @@ type
     procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
     function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
     function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : integer; virtual;
-    function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; inline;
+    function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
 
     procedure InitialiseIndex; virtual; abstract;
 
@@ -228,6 +228,7 @@ type
     procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
     procedure GotoBookmark(const ABookmark : PBufBookmark); override;
     function CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; override;
+    function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; override;
     procedure InitialiseIndex; override;
 
     procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
@@ -496,6 +497,7 @@ type
     function GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludePrior : boolean = false; AFindNext : boolean = false) : boolean;
     function GetRecordUpdateBufferCached(const ABookmark : TBufBookmark; IncludePrior : boolean = false) : boolean;
     function GetActiveRecordUpdateBuffer : boolean;
+    procedure CancelRecordUpdateBuffer(AUpdateBufferIndex: integer; var ABookmark: TBufBookmark);
     procedure ParseFilter(const AFilter: string);
 
     function GetIndexDefs : TIndexDefs;
@@ -575,6 +577,7 @@ type
     procedure ApplyUpdates; virtual; overload;
     procedure ApplyUpdates(MaxErrors: Integer); virtual; overload;
     procedure MergeChangeLog;
+    procedure RevertRecord;
     procedure CancelUpdates; virtual;
     destructor Destroy; override;
     function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
@@ -1677,6 +1680,11 @@ begin
     Result := -Result;
 end;
 
+function TDoubleLinkedBufIndex.SameBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
+begin
+  Result := Assigned(ABookmark1) and Assigned(ABookmark2) and (ABookmark1^.BookmarkData = ABookmark2^.BookmarkData);
+end;
+
 procedure TDoubleLinkedBufIndex.InitialiseIndex;
 begin
   // Do nothing
@@ -2401,90 +2409,106 @@ begin
   raise EDatabaseError.Create(SApplyRecNotSupported);
 end;
 
-procedure TCustomBufDataset.CancelUpdates;
-var StoreRecBM     : TBufBookmark;
-  procedure CancelUpdBuffer(var AUpdBuffer : TRecUpdateBuffer);
-  var
-    TmpBuf         : TRecordBuffer;
-    StoreUpdBuf    : integer;
-    Bm             : TBufBookmark;
-  begin
-    with AUpdBuffer do
+procedure TCustomBufDataset.CancelRecordUpdateBuffer(AUpdateBufferIndex: integer; var ABookmark: TBufBookmark);
+var
+  ARecordBuffer: TRecordBuffer;
+  NBookmark    : TBufBookmark;
+  i            : integer;
+begin
+  with FUpdateBuffer[AUpdateBufferIndex] do
+    if Assigned(BookmarkData.BookmarkData) then // this is used to exclude buffers which are already handled
       begin
-      if Not assigned(BookmarkData.BookmarkData) then
-        exit;// this is used to exclude buffers which are already handled
-      Case UpdateKind of
-      ukModify:
-        begin
-        FCurrentIndex.GotoBookmark(@BookmarkData);
-        move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
-        FreeRecordBuffer(OldValuesBuffer);
-        end;
-      ukDelete:
-        if (assigned(OldValuesBuffer)) then
+      case UpdateKind of
+        ukModify:
           begin
-          FCurrentIndex.GotoBookmark(@NextBookmarkData);
-          FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
-          FCurrentIndex.ScrollBackward;
-          move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
-
-          {for x := length(FUpdateBuffer)-1 downto 0 do
-            begin
-            if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
-              CancelUpdBuffer(FUpdateBuffer[x]);
-            end;}
+          FCurrentIndex.GotoBookmark(@BookmarkData);
+          move(TRecordBuffer(OldValuesBuffer)^, TRecordBuffer(FCurrentIndex.CurrentBuffer)^, FRecordSize);
           FreeRecordBuffer(OldValuesBuffer);
-          inc(FBRecordCount);
-          end  ;
-      ukInsert:
-        begin
-        // Process all update buffers linked to this record before this record is removed
-        StoreUpdBuf:=FCurrentUpdateBuffer;
-        Bm := BookmarkData;
-        BookmarkData.BookmarkData:=nil; // Avoid infinite recursion...
-        if GetRecordUpdateBuffer(Bm,True,False) then
-          begin
-          repeat
-            if (FCurrentUpdateBuffer<>StoreUpdBuf) then
-              CancelUpdBuffer(FUpdateBuffer[FCurrentUpdateBuffer]);
-          until not GetRecordUpdateBuffer(Bm,True,True);
           end;
-        FCurrentUpdateBuffer:=StoreUpdBuf;
-
-        FCurrentIndex.GotoBookmark(@Bm);
-        TmpBuf:=FCurrentIndex.CurrentRecord;
-        // resync won't work if the currentbuffer is freed...
-        if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
+        ukDelete:
+          if (assigned(OldValuesBuffer)) then
+            begin
+            FCurrentIndex.GotoBookmark(@NextBookmarkData);
+            FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
+            FCurrentIndex.ScrollBackward;
+            move(TRecordBuffer(OldValuesBuffer)^, TRecordBuffer(FCurrentIndex.CurrentBuffer)^, FRecordSize);
+            FreeRecordBuffer(OldValuesBuffer);
+            inc(FBRecordCount);
+            end;
+        ukInsert:
           begin
-          GotoBookmark(@StoreRecBM);
-          if ScrollForward = grEOF then
-            if ScrollBackward = grBOF then
-              ScrollLast;  // last record will be removed from index, so move to spare record
-          StoreCurrentRecIntoBookmark(@StoreRecBM);
+          FCurrentIndex.GotoBookmark(@BookmarkData);
+          ARecordBuffer := FCurrentIndex.CurrentRecord;
+
+          // Find next record's bookmark
+          FCurrentIndex.DoScrollForward;
+          FCurrentIndex.StoreCurrentRecIntoBookmark(@NBookmark);
+          // Process (re-link) all update buffers linked to this record before this record is removed
+          //  Modified record #1, which is later deleted can be linked to another inserted record #2. In this case deleted record #1 precedes inserted #2 in update buffer.
+          //  Deleted records, which are deleted after this record is inserted are in update buffer after this record.
+          //  if we need revert inserted record which is linked from another deleted records, then we must re-link these records
+          for i:=0 to high(FUpdateBuffer) do
+            if (FUpdateBuffer[i].UpdateKind = ukDelete) and
+               (FUpdateBuffer[i].NextBookmarkData.BookmarkData = BookmarkData.BookmarkData) then
+              FUpdateBuffer[i].NextBookmarkData := NBookmark;
+
+          // ReSync won't work if the CurrentBuffer is freed ... so in this case move to next/prior record
+          if FCurrentIndex.SameBookmarks(@BookmarkData,@ABookmark) then with FCurrentIndex do
+            begin
+            GotoBookmark(@ABookmark);
+            if ScrollForward = grEOF then
+              if ScrollBackward = grBOF then
+                ScrollLast;  // last record will be removed from index, so move to spare record
+            StoreCurrentRecIntoBookmark(@ABookmark);
+            end;
+
+          RemoveRecordFromIndexes(BookmarkData);
+          FreeRecordBuffer(ARecordBuffer);
+          dec(FBRecordCount);
           end;
-        RemoveRecordFromIndexes(Bm);
-        FreeRecordBuffer(TmpBuf);
-        dec(FBRecordCount);
-        end;
       end;
-      BookmarkData.BookmarkData:=nil;
+      BookmarkData.BookmarkData := nil;
       end;
-  end;
+end;
 
-var r              : Integer;
+procedure TCustomBufDataset.RevertRecord;
+var
+  ABookmark : TBufBookmark;
+begin
+  CheckBrowseMode;
+
+  if GetActiveRecordUpdateBuffer then
+  begin
+    FCurrentIndex.StoreCurrentRecIntoBookmark(@ABookmark);
+
+    CancelRecordUpdateBuffer(FCurrentUpdateBuffer, ABookmark);
+
+    // remove update record of current record from update-buffer array
+    Move(FUpdateBuffer[FCurrentUpdateBuffer+1], FUpdateBuffer[FCurrentUpdateBuffer], (High(FUpdateBuffer)-FCurrentUpdateBuffer)*SizeOf(TRecUpdateBuffer));
+    SetLength(FUpdateBuffer, High(FUpdateBuffer));
+
+    FCurrentIndex.GotoBookmark(@ABookmark);
+
+    Resync([]);
+  end;
+end;
 
+procedure TCustomBufDataset.CancelUpdates;
+var
+  ABookmark : TBufBookmark;
+  r         : Integer;
 begin
   CheckBrowseMode;
 
   if Length(FUpdateBuffer) > 0 then
     begin
-    FCurrentIndex.StoreCurrentRecIntoBookmark(@StoreRecBM);
-    for r := Length(FUpdateBuffer) - 1 downto 0 do
-      CancelUpdBuffer(FUpdateBuffer[r]);
+    FCurrentIndex.StoreCurrentRecIntoBookmark(@ABookmark);
 
-    SetLength(FUpdateBuffer,0);
+    for r := High(FUpdateBuffer) downto 0 do
+      CancelRecordUpdateBuffer(r, ABookmark);
+    SetLength(FUpdateBuffer, 0);
     
-    FCurrentIndex.GotoBookmark(@StoreRecBM);
+    FCurrentIndex.GotoBookmark(@ABookmark);
     
     Resync([]);
     end;
@@ -2635,7 +2659,7 @@ begin
       FAutoIncField.AsInteger := FAutoIncValue;
       inc(FAutoIncValue);
       end;
-    // The active buffer is the newly created TDataset record,
+    // The active buffer is the newly created TDataSet record,
     // from which the bookmark is set to the record where the new record should be
     // inserted
     ABookmark := PBufBookmark(ActiveBuffer + FRecordSize);
@@ -2653,12 +2677,13 @@ begin
           // insert (before current record)
           FIndexes[i].GotoBookmark(ABookmark);
 
+        // insert new record before current record
         FIndexes[i].InsertRecordBeforeCurrentRecord(ABuff);
         // newly inserted record becomes current record
         FIndexes[i].ScrollBackward;
       end;
 
-    // Link the newly created record buffer to the newly created TDataset record
+    // Link the newly created record buffer to the newly created TDataSet record
     FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
     ABookmark^.BookmarkFlag := bfInserted;
 
@@ -2679,12 +2704,11 @@ begin
 
     if State = dsEdit then
       begin
-      // Create an oldvalues buffer with the old values of the record
-      FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
-      with FCurrentIndex do
-        // Move only the real data
-        move(CurrentBuffer^,FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
+      // Create an OldValues buffer with the old values of the record
       FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukModify;
+      FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
+      // Move only the real data
+      move(FCurrentIndex.CurrentBuffer^, FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^, FRecordSize);
       end
     else
       begin
@@ -2808,7 +2832,7 @@ begin
     Result := 0
   else
     begin
-    InternalSetToRecord(ActiveBuffer);
+    UpdateCursorPos;
     Result := FCurrentIndex.RecNo;
     end;
 end;
@@ -3018,12 +3042,10 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
       begin
       AStoreUpdBuf:=FCurrentUpdateBuffer;
       if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
-        begin
         repeat
           if FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
             StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
-        until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
-        end;
+        until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True);
       FCurrentUpdateBuffer:=AStoreUpdBuf;
       AThisRowState := [rsvDeleted];
       end
@@ -3036,16 +3058,16 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
       FDatasetReader.StoreRecord(AThisRowState,FCurrentUpdateBuffer);
   end;
 
-  procedure HandleUpdateBuffersFromRecord(AFirstCall : boolean;ARecBookmark : TBufBookmark; var ARowState: TRowState);
+  procedure HandleUpdateBuffersFromRecord(AFindNext : boolean; ARecBookmark : TBufBookmark; var ARowState: TRowState);
   var StoreUpdBuf1,StoreUpdBuf2 : Integer;
   begin
-    if AFirstCall then ARowState:=[];
-    if GetRecordUpdateBuffer(ARecBookmark,True,not AFirstCall) then
+    if not AFindNext then ARowState:=[];
+    if GetRecordUpdateBuffer(ARecBookmark,True,AFindNext) then
       begin
       if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete then
         begin
         StoreUpdBuf1:=FCurrentUpdateBuffer;
-        HandleUpdateBuffersFromRecord(False,ARecBookmark,ARowState);
+        HandleUpdateBuffersFromRecord(True,ARecBookmark,ARowState);
         StoreUpdBuf2:=FCurrentUpdateBuffer;
         FCurrentUpdateBuffer:=StoreUpdBuf1;
         StoreUpdateBuffer(FUpdateBuffer[StoreUpdBuf1], ARowState);
@@ -3054,7 +3076,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
       else
         begin
         StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
-        HandleUpdateBuffersFromRecord(False,ARecBookmark,ARowState);
+        HandleUpdateBuffersFromRecord(True,ARecBookmark,ARowState);
         end;
       end
   end;
@@ -3078,7 +3100,9 @@ begin
       begin
       RowState:=[];
       FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
-      HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
+      // updates related to current record are stored first
+      HandleUpdateBuffersFromRecord(False,ABookmark^,RowState);
+      // now store current record
       FFilterBuffer:=FCurrentIndex.CurrentBuffer;
       if RowState=[] then
         FDatasetReader.StoreRecord([])
@@ -3094,7 +3118,7 @@ begin
       end;
     // There could be an update buffer linked to the last (spare) record
     FCurrentIndex.StoreSpareRecIntoBookmark(ABookmark);
-    HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
+    HandleUpdateBuffersFromRecord(False,ABookmark^,RowState);
 
     RestoreState(SavedState);
 
@@ -3233,10 +3257,9 @@ end;
 procedure TCustomBufDataset.IntLoadRecordsFromFile;
 
 var SavedState      : TDataSetState;
-    AddRecordBuffer : boolean;
     ARowState       : TRowState;
     AUpdOrder       : integer;
-    x               : integer;
+    i               : integer;
 
 begin
   CheckBiDirectional;
@@ -3274,9 +3297,6 @@ begin
       FDatasetReader.RestoreRecord;
       FIndexes[0].AddRecord;
       inc(FBRecordCount);
-
-      AddRecordBuffer:=False;
-
       end
     else if rsvDeleted in ARowState then
       begin
@@ -3297,16 +3317,11 @@ begin
       FIndexes[0].RemoveRecordFromIndex(FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
       FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
 
-      for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do
-        if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
-          FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData);
-
-      AddRecordBuffer:=False;
+      for i := FCurrentUpdateBuffer+1 to high(FUpdateBuffer) do
+        if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData, @FUpdateBuffer[i].NextBookmarkData) then
+          FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[i].NextBookmarkData);
       end
     else
-      AddRecordBuffer:=True;
-
-    if AddRecordBuffer then
       begin
       FFilterBuffer:=FIndexes[0].SpareBuffer;
       fillchar(FFilterBuffer^,FNullmaskSize,0);
diff --git a/packages/fcl-db/src/base/database.inc b/packages/fcl-db/src/base/database.inc
index bbf81c9eb2..6d06c9bdea 100644
--- a/packages/fcl-db/src/base/database.inc
+++ b/packages/fcl-db/src/base/database.inc
@@ -525,10 +525,12 @@ begin
     begin
     GetLoginParams(ADatabaseName, AUserName, APassword);
     if Assigned(FOnLogin) then
-      FOnLogin(Self, AUserName, APassword)
+      FOnLogin(Self, AUserName, APassword) // by value
     else if Assigned(LoginDialogExProc) then
-      LoginDialogExProc(ADatabaseName, AUserName, APassword, False);
-    SetLoginParams(ADatabaseName, AUserName, APassword);
+      begin
+      LoginDialogExProc(ADatabaseName, AUserName, APassword, False); // by reference
+      SetLoginParams(ADatabaseName, AUserName, APassword);
+      end;
     end;
 end;
 
@@ -572,7 +574,7 @@ begin
   if IsPublishedProp(Self,'UserName') then
     AUserName := GetStrProp(Self,'UserName');
   if IsPublishedProp(Self,'Password') then
-    APassword := 'Password';
+    APassword := GetStrProp(Self,'Password');
 end;
 
 procedure TCustomConnection.SetLoginParams(const ADatabaseName, AUserName, APassword: string);
diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc
index b27fb5cb57..5c66828ed3 100644
--- a/packages/fcl-db/src/base/dataset.inc
+++ b/packages/fcl-db/src/base/dataset.inc
@@ -763,20 +763,20 @@ begin
   If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
   Result:=GetRecord(FBuffers[FBufferCount],gmNext,True)=grOK;
 
-  if result then
+  if Result then
     begin
       If FRecordCount=0 then ActivateBuffers;
       if FRecordCount=FBufferCount then
         ShiftBuffersBackward
       else
         begin
-          inc(FRecordCount);
+          Inc(FRecordCount);
           FCurrentRecord:=FRecordCount - 1;
           ExchangeBuffers(FBuffers[FCurrentRecord],FBuffers[FBufferCount]);
         end;
     end
   else
-    cursorposchanged;
+    CursorPosChanged;
 {$ifdef dsdebug}
   Writeln ('Result getting next record : ',Result);
 {$endif}
@@ -805,16 +805,16 @@ begin
   CheckBiDirectional;
   If FRecordCount>0 Then SetCurrentRecord(0);
   Result:=GetRecord(FBuffers[FBufferCount],gmPrior,True)=grOK;
-  if result then
+  if Result then
     begin
       If FRecordCount=0 then ActivateBuffers;
       ShiftBuffersForward;
 
       if FRecordCount<FBufferCount then
-        inc(FRecordCount);
+        Inc(FRecordCount);
     end
   else
-    cursorposchanged;
+    CursorPosChanged;
 {$ifdef dsdebug}
   Writeln ('Result getting prior record : ',Result);
 {$endif}
@@ -894,30 +894,30 @@ begin
   else
     Insert;
 
-  for i := 0 to ValuesSize-1 do with values[i] do
-    fields[i].AssignValue(values[i]);
+  for i := 0 to ValuesSize-1 do
+    Fields[i].AssignValue(Values[i]);
   Post;
 
 end;
 
-procedure TDataSet.InitFieldDefsFromfields;
+procedure TDataSet.InitFieldDefsFromFields;
 var i : integer;
 
 begin
-  if FieldDefs.count = 0 then
+  if FieldDefs.Count = 0 then
     begin
     FieldDefs.BeginUpdate;
     try
-      for i := 0 to Fields.Count-1 do with fields[i] do
+      for i := 0 to Fields.Count-1 do with Fields[i] do
         if not (FieldKind in [fkCalculated,fkLookup]) then // Do not add fielddefs for calculated/lookup fields.
           begin
           FFieldDef:=FieldDefs.FieldDefClass.Create(FieldDefs,FieldName,DataType,Size,Required,FieldDefs.Count+1);
           with FFieldDef do
             begin
-            if Required then Attributes := attributes + [faRequired];
-            if ReadOnly then Attributes := attributes + [faReadOnly];
-            if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
-            else if DataType = ftFMTBcd then precision := (fields[i] as TFMTBCDField).Precision;
+            if Required then Attributes := Attributes + [faRequired];
+            if ReadOnly then Attributes := Attributes + [faReadOnly];
+            if DataType = ftBCD then Precision := (Fields[i] as TBCDField).Precision
+            else if DataType = ftFMTBcd then Precision := (Fields[i] as TFMTBCDField).Precision;
             end;
           end;
     finally
@@ -1148,7 +1148,7 @@ begin
     for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
       begin
       DataLink:=TDataLink(TDataSource(FDataSources[i]).DataLinks[j]);
-      if DataLink.BufferCount>ABufferCount then
+      if ABufferCount<DataLink.BufferCount then
         ABufferCount:=DataLink.BufferCount;
       end;
 
@@ -1200,11 +1200,11 @@ begin
 {$ifdef dsdebug}
     Writeln ('   Reallocating memory :',(Value+1)*SizeOf(TRecordBuffer));
 {$endif}
-    ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
+    ReAllocMem(FBuffers,(Value+1)*SizeOf(TRecordBuffer));
 {$ifdef dsdebug}
     Writeln ('   Filling memory :',(Value+1-FBufferCount)*SizeOf(TRecordBuffer));
 {$endif}
-    inc(FBufferCount); // Cause FBuffers[FBufferCount] is already allocated
+    Inc(FBufferCount); // Cause FBuffers[FBufferCount] is already allocated
     FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOf(TRecordBuffer),#0);
 {$ifdef dsdebug}
     Writeln ('   Filled memory');
@@ -1286,7 +1286,7 @@ begin
       bfBOF : InternalFirst;
       bfEOF : InternalLast;
       end;
-    FCurrentRecord:=index;
+    FCurrentRecord:=Index;
     end;
 end;
 
@@ -2165,7 +2165,7 @@ begin
     inc(i);
   FActiveRecord := i;
 // Fill the rest of the buffer
-  getnextrecords;
+  GetNextRecords;
 // If the buffer is not full yet, try to fetch some more prior records
   if FRecordCount < FBufferCount then inc(FActiveRecord,getpriorrecords);
 // That's all folks!
diff --git a/packages/fcl-db/src/base/dsparams.inc b/packages/fcl-db/src/base/dsparams.inc
index b09830ee38..41c57568af 100644
--- a/packages/fcl-db/src/base/dsparams.inc
+++ b/packages/fcl-db/src/base/dsparams.inc
@@ -1076,7 +1076,7 @@ Var
   S : TFileStream;
 
 begin
-  S:=TFileStream.Create(FileName,fmOpenRead);
+  S:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
   Try
     LoadFromStream(S,BlobType);
   Finally
@@ -1096,8 +1096,8 @@ begin
     Position:=0;
     SetLength(Temp,Size);
     ReadBuffer(Pointer(Temp)^,Size);
-    FValue:=Temp;
     end;
+  Value:=Temp;
 end;
 
 Procedure TParam.SetBlobData(Buffer: Pointer; ASize: Integer);
diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc
index ae5910227e..ffa3819ced 100644
--- a/packages/fcl-db/src/base/fields.inc
+++ b/packages/fcl-db/src/base/fields.inc
@@ -1481,12 +1481,13 @@ var L : Longint;
     P : PLongint;
 
 begin
+  L:=0;
   P:=@L;
   Result:=GetData(P);
   If Result then
-    Case Datatype of
-      ftInteger,ftAutoinc  : AValue:=Plongint(P)^;
-      ftWord               : AValue:=Pword(P)^;
+    Case DataType of
+      ftInteger,ftAutoInc  : AValue:=PLongint(P)^;
+      ftWord               : AValue:=PWord(P)^;
       ftSmallint           : AValue:=PSmallint(P)^;
     end;
 end;
diff --git a/packages/fcl-db/src/sqldb/interbase/fbadmin.pp b/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
index e1d2d667af..87f3139597 100644
--- a/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
+++ b/packages/fcl-db/src/sqldb/interbase/fbadmin.pp
@@ -27,7 +27,7 @@ unit FBAdmin;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$mode objfpc}{$H+}
@@ -47,11 +47,11 @@ uses
 
 type
   TIBBackupOption=(IBBkpVerbose,IBBkpIgnoreChecksums,IBBkpIgnoreLimbo,IBBkpMetadataOnly,
-     IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert);
+     IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert,IBBkpWait);
   TIBBackupOptions= set of TIBBackupOption;
   TIBRestoreOption=(IBResVerbose,IBResDeactivateIdx,IBResNoShadow,IBResNoValidity,
      IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,IBResAMReadWrite,
-     IBFixFssData, IBFixFssMeta);
+     IBFixFssData, IBFixFssMeta,IBResWait);
   TIBRestoreOptions= set of TIBRestoreOption;
   TServiceProtocol=(IBSPLOCAL,IBSPTCPIP,IBSPNETBEUI,IBSPNAMEDPIPE);
   TIBOnOutput= procedure(Sender: TObject; msg: string; IBAdminAction: string) of object;
@@ -82,6 +82,7 @@ type
     FSvcHandle: isc_svc_handle;
     FUseExceptions: boolean;
     FUser: string;
+    FWaitInterval: Integer;
     function CheckConnected(ProcName: string):boolean;
     procedure CheckError(ProcName : string; Status : PISC_STATUS);
     function GetDBInfo:boolean;
@@ -94,7 +95,6 @@ type
     function IBSPBParamSerialize(isccode:byte;value:longint):string;
     function MakeBackupOptions(options:TIBBackupOptions):longint;
     function MakeRestoreOptions(options:TIBRestoreOptions):longint;
-
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -140,6 +140,12 @@ type
     function GetUsers(Users:TStrings):boolean;
     //Get database server log file
     function GetDatabaseLog:boolean;
+    // For Backup, Restore this will check if the service call is still running.
+    function ServiceRunning: Boolean;
+    // Wait till the service stops running, or until aTimeout (in milliseconds) is reached.
+    // Return true if the service stopped, false if timeout reached.
+    // WaitInterval is the interval (in milliseconds) between ServiceRunning calls.
+    function WaitForServiceCompletion(aTimeOut: Integer): Boolean;
     //Get database statistics
     function GetDatabaseStats(Database:string;Options:TIBStatOptions;TableNames:String = ''): boolean;
     //Database server version
@@ -183,11 +189,15 @@ type
     //Event handler for Service output messages
     //Used in Backup and Restore operations and GetLog
     property OnOutput: TIBOnOutput read FOnOutput write FOnOutput;
+    // Interval (in milliseconds) to sleep while waiting for the service operation to end.
+    Property WaitInterval : Integer Read FWaitInterval Write FWaitInterval;
   end;
 
 
 implementation
 
+uses dateutils;
+
 resourcestring
   SErrNotConnected = '%s : %s : Not connected.';
   SErrError = '%s : %s : %s';
@@ -383,6 +393,7 @@ end;
 destructor TFBAdmin.Destroy;
 begin
   if FSvcHandle<>FB_API_NULLHANDLE then
+  WaitInterval:=100;
     DisConnect;
   FOutput.Destroy;
   inherited Destroy;
@@ -454,7 +465,9 @@ begin
     exit;
     end;
   if IBBkpVerbose in Options then
-    result:=GetOutput('Backup');
+    result:=GetOutput('Backup')
+  else if (IBBkpWait in Options) then
+    WaitForServiceCompletion(0);
 end;
 
 function TFBAdmin.BackupMultiFile(Database: string; Filenames: TStrings;
@@ -483,9 +496,52 @@ begin
     exit;
     end;
   if IBBkpVerbose in Options then
-    result:=GetOutput('BackupMultiFile');
+    result:=GetOutput('BackupMultiFile')
+  else if (IBBkpWait in Options) then
+    WaitForServiceCompletion(0);
 end;
 
+Function TFBAdmin.ServiceRunning : Boolean;
+
+const
+  BUFFERSIZE=1000;
+
+var
+  res:integer;
+  buffer: string;
+  spb:string;
+
+begin
+  FOutput.Clear;
+  spb:=chr(isc_info_svc_running);
+  setlength(buffer,BUFFERSIZE);
+  result:=isc_service_query(@FStatus[0], @FSvcHandle, nil, 0, nil, length(spb),
+          @spb[1],BUFFERSIZE,@buffer[1])=0;
+  if Not Result then
+    CheckError('ServiceRunning',FSTatus);
+  if (Buffer[1]=Char(isc_info_svc_running)) then
+    begin
+    res:=isc_vax_integer(@Buffer[2],4);
+    Result:=res=1;
+    end
+  else
+    IBRaiseError(0,'%s: Service status detection returned wrong result',[self.Name]);
+end;
+
+Function TFBAdmin.WaitForServiceCompletion(aTimeOut : Integer) : Boolean;
+
+Var
+  N : TDateTime;
+
+begin
+  N:=Now;
+  Repeat
+    Sleep(WaitInterval);
+    Result:=not ServiceRunning;
+  until Result or ((aTimeOut<>0) and (MilliSecondsBetween(Now,N)>aTimeOut*WaitInterval));
+end;
+
+
 function TFBAdmin.Restore(Database, Filename: string;
   Options: TIBRestoreOptions; RoleName: string): boolean;
 var
@@ -524,7 +580,9 @@ begin
     exit;
     end;
   if IBResVerbose in Options then
-    result:=GetOutput('Restore');
+    result:=GetOutput('Restore')
+  else if IBResWait in Options then
+    WaitForServiceCompletion(0);
 end;
 
 
diff --git a/packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp b/packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp
index 6f8c856307..2bd4427851 100644
--- a/packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp
+++ b/packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp
@@ -27,7 +27,7 @@ unit FBEventMonitor;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$mode objfpc}{$H+}
diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
index 2c1964c827..9081a278e4 100644
--- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
+++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
@@ -154,8 +154,10 @@ Type
     function RefreshLastInsertID(Query : TCustomSQLQuery; Field : TField): Boolean; override;
   Public
     constructor Create(AOwner : TComponent); override;
+{$IFNDEF MYSQL50_UP}
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
+{$ENDIF}
     function GetConnectionInfo(InfoType:TConnInfoType): string; override;
     Function GetInsertID: int64;
     procedure CreateDB; override;
@@ -1199,6 +1201,7 @@ begin
   FMySQL := Nil;
 end;
 
+{$IFNDEF MYSQL50_UP}
 procedure TConnectionName.GetFieldNames(const TableName: string; List: TStrings);
 begin
   GetDBInfo(stColumns,TableName,'field',List);
@@ -1208,6 +1211,7 @@ procedure TConnectionName.GetTableNames(List: TStrings; SystemTables: Boolean);
 begin
   GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
 end;
+{$ENDIF}
 
 function TConnectionName.GetConnectionInfo(InfoType: TConnInfoType): string;
 begin
@@ -1294,13 +1298,19 @@ function TConnectionName.GetSchemaInfoSQL(SchemaType: TSchemaType;
 
 begin
   case SchemaType of
+    {$IFDEF MYSQL50_UP}
+    stTables     : result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_TYPE IN (''BASE TABLE'',''VIEW'')';
+    stColumns    : result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_NAME='+QuotedStr(SchemaObjectName);
+    {$ELSE}
     stTables     : result := 'show tables';
     stColumns    : result := 'show columns from ' + EscapeString(SchemaObjectName);
+    {$ENDIF}
   else
-    DatabaseError(SMetadataUnavailable)
+                   result := inherited;
   end; {case}
 end;
 
+
 { TMySQLConnectionDef }
 
 class function TMySQLConnectionDef.TypeName: String;
diff --git a/packages/fcl-db/src/sqldb/odbc/odbcconn.pas b/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
index dc3f5be83f..dd6aa2fcd7 100644
--- a/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
+++ b/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
@@ -298,7 +298,7 @@ end;
 constructor TODBCConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-  FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
+  FConnOptions := FConnOptions + [sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash];
 end;
 
 function TODBCConnection.StrToStatementType(s : string) : TStatementType;
diff --git a/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp b/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp
index fdec42a959..a1f85ce683 100644
--- a/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp
+++ b/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp
@@ -27,7 +27,7 @@ unit PQEventMonitor;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$mode objfpc}{$H+}
diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp
index 1aea8488f6..390cd67073 100644
--- a/packages/fcl-db/src/sqldb/sqldb.pp
+++ b/packages/fcl-db/src/sqldb/sqldb.pp
@@ -290,7 +290,7 @@ type
     property HostName : string Read FHostName Write FHostName;
     Property OnLog : TDBLogNotifyEvent Read FOnLog Write FOnLog;
     Property LogEvents : TDBEventTypes Read FLogEvents Write FLogEvents Default LogAllEvents;
-    Property Options : TSQLConnectionOptions Read FOptions Write SetOptions;
+    Property Options : TSQLConnectionOptions Read FOptions Write SetOptions default [];
     Property Role :  String read FRole write FRole;
     property Connected;
     property DatabaseName;
@@ -340,7 +340,7 @@ type
     property Action : TCommitRollbackAction read FAction write FAction Default caRollBack;
     property Database;
     property Params : TStringList read FParams write SetParams;
-    Property Options : TSQLTransactionOptions Read FOptions Write SetOptions;
+    Property Options : TSQLTransactionOptions Read FOptions Write SetOptions default [];
   end;
 
 
@@ -578,6 +578,8 @@ type
     property AfterCancel;
     property BeforeDelete;
     property AfterDelete;
+    property BeforeRefresh;
+    property AfterRefresh;
     property BeforeScroll;
     property AfterScroll;
     property OnCalcFields;
@@ -596,7 +598,7 @@ type
     property UpdateSQL : TStringList read FUpdateSQL write SetUpdateSQL;
     property DeleteSQL : TStringList read FDeleteSQL write SetDeleteSQL;
     property RefreshSQL : TStringList read FRefreshSQL write SetRefreshSQL;
-    Property Options : TSQLQueryOptions Read FOptions Write SetOptions;
+    Property Options : TSQLQueryOptions Read FOptions Write SetOptions default [];
     property Params : TParams read GetParams Write SetParams;
     Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
     property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
@@ -630,6 +632,7 @@ type
     Property AfterInsert;
     Property AfterOpen;
     Property AfterPost;
+    Property AfterRefresh;
     Property AfterScroll;
     Property BeforeCancel;
     Property BeforeClose;
@@ -638,6 +641,7 @@ type
     Property BeforeInsert;
     Property BeforeOpen;
     Property BeforePost;
+    Property BeforeRefresh;
     Property BeforeScroll;
     Property OnCalcFields;
     Property OnDeleteError;
@@ -1670,7 +1674,7 @@ Var
   P : TParam;
 
 begin
-  if not LogEvent(detParamValue) then
+  if not LogEvent(detParamValue) or not Assigned(AParams) then
     Exit;
   For P in AParams do
     begin
@@ -1857,7 +1861,7 @@ Var
   Where : String;
 
 begin
-  Result:=Query.RefreshSQL.Text;
+  Result:=Trim(Query.RefreshSQL.Text);
   if (Result='') then
     begin
     Where:='';
@@ -1908,7 +1912,7 @@ var
 
 begin
   qry:=Nil;
-  ReturningClause:=(sqSupportReturning in ConnOptions) and not (sqoRefreshUsingSelect in Query.Options) and (Query.RefreshSQL.Count=0);
+  ReturningClause:=(sqSupportReturning in ConnOptions) and not (sqoRefreshUsingSelect in Query.Options) and (Trim(Query.RefreshSQL.Text)='');
   case UpdateKind of
     ukInsert : begin
                s := Trim(Query.FInsertSQL.Text);
@@ -1984,6 +1988,8 @@ function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObject
 
 begin
   case SchemaType of
+    stTables    : Result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_TYPE=''BASE TABLE''';
+    stColumns   : Result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME='+QuotedStr(SchemaObjectName);
     stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
     stSchemata  : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
     stSequences : Result := 'SELECT * FROM INFORMATION_SCHEMA.SEQUENCES';
@@ -2491,7 +2497,7 @@ Var
   DoReturning : Boolean;
 
 begin
-  Result:=(FRefreshSQL.Count<>0);
+  Result:=(Trim(FRefreshSQL.Text)<>'');
   DoReturning:=(sqSupportReturning in SQLConnection.ConnOptions) and not (sqoRefreshUsingSelect in Options);
   if Not (Result or DoReturning) then
     begin
diff --git a/packages/fcl-db/src/sqldb/sqlite/sqlite3backup.pas b/packages/fcl-db/src/sqldb/sqlite/sqlite3backup.pas
index d4588110c6..1f690c1ff6 100644
--- a/packages/fcl-db/src/sqldb/sqlite/sqlite3backup.pas
+++ b/packages/fcl-db/src/sqldb/sqlite/sqlite3backup.pas
@@ -27,7 +27,7 @@ unit sqlite3backup;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 {$mode objfpc}{$H+}
 
diff --git a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
index efbbc67201..9c49c92fe2 100644
--- a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
+++ b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
@@ -409,13 +409,14 @@ Const
 
 procedure TSQLite3Connection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
 var
- i, fi : integer;
- FN, FD, PrimaryKeyFields : string;
- ft1   : TFieldType;
+ st : psqlite3_stmt;
+ i, j, NotNull : integer;
+ FN, FD, PrimaryKeyFields : AnsiString;
+ FT : TFieldType;
  size1, size2 : integer;
- st    : psqlite3_stmt;
+ CN: PAnsiChar;
 
- function GetPrimaryKeyFields: string;
+ function GetPrimaryKeyFields: AnsiString;
  var IndexDefs: TServerIndexDefs;
      i: integer;
  begin
@@ -432,7 +433,7 @@ var
    Result := '';
  end;
 
- function ExtractPrecisionAndScale(decltype: string; var precision, scale: integer): boolean;
+ function ExtractPrecisionAndScale(decltype: AnsiString; var precision, scale: integer): boolean;
  var p: integer;
  begin
    p:=pos('(', decltype);
@@ -459,34 +460,34 @@ var
 begin
   PrimaryKeyFields := GetPrimaryKeyFields;
   st:=TSQLite3Cursor(cursor).fstatement;
-  for i:= 0 to sqlite3_column_count(st) - 1 do 
+  for i := 0 to sqlite3_column_count(st) - 1 do
     begin
-    FN:=sqlite3_column_name(st,i);
-    FD:=uppercase(sqlite3_column_decltype(st,i));
-    ft1:= ftUnknown;
-    size1:= 0;
-    for fi := 1 to FieldMapCount do if pos(FieldMap[fi].N,FD)=1 then
+    FN := sqlite3_column_name(st,i);
+    FD := uppercase(sqlite3_column_decltype(st,i));
+    FT := ftUnknown;
+    for j := 1 to FieldMapCount do if pos(FieldMap[j].N,FD)=1 then
       begin
-      ft1:=FieldMap[fi].t;
+      FT:=FieldMap[j].t;
       break;
       end;
     // Column declared as INTEGER PRIMARY KEY [AUTOINCREMENT] becomes ROWID for given table
     // declared data type must be INTEGER (not INT, BIGINT, NUMERIC etc.)
     if (FD='INTEGER') and SameText(FN, PrimaryKeyFields) then
-      ft1:=ftAutoInc;
+      FT:=ftAutoInc;
     // In case of an empty fieldtype (FD='', which is allowed and used in calculated
     // columns (aggregates) and by pragma-statements) or an unknown fieldtype,
     // use the field's affinity:
-    if ft1=ftUnknown then
+    if FT=ftUnknown then
       case TStorageType(sqlite3_column_type(st,i)) of
-        stInteger: ft1:=ftLargeInt;
-        stFloat:   ft1:=ftFloat;
-        stBlob:    ft1:=ftBlob;
-        else       ft1:=ftString;
+        stInteger: FT:=ftLargeInt;
+        stFloat:   FT:=ftFloat;
+        stBlob:    FT:=ftBlob;
+        else       FT:=ftString;
       end;
     // handle some specials.
     size1:=0;
-    case ft1 of
+    size2:=0;
+    case FT of
       ftString,
       ftFixedChar,
       ftFixedWideChar,
@@ -504,13 +505,22 @@ begin
                  size1 := 0;               //sql: if a scale is omitted then scale is 0
                  ExtractPrecisionAndScale(FD, size2, size1);
                  if (size2<=18) and (size1=0) then
-                   ft1:=ftLargeInt
+                   FT:=ftLargeInt
                  else if (size2-size1>MaxBCDPrecision-MaxBCDScale) or (size1>MaxBCDScale) then
-                   ft1:=ftFmtBCD;
+                   FT:=ftFmtBCD;
                end;
       ftUnknown : DatabaseErrorFmt('Unknown or unsupported data type %s of column %s', [FD, FN]);
     end; // Case
-    FieldDefs.Add(FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
+    // check if SQLite is compiled with SQLITE_ENABLE_COLUMN_METADATA
+    if Assigned(sqlite3_column_origin_name) then
+      CN := sqlite3_column_origin_name(st,i)
+    else
+      CN := nil;
+    // check only for physical table columns (not computed)
+    // is column declared as NOT NULL ? (table name parameter (3rd) must be not nil)
+    if not (Assigned(CN) and (sqlite3_table_column_metadata(fhandle, sqlite3_column_database_name(st,i), sqlite3_column_table_name(st,i), CN, nil, nil, @NotNull, nil, nil) = SQLITE_OK)) then
+      NotNull := 0;
+    FieldDefs.Add(FieldDefs.MakeNameUnique(FN), FT, size1, NotNull=1, i+1);
     end;
 end;
 
@@ -885,8 +895,8 @@ end;
 procedure TSQLite3Connection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
 var
   artableinfo, arindexlist, arindexinfo: TArrayStringArray;
-  il,ii: integer;
-  IndexName: string;
+  i,il,ii: integer;
+  DbName, IndexName: string;
   IndexOptions: TIndexOptions;
   PKFields, IXFields: TStrings;
 
@@ -907,14 +917,27 @@ begin
   IXFields:=TStringList.Create;
   IXFields.Delimiter:=';';
 
+  //check for multipart unquoted identifier: DatabaseName.TableName
+  if Pos('"',TableName) = 0 then
+    i := Pos('.',TableName)
+  else
+    i := 0;
+  if i>0 then
+    begin
+    DbName := Copy(TableName,1,i);
+    Delete(TableName,1,i);
+    end
+  else
+    DbName := '';
+
   //primary key fields; 5th column "pk" is zero for columns that are not part of PK
-  artableinfo := stringsquery('PRAGMA table_info('+TableName+');');
+  artableinfo := stringsquery('PRAGMA '+DbName+'table_info('+TableName+');');
   for ii:=low(artableinfo) to high(artableinfo) do
     if (high(artableinfo[ii]) >= 5) and (artableinfo[ii][5] >= '1') then
       PKFields.Add(artableinfo[ii][1]);
 
   //list of all table indexes
-  arindexlist:=stringsquery('PRAGMA index_list('+TableName+');');
+  arindexlist:=stringsquery('PRAGMA '+DbName+'index_list('+TableName+');');
   for il:=low(arindexlist) to high(arindexlist) do
     begin
     IndexName:=arindexlist[il][1];
diff --git a/packages/fcl-db/src/sqlite/customsqliteds.pas b/packages/fcl-db/src/sqlite/customsqliteds.pas
index 7acdc98c36..d7ff35e358 100644
--- a/packages/fcl-db/src/sqlite/customsqliteds.pas
+++ b/packages/fcl-db/src/sqlite/customsqliteds.pas
@@ -28,7 +28,7 @@ unit CustomSqliteDS;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$Mode ObjFpc}
diff --git a/packages/fcl-db/src/sqlite/sqlite3ds.pas b/packages/fcl-db/src/sqlite/sqlite3ds.pas
index 953dc07da4..31c1409030 100644
--- a/packages/fcl-db/src/sqlite/sqlite3ds.pas
+++ b/packages/fcl-db/src/sqlite/sqlite3ds.pas
@@ -28,7 +28,7 @@ unit Sqlite3DS;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$mode objfpc}
diff --git a/packages/fcl-db/src/sqlite/sqliteds.pas b/packages/fcl-db/src/sqlite/sqliteds.pas
index af82880c31..d0f90d7e84 100644
--- a/packages/fcl-db/src/sqlite/sqliteds.pas
+++ b/packages/fcl-db/src/sqlite/sqliteds.pas
@@ -28,7 +28,7 @@ unit SqliteDS;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$mode objfpc}
diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas
index 02956a39cb..7d125dc4ed 100644
--- a/packages/fcl-db/tests/sqldbtoolsunit.pas
+++ b/packages/fcl-db/tests/sqldbtoolsunit.pas
@@ -196,6 +196,7 @@ begin
     UserName := dbuser;
     Password := dbpassword;
     HostName := dbhostname;
+    CharSet := dbcharset;
     if dblogfilename<>'' then
     begin
       LogEvents:=[detCustom,detCommit,detExecute,detRollBack];
@@ -357,6 +358,11 @@ begin
       testStringValues[i] := TrimRight(testStringValues[i]);
     end;
 
+  if SQLServerType in [ssMSSQL, ssSQLite, ssSybase] then
+    // Some DB's do not support sql compliant boolean data type.
+    for i := 0 to testValuesCount-1 do
+      testValues[ftBoolean, i] := BoolToStr(testBooleanValues[i], '1', '0');
+
   if SQLServerType in [ssMySQL] then
     begin
     // Some DB's do not support milliseconds in datetime and time fields.
@@ -498,46 +504,35 @@ begin
           begin
           sql := sql + ',F' + Fieldtypenames[FType];
           if testValues[FType,CountID] <> '' then
-            case FType of
-              ftBlob, ftBytes, ftGraphic, ftVarBytes:
-                if SQLServerType in [ssOracle] then
-                  // Oracle does not accept string literals in blob insert statements
-                  // convert 'DEADBEEF' hex literal to binary:
-                    sql1 := sql1 + ', HEXTORAW(' + QuotedStr(String2Hex(testValues[FType,CountID])) + ') '
-                  else // other dbs have no problems with the original string values
-                    sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
-              ftCurrency:
-                sql1 := sql1 + ',' + testValues[FType,CountID];
-              ftDate:
-                // Oracle requires date conversion; otherwise
-                // ORA-01861: literal does not match format string
-                if SQLServerType in [ssOracle] then
-                  // ANSI/ISO date literal:
-                  sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID])
-                else
-                  sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
-              ftDateTime:
-                // similar to ftDate handling
-                if SQLServerType in [ssOracle] then
-                begin
-                  // Could be a real date+time or only date. Does not consider only time.
-                  if pos(' ',testValues[FType,CountID])>0 then
-                    sql1 := sql1 + ', TIMESTAMP ' + QuotedStr(testValues[FType,CountID])
-                  else
-                    sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID]);
-                end
-                else
-                  sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
-              ftTime:
-                // similar to ftDate handling
-                if SQLServerType in [ssOracle] then
-                  // More or less arbitrary default time; there is no time-only data type in Oracle.
-                  sql1 := sql1 + ', TIMESTAMP ' + QuotedStr('0001-01-01 '+testValues[FType,CountID])
-                else
-                  sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID]);
-              else
-                sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
+            if FType in [ftBoolean, ftCurrency] then
+               sql1 := sql1 + ',' + testValues[FType,CountID]
+            else if (FType in [ftBlob, ftBytes, ftGraphic, ftVarBytes]) and
+                    (SQLServerType = ssOracle) then
+               // Oracle does not accept string literals in blob insert statements
+               // convert 'DEADBEEF' hex literal to binary:
+               sql1 := sql1 + ', HEXTORAW(' + QuotedStr(String2Hex(testValues[FType,CountID])) + ') '
+            else if (FType = ftDate) and
+                    (SQLServerType = ssOracle) then
+               // Oracle requires date conversion; otherwise
+               // ORA-01861: literal does not match format string
+               // ANSI/ISO date literal:
+               sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID])
+            else if (FType = ftDateTime) and
+                    (SQLServerType = ssOracle) then begin
+               // similar to ftDate handling
+               // Could be a real date+time or only date. Does not consider only time.
+               if pos(' ',testValues[FType,CountID])>0 then
+                  sql1 := sql1 + ', TIMESTAMP ' + QuotedStr(testValues[FType,CountID])
+               else
+                  sql1 := sql1 + ', DATE ' + QuotedStr(testValues[FType,CountID]);
             end
+            else if (FType = ftTime) and
+                    (SQLServerType = ssOracle) then
+               // similar to ftDate handling
+               // More or less arbitrary default time; there is no time-only data type in Oracle.
+               sql1 := sql1 + ', TIMESTAMP ' + QuotedStr('0001-01-01 '+testValues[FType,CountID])
+            else
+               sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
           else
             sql1 := sql1 + ',NULL';
           end;
diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas
index 64ba6ff1e7..28d6cfdbd2 100644
--- a/packages/fcl-db/tests/testdbbasics.pas
+++ b/packages/fcl-db/tests/testdbbasics.pas
@@ -88,6 +88,7 @@ type
     procedure TestMultipleDeleteUpdateBuffer;
     procedure TestDoubleDelete;
     procedure TestMergeChangeLog;
+    procedure TestRevertRecord;
   // index tests
     procedure TestAddIndexInteger;
     procedure TestAddIndexSmallInt;
@@ -167,6 +168,7 @@ type
     procedure TestBug6893;
     procedure TestRequired;
     procedure TestModified;
+    procedure TestUpdateCursorPos;         // bug 31532
     // fields
     procedure TestFieldOldValueObsolete;
     procedure TestFieldOldValue;
@@ -683,6 +685,37 @@ begin
   end;
 end;
 
+procedure TTestCursorDBBasics.TestUpdateCursorPos;
+var
+  datasource1: TDataSource;
+  datalink1: TDataLink;
+  dataset1: TDataSet;
+  i,r: integer;
+begin
+  // TBufDataset should notify TDataset (TDataset.CurrentRecord) when changes internaly current record
+  // TBufDataset.GetRecNo was synchronizing its internal position with TDataset.ActiveRecord, but TDataset.CurrentRecord remains unchaged
+  // Bug #31532
+  dataset1 := DBConnector.GetNDataset(16);
+  datasource1 := TDataSource.Create(nil);
+  datasource1.DataSet := dataset1;
+  datalink1 := TDataLink.Create;
+  datalink1:= TDataLink.create;
+  datalink1.DataSource:= datasource1;
+  datalink1.BufferCount:= 12;
+
+  dataset1.Open;
+  dataset1.MoveBy(4);
+  CheckEquals(5, dataset1.RecNo);
+  for i:=13 to 15 do begin
+    datalink1.BufferCount := datalink1.BufferCount+1;
+    r := dataset1.RecNo; // syncronizes source dataset to ActiveRecord
+    datalink1.ActiveRecord := datalink1.BufferCount-1;
+    CheckEquals(i, dataset1.FieldByName('ID').AsInteger);
+  end;
+  datasource1.free;
+  datalink1.free;
+end;
+
 procedure TTestDBBasics.TestDetectionNonMatchingDataset;
 var
   F: TField;
@@ -1231,6 +1264,7 @@ begin
     begin
     Open;
 
+    // modify records
     for i := 0 to 16 do
       begin
       if i mod 4=0 then
@@ -1242,19 +1276,21 @@ begin
       next;
       end;
 
-    for i := 17 to 20 do
+    // append new records
+    for i := 18 to 21 do
       begin
       append;
-      fieldbyname('id').AsInteger:=i+1;
-      fieldbyname('name').AsString:='TestName'+inttostr(i+1);
+      fieldbyname('id').AsInteger:=i;
+      fieldbyname('name').AsString:='TestName'+inttostr(i);
       post;
       end;
 
+    // delete records #1,5,9,13,17,21 which was modified or appended before
     first;
     for i := 0 to 20 do if i mod 4=0 then
       delete
     else
-       next;
+      next;
 
     First;
     i := 0;
@@ -1279,10 +1315,10 @@ begin
       CancelUpdates;
 
       First;
-      for i := 0 to 16 do
+      for i := 1 to 17 do
         begin
-        CheckEquals(i+1,FieldByName('ID').AsInteger);
-        CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
+        CheckEquals(i, FieldByName('ID').AsInteger);
+        CheckEquals('TestName'+inttostr(i), FieldByName('NAME').AsString);
         next;
         end;
 
@@ -1785,6 +1821,77 @@ begin
     end;
 end;
 
+procedure TTestBufDatasetDBBasics.TestRevertRecord;
+begin
+  with DBConnector.GetNDataset(True,1) as TCustomBufDataset do
+  begin
+    Open;
+    // update value in one record and revert them
+    Edit;
+    FieldByName('ID').AsInteger := 100;
+    Post;
+    CheckEquals(100, FieldByName('ID').AsInteger);
+    RevertRecord;
+    CheckEquals(1, FieldByName('ID').AsInteger, 'Revert modified #1');
+    // append new record and delete prior and revert appended
+    AppendRecord([3,'']);
+    InsertRecord([2,'']);
+    Prior;
+    Delete; // 1st
+    Next;
+    RevertRecord; // 3rd
+    CheckEquals(2, FieldByName('ID').AsInteger, 'Revert inserted #1a');
+    RevertRecord; // 2nd
+    CheckTrue(Eof, 'Revert inserted #1b');
+    CancelUpdates; // restores 1st deleted record
+    CheckEquals(1, FieldByName('ID').AsInteger, 'CancelUpdates #1');
+    Close;
+  end;
+
+  with DBConnector.GetNDataset(False,0) as TCustomBufDataset do
+  begin
+    Open;
+    // insert one record and revert them
+    InsertRecord([1,'']);
+    RevertRecord;
+    CheckTrue(Eof);
+    CheckEquals(0, ChangeCount);
+
+    // insert two records and revert them in inverse order
+    AppendRecord([2,'']);
+    InsertRecord([1,'']); // this record in update-buffer is linked to 2
+    RevertRecord;
+    CheckEquals(2, FieldByName('ID').AsInteger);
+    CheckEquals(1, ChangeCount);
+    RevertRecord;
+    CheckTrue(Eof);
+    CheckEquals(0, ChangeCount);
+
+    // insert more records and some delete and some revert
+    AppendRecord([4,'']);
+    InsertRecord([3,'']);
+    InsertRecord([2,'']);
+    InsertRecord([1,'']);
+    CheckEquals(4, ChangeCount);
+    Delete;  // 1
+    CheckEquals(4, ChangeCount);
+    Next;    // 3
+    RevertRecord;
+    CheckEquals(4, FieldByName('ID').AsInteger);
+    CheckEquals(3, ChangeCount);
+    Prior;   // 2
+    RevertRecord;
+    CheckEquals(4, FieldByName('ID').AsInteger);
+    CheckEquals(2, ChangeCount);
+
+    CancelUpdates;
+    CheckTrue(Eof);
+    CheckEquals(0, ChangeCount);
+
+    Close;
+  end;
+end;
+
 procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
 var i : integer;
 begin
diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas
index ee06f9a1f1..6b114b48f0 100644
--- a/packages/fcl-db/tests/testfieldtypes.pas
+++ b/packages/fcl-db/tests/testfieldtypes.pas
@@ -2181,12 +2181,12 @@ end;
 
 procedure TTestFieldTypes.TestTableNames;
 var TableList : TStringList;
-    i         : integer;
+
 begin
   TableList := TStringList.Create;
   try
     TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
-    AssertTrue(TableList.Find('fpdev',i));
+    AssertTrue(TableList.IndexOf('fpdev')<>-1);
   finally
     TableList.Free;
   end;
@@ -2216,7 +2216,7 @@ begin
   FieldList := TStringList.Create;
   try
     TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
-    AssertTrue(FieldList.Find('id',i));
+    AssertTrue(FieldList.IndexOf('id')<>-1);
   finally
     FieldList.Free;
   end;
diff --git a/packages/fcl-db/tests/testspecifictbufdataset.pas b/packages/fcl-db/tests/testspecifictbufdataset.pas
index 1c4e73cb47..792deb382d 100644
--- a/packages/fcl-db/tests/testspecifictbufdataset.pas
+++ b/packages/fcl-db/tests/testspecifictbufdataset.pas
@@ -195,9 +195,11 @@ begin
   try
     F := TIntegerField.Create(ds);
     F.FieldName:='ID';
+    F.Required:=True;
     F.DataSet:=ds;
     F := TStringField.Create(ds);
     F.FieldName:='NAME';
+    F.Required:=False;
     F.DataSet:=ds;
     F.Size:=50;
 
@@ -221,6 +223,8 @@ begin
 
     TestDataset(ds);
 
+    CheckTrue(ds.FieldDefs[0].Required, 'Required');
+    CheckFalse(ds.FieldDefs[1].Required, 'not Required');
     for i := 0 to ds.FieldDefs.Count-1 do
       begin
       CheckNotEquals(ds.FieldDefs[i].Name,'NAME_CALC');
diff --git a/packages/fcl-db/tests/toolsunit.pas b/packages/fcl-db/tests/toolsunit.pas
index b3ab9625e3..89a9941173 100644
--- a/packages/fcl-db/tests/toolsunit.pas
+++ b/packages/fcl-db/tests/toolsunit.pas
@@ -224,6 +224,7 @@ var dbtype,
     dbuser,
     dbhostname,
     dbpassword,
+    dbcharset,
     dblogfilename,
     dbQuoteChars   : string;
     dblogfile      : TextFile;
@@ -476,17 +477,18 @@ procedure ReadIniFile;
 var IniFile : TIniFile;
 
 begin
-  IniFile := TIniFile.Create(getcurrentdir + PathDelim + 'database.ini');
+  IniFile := TIniFile.Create(GetCurrentDir + PathDelim + 'database.ini');
   dbtype:='';
-  if Paramcount>0 then
+  if ParamCount>0 then
     dbtype := ParamStr(1);
-  if (dbtype='') or not inifile.SectionExists(dbtype) then
+  if (dbtype='') or not IniFile.SectionExists(dbtype) then
     dbtype := IniFile.ReadString('Database','Type','');
   dbconnectorname := IniFile.ReadString(dbtype,'Connector','');
   dbname := IniFile.ReadString(dbtype,'Name','');
   dbuser := IniFile.ReadString(dbtype,'User','');
   dbhostname := IniFile.ReadString(dbtype,'Hostname','');
   dbpassword := IniFile.ReadString(dbtype,'Password','');
+  dbcharset := IniFile.ReadString(dbtype,'CharSet','');
   dbconnectorparams := IniFile.ReadString(dbtype,'ConnectorParams','');
   dblogfilename := IniFile.ReadString(dbtype,'LogFile','');
   dbquotechars := IniFile.ReadString(dbtype,'QuoteChars','"');
@@ -526,8 +528,6 @@ end;
 
 procedure InitialiseDBConnector;
 
-const B: array[boolean] of char=('0','1');  // should be exported from some main db unit, as SQL true/false?
-
 var DBConnectorClass : TPersistentClass;
     i                : integer;
     FormatSettings   : TFormatSettings;
@@ -548,7 +548,7 @@ begin
   testValues[ftFMTBcd] := testFmtBCDValues;
   for i := 0 to testValuesCount-1 do
     begin
-    testValues[ftBoolean,i] := B[testBooleanValues[i]];
+    testValues[ftBoolean,i] := BoolToStr(testBooleanValues[i], True);
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i],FormatSettings);
     testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
     testValues[ftInteger,i] := IntToStr(testIntValues[i]);
diff --git a/packages/fcl-fpcunit/src/fpcunit.pp b/packages/fcl-fpcunit/src/fpcunit.pp
index a390711df8..66893eaf85 100644
--- a/packages/fcl-fpcunit/src/fpcunit.pp
+++ b/packages/fcl-fpcunit/src/fpcunit.pp
@@ -618,13 +618,13 @@ end;
 
 class procedure TAssert.AssertEquals(const AMessage: string; Expected, Actual: string);
 begin
-  AssertTrue(ComparisonMsg(AMessage ,Expected, Actual), AnsiCompareStr(Expected, Actual) = 0,CallerAddr);
+  AssertTrue(ComparisonMsg(AMessage ,Expected, Actual), Expected=Actual,CallerAddr);
 end;
 
 
 class procedure TAssert.AssertEquals(Expected, Actual: string);
 begin
-  AssertTrue(ComparisonMsg(Expected, Actual), AnsiCompareStr(Expected, Actual) = 0,CallerAddr);
+  AssertTrue(ComparisonMsg(Expected, Actual), Expected=Actual,CallerAddr);
 end;
 
 {$IFDEF UNICODE}
diff --git a/packages/fcl-image/examples/drawing.pp b/packages/fcl-image/examples/drawing.pp
index 518e867b43..33fa274925 100644
--- a/packages/fcl-image/examples/drawing.pp
+++ b/packages/fcl-image/examples/drawing.pp
@@ -1,19 +1,19 @@
 {$mode objfpc}{$h+}
 program Drawing;
 
-uses classes, sysutils,
-     FPImage, FPCanvas, FPImgCanv, ftFont,
-     FPWritePNG, FPReadPNG;
+uses cwstring,classes, sysutils, FPImage, FPCanvas, FPImgCanv, FPWritePNG, FPReadPNG;
 
 const
   MyColor : TFPColor = (Red: $7FFF; Green: $0000; Blue: $FFFF; Alpha: alphaOpaque);
 
 procedure DoDraw;
-var canvas : TFPcustomCAnvas;
-    ci, image : TFPCustomImage;
-    writer : TFPCustomImageWriter;
-    reader : TFPCustomImageReader;
-    f : TFreeTypeFont;
+
+var
+  canvas : TFPcustomCAnvas;
+  ci,image : TFPCustomImage;
+  writer : TFPCustomImageWriter;
+  reader : TFPCustomImageReader;
+
 begin
   image := TFPMemoryImage.Create (100,100);
   ci := TFPMemoryImage.Create (20,20);
@@ -28,9 +28,11 @@ begin
     GrayScale := false;
     end;
   try
-//    ci.LoadFromFile ('test.png', reader);
+    ci.LoadFromFile ('pattern.png', reader);
     with Canvas as TFPImageCanvas do
       begin
+      brush.FPcolor:=colwhite;
+      brush.style:=bsSolid;
       pen.mode := pmCopy;
       pen.style := psSolid;
       pen.width := 1;
@@ -51,14 +53,14 @@ begin
         blue := green;
         end;
       pen.style := psSolid;
+
       RelativeBrushImage := true;
-{
       brush.image := ci;
       brush.style := bsimage;
       with brush.FPColor do
         green := green div 2;
       Ellipse (11,11, 89,89);
-}
+
 
       brush.style := bsSolid;
       brush.FPColor := MyColor;
@@ -71,31 +73,18 @@ begin
       pen.FPColor := colCyan;
       ellipseC (50,50, 1,1);
 
-      InitEngine;
-      F:=TFreeTypeFont.Create;
-      F.Angle:=0.15;
-      Font:=F;
-//      Font.Name:='/usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf';
-      Font.Name:='/home/michael/Documents/arial.ttf';
-      Font.Size:=10;
-      Font.FPColor:=colWhite;
-//      Font.Orientation:=900;
-      
-      Canvas.TextOut(10,90,'o');
       end;
-      writeln ('Saving to inspect !');
-    image.SaveToFile ('DrawTest.png', writer);
+      writeln ('Saving to "DrawTest.png" for inspection !');
+     image.SaveToFile ('DrawTest.png', writer);
   finally
     Canvas.Free;
+    ci.free;
     image.Free;
     writer.Free;
-    ci.free;
     reader.Free;
   end;
 end;
 
 begin
-//  DefaultFontPath := '/usr/share/fonts/truetype/ttf-dejavu/';
   DoDraw;
-
 end.
diff --git a/packages/fcl-image/examples/imgconv.pp b/packages/fcl-image/examples/imgconv.pp
index 8012089dad..9048210929 100644
--- a/packages/fcl-image/examples/imgconv.pp
+++ b/packages/fcl-image/examples/imgconv.pp
@@ -19,7 +19,7 @@ program ImgConv;
 
 uses FPWriteXPM, FPWritePNG, FPWriteBMP,
      FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
-     fpreadtga,fpwritetga,fpreadpnm,fpwritepnm,
+     fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
      {$ifndef UseFile}classes,{$endif}
      FPImage, sysutils;
 
@@ -44,6 +44,8 @@ begin
       Reader := TFPReaderPNG.Create
     else if T = 'T' then
       Reader := TFPReaderTarga.Create
+    else if T = 'F' then
+      Reader := TFPReaderTiff.Create
     else if T = 'N' then
       Reader := TFPReaderPNM.Create
     else
@@ -77,6 +79,8 @@ begin
     Writer := TFPWriterPNG.Create
   else if T = 'T' then
     Writer := TFPWriterTARGA.Create
+  else if T = 'F' then
+    Writer := TFPWriterTiff.Create
   else if T = 'N' then
     Writer := TFPWriterPNM.Create
   else
@@ -150,7 +154,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)');
+    writeln ('N for PNM (read only), F for TIFF');
     writeln ('example: imgconv X hello.xpm P hello.png');
     writeln ('example: imgconv hello.xpm P hello.png');
     writeln ('Options for');
diff --git a/packages/fcl-image/examples/pattern.png b/packages/fcl-image/examples/pattern.png
new file mode 100644
index 0000000000..106e78f437
--- /dev/null
+++ b/packages/fcl-image/examples/pattern.png
diff --git a/packages/fcl-image/examples/textout.pp b/packages/fcl-image/examples/textout.pp
new file mode 100644
index 0000000000..712f83b4e6
--- /dev/null
+++ b/packages/fcl-image/examples/textout.pp
@@ -0,0 +1,116 @@
+{$mode objfpc}{$h+}
+{$CODEPAGE UTF8}
+program textout;
+
+uses
+  cwstring,classes, sysutils, FPImage, FPCanvas, FPImgCanv, ftFont, FPWritePNG, freetype;
+
+const
+  MyColor : TFPColor = (Red: $7FFF; Green: $0000; Blue: $FFFF; Alpha: alphaOpaque);
+
+procedure DoDraw(FN, fnChinese : String);
+
+var
+  canvas : TFPcustomCAnvas;
+  image : TFPCustomImage;
+  writer : TFPCustomImageWriter;
+  f : TFreeTypeFont;
+  S : String;
+  U : UnicodeString;
+
+begin
+  f:=Nil;
+  image := TFPMemoryImage.Create (256,256);
+  Canvas := TFPImageCanvas.Create (image);
+  Writer := TFPWriterPNG.Create;
+  InitEngine;
+  with TFPWriterPNG(Writer) do
+    begin
+    indexed := false;
+    wordsized := false;
+    UseAlpha := false;
+    GrayScale := false;
+    end;
+  try
+    with Canvas as TFPImageCanvas do
+      begin
+      // Clear background
+      brush.FPcolor:=colwhite;
+      brush.style:=bsSolid;
+      pen.mode := pmCopy;
+      pen.style := psSolid;
+      pen.width := 1;
+      pen.FPColor := colWhite;
+      FillRect(0,0,255,255);
+      // Set font
+      F:=TFreeTypeFont.Create;
+      Font:=F;
+      Font.Name:=FN;
+      Font.Size:=14;
+      Font.FPColor:=colBlack;
+      S:='Hello, world!';
+      Canvas.TextOut(20,20,S);
+      U:=UTF8Decode('привет, Мир!');
+      Font.FPColor:=colBlue;
+      Canvas.TextOut(50,50,U);
+      if (FNChinese<>'') then
+        begin
+        Font.Name:=FNChinese;
+        U:=UTF8Decode('你好，世界!');
+        Font.FPColor:=colRed;
+        Canvas.TextOut(20,100,U);
+        end
+      else
+        begin
+        Font.Size:=10;
+        Canvas.TextOut(20,100,'No chinese font available.');
+        end;
+      U:=UTF8Decode('non-ASCII chars: ßéùµàçè§âêû');
+      Font.Size:=10;
+      Canvas.TextOut(20,180,U);
+      end;
+    writeln ('Saving to "TextTest.png" for inspection !');
+    Image.SaveToFile ('TextTest.png', writer);
+  finally
+    F.Free;
+    Canvas.Free;
+    image.Free;
+    writer.Free;
+  end;
+end;
+
+Var
+  D,FontFile, FontFileChinese : String;
+  Info : TSearchRec;
+
+begin
+  // Initialize font search path;
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+  D := '/usr/share/fonts/truetype/';
+  DefaultSearchPath:=D;
+  if FindFirst(DefaultSearchPath+AllFilesMask,faDirectory,Info)=0 then
+    try
+      repeat
+        if (Info.Attr and faDirectory)<>0 then
+          if (Info.Name<>'.') and (info.name<>'..') then
+            DefaultSearchPath:=DefaultSearchPath+';'+D+Info.Name;
+      Until FindNext(Info)<>0;
+    finally
+      FindClose(Info);
+    end;
+{$ENDIF}
+{$ENDIF}
+  FontFile:=ParamStr(1);
+  if FontFile='' then
+    FontFile:='LiberationSans-Regular.ttf';
+  FontFileChinese:=ParamStr(2);
+  if FontFileChinese='' then
+    With TFontManager.Create do
+      try
+          FontFileChinese:=SearchFont('wqy-microhei.ttc',False);
+      finally
+        Free;
+      end;
+  DoDraw(FontFile,FontFileChinese);
+end.
diff --git a/packages/fcl-image/src/fpcanvas.inc b/packages/fcl-image/src/fpcanvas.inc
index c00cd955ca..521af4e8f7 100644
--- a/packages/fcl-image/src/fpcanvas.inc
+++ b/packages/fcl-image/src/fpcanvas.inc
@@ -353,6 +353,77 @@ begin
     result := DoGetTextWidth (Text);
 end;
 
+procedure TFPCustomCanvas.TextOut (x,y:integer;text:unicodestring);
+begin
+  if Font is TFPCustomDrawFont then
+    TFPCustomDrawFont(Font).DrawText(x,y, text)
+  else
+    DoTextOut (x,y, text);
+end;
+
+procedure TFPCustomCanvas.GetTextSize (text:unicodestring; var w,h:integer);
+begin
+  if Font is TFPCustomDrawFont then
+    TFPCustomDrawFont(Font).GetTextSize (text, w, h)
+  else
+    DoGetTextSize (Text, w, h);
+end;
+
+function TFPCustomCanvas.GetTextHeight (text:unicodestring) : integer;
+begin
+  Result := TextHeight(Text);
+end;
+
+function TFPCustomCanvas.GetTextWidth (text:unicodestring) : integer;
+begin
+  Result := TextWidth(Text);
+end;
+
+function TFPCustomCanvas.TextExtent(const Text: unicodestring): TSize;
+begin
+  GetTextSize(Text, Result.cx, Result.cy);
+end;
+
+function TFPCustomCanvas.TextHeight(const Text: unicodestring): Integer;
+begin
+  if Font is TFPCustomDrawFont then
+    result := TFPCustomDrawFont(Font).GetTextHeight (text)
+  else
+    result := DoGetTextHeight (Text);
+end;
+
+function TFPCustomCanvas.TextWidth(const Text: unicodestring): Integer;
+begin
+  if Font is TFPCustomDrawFont then
+    result := TFPCustomDrawFont(Font).GetTextWidth (text)
+  else
+    result := DoGetTextWidth (Text);
+end;
+
+procedure TFPCustomCanvas.DoTextOut (x,y:integer;text:unicodestring); 
+
+begin
+  DoTextOut(x,y,string(text));
+end;
+
+procedure TFPCustomCanvas.DoGetTextSize (text:unicodestring; var w,h:integer); 
+
+begin
+  DoGetTextSize(String(Text),w,h);
+end;
+
+function  TFPCustomCanvas.DoGetTextHeight (text:unicodestring) : integer; 
+
+begin
+  Result:=DoGetTextHeight(String(text));
+end;
+
+function  TFPCustomCanvas.DoGetTextWidth (text:unicodestring) : integer; 
+
+begin
+  Result:=DoGetTextWidth(String(text));
+end;
+
 procedure TFPCustomCanvas.Arc(ALeft, ATop, ARight, ABottom, Angle16Deg,
   Angle16DegLength: Integer);
 begin
diff --git a/packages/fcl-image/src/fpcanvas.pp b/packages/fcl-image/src/fpcanvas.pp
index 7f7b0bc8ec..83b657f80f 100644
--- a/packages/fcl-image/src/fpcanvas.pp
+++ b/packages/fcl-image/src/fpcanvas.pp
@@ -278,6 +278,10 @@ type
     procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
     function  DoGetTextHeight (text:string) : integer; virtual; abstract;
     function  DoGetTextWidth (text:string) : integer; virtual; abstract;
+    procedure DoTextOut (x,y:integer;text:unicodestring); virtual; 
+    procedure DoGetTextSize (text:unicodestring; var w,h:integer); virtual; 
+    function  DoGetTextHeight (text:unicodestring) : integer; virtual; 
+    function  DoGetTextWidth (text:unicodestring) : integer; virtual; 
     procedure DoRectangle (Const Bounds:TRect); virtual; abstract;
     procedure DoRectangleFill (Const Bounds:TRect); virtual; abstract;
     procedure DoRectangleAndFill (Const Bounds:TRect); virtual;
@@ -317,6 +321,13 @@ type
     function TextExtent(const Text: string): TSize; virtual;
     function TextHeight(const Text: string): Integer; virtual;
     function TextWidth(const Text: string): Integer; virtual;
+    procedure TextOut (x,y:integer;text:unicodestring); virtual;
+    procedure GetTextSize (text:unicodestring; var w,h:integer);
+    function GetTextHeight (text:unicodestring) : integer;
+    function GetTextWidth (text:unicodestring) : integer;
+    function TextExtent(const Text: unicodestring): TSize; virtual;
+    function TextHeight(const Text: unicodestring): Integer; virtual;
+    function TextWidth(const Text: unicodestring): Integer; virtual;
     // using pen and brush
     procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual;
     procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual;
@@ -374,11 +385,19 @@ type
     procedure GetTextSize (text:string; var w,h:integer);
     function GetTextHeight (text:string) : integer;
     function GetTextWidth (text:string) : integer;
+    procedure DrawText (x,y:integer; text:unicodestring);
+    procedure GetTextSize (text: unicodestring; var w,h:integer);
+    function GetTextHeight (text: unicodestring) : integer;
+    function GetTextWidth (text: unicodestring) : integer;
   protected
     procedure DoDrawText (x,y:integer; text:string); virtual; abstract;
     procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
     function DoGetTextHeight (text:string) : integer; virtual; abstract;
     function DoGetTextWidth (text:string) : integer; virtual; abstract;
+    procedure DoDrawText (x,y:integer; text:unicodestring); virtual;
+    procedure DoGetTextSize (text: unicodestring; var w,h:integer); virtual; 
+    function DoGetTextHeight (text: unicodestring) : integer; virtual; 
+    function DoGetTextWidth (text: unicodestring) : integer; virtual; 
   end;
 
   TFPEmptyFont = class (TFPCustomFont)
diff --git a/packages/fcl-image/src/fpcdrawh.inc b/packages/fcl-image/src/fpcdrawh.inc
index 891bf34038..93cef40845 100644
--- a/packages/fcl-image/src/fpcdrawh.inc
+++ b/packages/fcl-image/src/fpcdrawh.inc
@@ -77,3 +77,50 @@ function TFPCustomDrawFont.GetTextWidth (text:string) : integer;
 begin
   result := DoGetTextWidth (Text);
 end;
+
+procedure TFPCustomDrawFont.DrawText (x,y:integer; text:UnicodeString);
+begin
+  DoDrawText (x,y, text);
+end;
+
+procedure TFPCustomDrawFont.GetTextSize (text:UnicodeString; var w,h:integer);
+begin
+  DoGetTextSize (text, w,h);
+end;
+
+function TFPCustomDrawFont.GetTextHeight (text:UnicodeString) : integer;
+begin
+  result := DoGetTextHeight (Text);
+end;
+
+function TFPCustomDrawFont.GetTextWidth (text:UnicodeString) : integer;
+begin
+  result := DoGetTextWidth (Text);
+end;
+
+procedure TFPCustomDrawFont.DoDrawText (x,y:integer; text:unicodestring); 
+
+begin
+  DoDrawText(x,y,String(text));
+end;
+
+procedure TFPCustomDrawFont.DoGetTextSize (text: unicodestring; var w,h:integer); 
+
+begin
+  DoGetTextSize(String(text),w,h);
+end;
+
+
+
+function TFPCustomDrawFont.DoGetTextHeight (text: unicodestring) : integer;  
+
+begin
+  Result:=DoGetTextHeight(String(text));
+end;
+
+function TFPCustomDrawFont.DoGetTextWidth (text: unicodestring) : integer; 
+
+begin
+  Result:=DoGetTextWidth(String(text));
+end;
+
diff --git a/packages/fcl-image/src/fpimage.pp b/packages/fcl-image/src/fpimage.pp
index 354ffa02a5..d59116daa8 100644
--- a/packages/fcl-image/src/fpimage.pp
+++ b/packages/fcl-image/src/fpimage.pp
@@ -314,7 +314,8 @@ type
     StrNoCorrectReaderFound,
     StrReadWithError,
     StrWriteWithError,
-    StrNoPaletteAvailable
+    StrNoPaletteAvailable,
+    StrInvalidHTMLColor
     );
 
 const
@@ -335,7 +336,8 @@ const
      'Can''t determine image type of stream',
      'Error while reading stream: %s',
      'Error while writing stream: %s',
-     'No palette available'
+     'No palette available',
+     'Invalid HTML color : %s'
      );
 
 {$i fpcolors.inc}
@@ -553,6 +555,11 @@ Pass FreeImg=true to call Img.Free }
 function GetMinimumFPCompactImg(Img: TFPCustomImage; FreeImg: boolean;
 FuzzyDepth: word = 4): TFPCustomImage;
 
+{ HTML Color support. RRGGBB or color name. Only W3 color names s are supported}
+
+function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+function HtmlToFpColor(const S: String): TFPColor;
 
 
 implementation
@@ -645,6 +652,121 @@ begin
 end;
 {$endif}
 
+type
+  THtmlColorName = (
+    hcnWhite, hcnSilver, hcnGray, hcnBlack,
+    hcnRed, hcnMaroon, hcnYellow, hcnOlive,
+    hcnLime, hcnGreen, hcnAqua, hcnTeal, hcnBlue,
+    hcnNavy, hcnFuchsia, hcnPurple);
+
+const
+  HtmlColorNameToFPColorMap: array[THtmlColorName] of TFPColor = (
+    (red: $ff; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnWhite
+    (red: $c0; green: $c0; blue: $c0; alpha: alphaOpaque), //hcnSilver
+    (red: $80; green: $80; blue: $80; alpha: alphaOpaque), //hcnGray
+    (red: $00; green: $00; blue: $00; alpha: alphaOpaque), //hcnBlack
+    (red: $ff; green: $00; blue: $00; alpha: alphaOpaque), //hcnRed
+    (red: $80; green: $00; blue: $00; alpha: alphaOpaque), //hcnMaroon
+    (red: $ff; green: $ff; blue: $00; alpha: alphaOpaque), //hcnYellow
+    (red: $80; green: $80; blue: $00; alpha: alphaOpaque), //hcnOlive
+    (red: $00; green: $ff; blue: $00; alpha: alphaOpaque), //hcnLime
+    (red: $00; green: $80; blue: $00; alpha: alphaOpaque), //hcnGreen
+    (red: $00; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnAqua
+    (red: $00; green: $80; blue: $80; alpha: alphaOpaque), //hcnTeal
+    (red: $00; green: $00; blue: $ff; alpha: alphaOpaque), //hcnBlue
+    (red: $00; green: $00; blue: $80; alpha: alphaOpaque), //hcnNavy
+    (red: $ff; green: $00; blue: $ff; alpha: alphaOpaque), //hcnFuchsia
+    (red: $80; green: $00; blue: $80; alpha: alphaOpaque)  //hcnPurple
+  );
+
+function TryStrToHtmlColorName(const S: String; out AName: THtmlColorName): Boolean;
+begin
+   Result := True;
+   case LowerCase(S) of
+     'white'  : AName := hcnWhite;
+     'silver' : AName := hcnSilver;
+     'gray'   : AName := hcnGray;
+     'black'  : AName := hcnBlack;
+     'red'    : AName := hcnRed;
+     'maroon' : AName := hcnMaroon;
+     'yellow' : AName := hcnYellow;
+     'olive'  : AName := hcnOlive;
+     'lime'   : AName := hcnLime;
+     'green'  : AName := hcnGreen;
+     'aqua'   : AName := hcnAqua;
+     'teal'   : AName := hcnTeal;
+     'blue'   : AName := hcnBlue;
+     'navy'   : AName := hcnNavy;
+     'fuchsia': AName := hcnFuchsia;
+     'purple' : AName := hcnPurple;
+  else
+    Result := False;
+  end;
+end;
+
+{ Try to translate HTML color code into TFPColor
+  Supports following formats
+    '#rgb'
+    '#rrggbb'
+    W3C Html color name
+}
+function TryHtmlToFPColor(const S: String; out FPColor: TFPColor): Boolean;
+
+  function TryHexStrToWord(const Hex: String; out W: Word): Boolean;
+  var
+    Code: Integer;
+  begin
+    Val('$'+Hex, W, Code);
+    Result := (Code = 0);
+    if not Result then W := 0;
+  end;
+
+var
+  AName: THtmlColorName;
+begin
+  Result := False;
+  FPColor.red := 0;
+  FPColor.green := 0;
+  FPColor.blue := 0;
+  FPColor.alpha := alphaOpaque;
+  if (Length(S) = 0) then
+    Exit;
+  if (S[1] = '#') then
+  begin
+    if Length(S) = 4 then
+    begin  // #rgb
+      Result := (TryHexstrToWord(S[2]+S[2], FPColor.red) and
+                 TryHexstrToWord(S[3]+S[3], FPColor.green) and
+                 TryHexstrToWord(S[4]+S[4], FPColor.blue));
+    end
+    else if Length(S) = 7 then
+    begin  // #rrggbb
+      Result := (TryHexstrToWord(S[2]+S[3], FPColor.red) and
+                 TryHexstrToWord(S[4]+S[5], FPColor.green) and
+                 TryHexstrToWord(S[6]+S[7], FPColor.blue));
+    end;
+  end
+  else
+  begin
+    Result := TryStrToHtmlColorName(S, AName);
+    if Result then
+      FPColor := HtmlColorNameToFPColorMap[AName];
+  end;
+end;
+
+function HtmlToFPColorDef(const S: String; out FPColor: TFpColor; Def: TFPColor): TFPColor;
+begin
+  if not TryHtmlToFPColor(S, Result) then
+    Result := Def;
+end;
+
+function HtmlToFpColor(const S: String): TFPColor;
+begin
+  if not TryHtmlToFpColor(S, Result) then
+    raise EConvertError.CreateFmt(ErrorText[StrInvalidHTMLColor], [S]);
+end;
+
+
 initialization
   ImageHandlers := TImageHandlersManager.Create;
   GrayConvMatrix := GCM_JPEG;
diff --git a/packages/fcl-image/src/fppixlcanv.pp b/packages/fcl-image/src/fppixlcanv.pp
index 9010a78bc0..6667918717 100644
--- a/packages/fcl-image/src/fppixlcanv.pp
+++ b/packages/fcl-image/src/fppixlcanv.pp
@@ -28,14 +28,18 @@ type
 
   PixelCanvasException = class (TFPCanvasException);
 
+  { TFPPixelCanvas }
+
   TFPPixelCanvas = class (TFPCustomCanvas)
   private
     FHashWidth : word;
     FRelativeBI : boolean;
   protected
+    procedure DoCopyRect(x, y: integer; canvas: TFPCustomCanvas; const SourceRect: TRect); override;
     function DoCreateDefaultFont : TFPCustomFont; override;
     function DoCreateDefaultPen : TFPCustomPen; override;
     function DoCreateDefaultBrush : TFPCustomBrush; override;
+    procedure DoDraw(x, y: integer; const image: TFPCustomImage); override;
     procedure DoTextOut (x,y:integer;text:string); override;
     procedure DoGetTextSize (text:string; var w,h:integer); override;
     function  DoGetTextHeight (text:string) : integer; override;
@@ -73,12 +77,26 @@ begin
   raise PixelCanvasException.Create(sErrNotAvailable);
 end;
 
-constructor TFPPixelCanvas.Create;
+constructor TFPPixelCanvas.create;
 begin
   inherited;
   FHashWidth := DefaultHashWidth;
 end;
 
+procedure TFPPixelCanvas.DoCopyRect(x, y: integer; canvas: TFPCustomCanvas; const SourceRect: TRect);
+Var
+  W,H,XS1,XS2,YS1,YS2 : Integer;
+
+begin
+  XS1:=SourceRect.Left;
+  XS2:=SourceRect.Right;
+  YS1:=SourceRect.Top;
+  YS2:=SourceRect.Bottom;
+  For H:=0 to YS2-YS1 do
+    For W:=0 to XS2-XS1 do
+      Colors[x+h,y+h]:=Canvas.Colors[XS1+W,YS1+H];
+end;
+
 function TFPPixelCanvas.DoCreateDefaultFont : TFPCustomFont;
 begin
   result := TFPEmptyFont.Create;
@@ -108,6 +126,17 @@ begin
   result.Style := bsSolid;
 end;
 
+procedure TFPPixelCanvas.DoDraw(x, y: integer; const image: TFPCustomImage);
+
+Var
+  W,h : Integer;
+
+begin
+  For H:=0 to Image.Height-1 do
+    For W:=0 to Image.Width-1 do
+      Colors[x+w,y+h]:=Image.Colors[W,H];
+end;
+
 procedure TFPPixelCanvas.DoTextOut (x,y:integer;text:string);
 begin
   NotImplemented;
@@ -365,4 +394,5 @@ begin
   end;
 end;
 
+
 end.
diff --git a/packages/fcl-image/src/fpreadjpeg.pas b/packages/fcl-image/src/fpreadjpeg.pas
index 84e5767edc..782ae65b7b 100644
--- a/packages/fcl-image/src/fpreadjpeg.pas
+++ b/packages/fcl-image/src/fpreadjpeg.pas
@@ -211,7 +211,7 @@ var
     if (FInfo.out_color_space = JCS_GRAYSCALE) then 
       begin
       FInfo.quantize_colors := True;
-      FInfo.desired_number_of_colors := 236;
+      FInfo.desired_number_of_colors := 256;
       end;
 
     if FPerformance = jpBestSpeed then 
diff --git a/packages/fcl-image/src/fpwritejpeg.pas b/packages/fcl-image/src/fpwritejpeg.pas
index ef0391bd30..22d2c132f7 100644
--- a/packages/fcl-image/src/fpwritejpeg.pas
+++ b/packages/fcl-image/src/fpwritejpeg.pas
@@ -44,7 +44,7 @@ type
     destructor Destroy; override;
     property CompressionQuality: TFPJPEGCompressionQuality read FQuality write FQuality;
     property ProgressiveEncoding: boolean read FProgressiveEncoding write FProgressiveEncoding;
-    property GrayScale: boolean read FGrayscale;
+    property GrayScale: boolean read FGrayscale write FGrayScale;
   end;
 
 implementation
@@ -125,10 +125,16 @@ var
   begin
     FInfo.image_width := Img.Width;
     FInfo.image_height := Img.Height;
-    FInfo.input_components := 3; // RGB has 3 components
-    FInfo.in_color_space := JCS_RGB;
     if FGrayscale then
-      jpeg_set_colorspace(@FInfo, JCS_GRAYSCALE);
+    begin
+      FInfo.input_components := 1;
+      FInfo.in_color_space := JCS_GRAYSCALE;
+    end
+    else
+    begin
+      FInfo.input_components := 3; // RGB has 3 components
+      FInfo.in_color_space := JCS_RGB;
+    end;
 
     jpeg_set_defaults(@FInfo);
     jpeg_set_quality(@FInfo, FQuality, True);
@@ -157,6 +163,10 @@ var
     try
       y:=0;
       while (FInfo.next_scanline < FInfo.image_height) do begin
+        if FGrayscale then
+        for x:=0 to FInfo.image_width-1 do
+          SampRow^[x]:=CalculateGray(Img.Colors[x,y]) shr 8
+        else
         for x:=0 to FInfo.image_width-1 do begin
           Color:=Img.Colors[x,y];
           SampRow^[x*3+0]:=Color.Red shr 8;
diff --git a/packages/fcl-image/src/freetype.pp b/packages/fcl-image/src/freetype.pp
index 923aa18142..271ce2d9e3 100644
--- a/packages/fcl-image/src/freetype.pp
+++ b/packages/fcl-image/src/freetype.pp
@@ -48,11 +48,10 @@ type
   PFontBitmap = ^TFontBitmap;
 
 
-  TStringBitMaps = class
+  TBaseStringBitMaps = class
     private
       FList : TList;
       FBounds : TRect;
-      FText : string;
       FMode : TBitmapType;
       function GetCount : integer;
       function GetBitmap (index:integer) : PFontBitmap;
@@ -61,17 +60,30 @@ type
       constructor Create (ACount : integer);
       destructor destroy; override;
       procedure GetBoundRect (out aRect : TRect);
-      property Text : string read FText;
       property Mode : TBitmapType read FMode;
       property Count : integer read GetCount;
       property Bitmaps[index:integer] : PFontBitmap read GetBitmap;
   end;
 
+  TStringBitMaps = class(TBaseStringBitMaps)
+    private
+      FText : STring;
+    public
+      property Text : string read FText;
+  end;
+
+  TUnicodeStringBitMaps = class(TBaseStringBitMaps)
+  private
+    FText : UnicodeString;
+  public
+    property Text : Unicodestring read FText;
+  end;
+
   TFontManager = class;
 
   PMgrGlyph = ^TMgrGlyph;
   TMgrGlyph = record
-    Character : char;
+    Character : unicodechar;
     GlyphIndex : FT_UInt;
     Glyph : PFT_Glyph;
   end;
@@ -109,33 +121,41 @@ type
       function GetSearchPath : string;
       procedure SetSearchPath (AValue : string);
       procedure SetExtention (AValue : string);
+      Procedure DoMakeString (Text : Array of cardinal; ABitmaps  : TBaseStringBitmaps);
+      Procedure DoMakeString (Text : Array of cardinal; angle: real; ABitmaps  : TBaseStringBitmaps);
     protected
       function GetFontId (afilename:string; anindex:integer) : integer;
       function CreateFont (afilename:string; anindex:integer) : integer;
-      function SearchFont (afilename:string) : string;
       function GetFont (FontID:integer) : TMgrFont;
       procedure GetSize (aSize, aResolution : integer);
       function CreateSize (aSize, aResolution : integer) : PMgrSize;
       procedure SetPixelSize (aSize, aResolution : integer);
-      function GetGlyph (c : char) : PMgrGlyph;
-      function CreateGlyph (c : char) : PMgrGlyph;
+      function GetGlyph (c : cardinal) : PMgrGlyph;
+      function CreateGlyph (c : cardinal) : PMgrGlyph;
       procedure MakeTransformation (angle:real; out Transformation:FT_Matrix);
       procedure InitMakeString (FontID, Size:integer);
       function MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
       function MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+      function MakeString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+      function MakeString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
     public
       constructor Create;
       destructor destroy; override;
+      function SearchFont(afilename: string; doraise: boolean=true): string;
       function RequestFont (afilename:string) : integer;
       function RequestFont (afilename:string; anindex:integer) : integer;
       function GetFreeTypeFont (aFontID:integer) : PFT_Face;
       function GetString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+      function GetString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
       // Black and white
       function GetStringGray (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text:unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
       // Anti Aliased gray scale
       function GetString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+      function GetString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
       // Black and white, following the direction of the font (left to right, top to bottom, ...)
-      function GetStringGray (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text: String; Size:integer) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
       // Anti Aliased gray scale, following the direction of the font (left to right, top to bottom, ...)
       property SearchPath : string read GetSearchPath write SetSearchPath;
       property DefaultExtention : string read FExtention write SetExtention;
@@ -381,11 +401,12 @@ begin
     AValue := '';
 end;
 
-function TFontManager.SearchFont (afilename:string) : string;
+function TFontManager.SearchFont (afilename:string; doraise : boolean = true) : string;
 // returns full filename of font, taking SearchPath in account
 var p,fn : string;
     r : integer;
 begin
+  Result:='';
   if (pos('.', afilename)=0) and (DefaultFontExtention<>'') then
     fn := afilename + DefaultFontExtention
   else
@@ -401,14 +422,12 @@ begin
       repeat
         dec (r);
       until (r < 0) or FileExists(FPaths[r]+fn);
-      if r < 0 then
-        raise FreeTypeException.CreateFmt (sErrFontFileNotFound, [fn])
-      else
-        result := FPaths[r]+fn;
+      if r >= 0 then
+        Result := FPaths[r]+fn;
       end
-    else
-      raise FreeTypeException.CreateFmt (sErrFontFileNotFound, [afilename]);
     end;
+  if (Result='') and doRaise then
+    raise FreeTypeException.CreateFmt (sErrFontFileNotFound, [fn])
 end;
 
 function TFontManager.GetFontId (afilename:string; anindex:integer) : integer;
@@ -527,13 +546,13 @@ begin
     end;
 end;
 
-function TFontManager.CreateGlyph (c : char) : PMgrGlyph;
+function TFontManager.CreateGlyph (c : cardinal) : PMgrGlyph;
 var e : integer;
 begin
   new (result);
   FillByte(Result^,SizeOf(Result),0);
-  result^.character := c;
-  result^.GlyphIndex := FT_Get_Char_Index (CurFont.font, ord(c));
+  result^.character := unicodechar(c);
+  result^.GlyphIndex := FT_Get_Char_Index (CurFont.font, c);
   //WriteFT_Face(CurFont.Font);
   e := FT_Load_Glyph (CurFont.font, result^.GlyphIndex, FT_Load_Default);
   if e <> 0 then
@@ -548,7 +567,7 @@ begin
   CurSize^.Glyphs.Add (result);
 end;
 
-function TFontManager.GetGlyph (c : char) : PMgrGlyph;
+function TFontManager.GetGlyph (c : cardinal) : PMgrGlyph;
 var r : integer;
 begin
   With CurSize^ do
@@ -556,7 +575,7 @@ begin
     r := Glyphs.Count;
     repeat
       dec (r)
-    until (r < 0) or (PMgrGlyph(Glyphs[r])^.character = c);
+    until (r < 0) or (PMgrGlyph(Glyphs[r])^.character = unicodechar(c));
     if r < 0 then
       result := CreateGlyph (c)
     else
@@ -571,10 +590,48 @@ begin
 end;
 
 function TFontManager.MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+
+Var
+  T : Array of cardinal;
+  C,I : Integer;
+
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,Length(Text));
+  For I:=1 to Length(Text) do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Angle,Result);
+end;
+
+function TFontManager.MakeString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+
+Var
+  T : Array of cardinal;
+  c,I : Integer;
+
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TUnicodeStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,C);
+  For I:=1 to c do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Angle,Result);
+end;
+
+
+procedure TFontManager.DoMakeString(Text: Array of cardinal; angle:real; ABitmaps : TBaseStringBitmaps);
+
 var g : PMgrGlyph;
     bm : PFT_BitmapGlyph;
     gl : PFT_Glyph;
-    prevIndex, prevx, c, r, rx : integer;
+    prevIndex, prevx, r, rx : integer;
     pre, adv, pos, kern : FT_Vector;
     buf : PByteArray;
     reverse : boolean;
@@ -582,19 +639,15 @@ var g : PMgrGlyph;
     FBM : PFontBitmap;
 
 begin
-  CurFont := GetFont(FontID);
   if  (Angle = 0) or   // no angle asked, or can't work with angles (not scalable)
       ((CurFont.Font^.face_flags and FT_FACE_FLAG_SCALABLE)=0) then
-    result := MakeString (FontID, Text, Size)
+    DoMakeString (Text, ABitmaps)
   else
     begin
-    InitMakeString (FontID, Size);
-    c := length(text);
-    result := TStringBitmaps.Create(c);
     if (CurRenderMode = FT_RENDER_MODE_MONO) then
-      result.FMode := btBlackWhite
+      ABitmaps.FMode := btBlackWhite
     else
-      result.FMode := bt256Gray;
+      ABitmaps.FMode := bt256Gray;
     MakeTransformation (angle, trans);
     prevIndex := 0;
     prevx := 0;
@@ -602,10 +655,10 @@ begin
     pos.y := 0;
     pre.x := 0;
     pre.y := 0;
-    for r := 0 to c-1 do
+    for r := 0 to Length(Text)-1 do
       begin
       // retrieve loaded glyph
-      g := GetGlyph (Text[r+1]);
+      g := GetGlyph (Text[r]);
       // check kerning
       if UseKerning and (g^.glyphindex <>0) and (PrevIndex <> 0) then
         begin
@@ -625,7 +678,7 @@ begin
       FTCheck(FT_Glyph_To_Bitmap (gl, CurRenderMode, nil, true),sErrMakingString4);
       // Copy what is needed to record
       bm := PFT_BitmapGlyph(gl);
-      FBM:=result.Bitmaps[r];
+      FBM:=ABitmaps.Bitmaps[r];
       with FBM^ do
         begin
         with gl^.advance do
@@ -675,36 +728,68 @@ begin
       // finish rendered glyph
       FT_Done_Glyph (gl);
       end;
-    result.FText := Text;
-    result.CalculateGlobals;
+    ABitmaps.CalculateGlobals;
     end;
 end;
 
 function TFontManager.MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+
+Var
+  T : Array of Cardinal;
+  C,I : Integer;
+  
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,Length(Text));
+  For I:=1 to Length(Text) do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Result);
+end;
+
+function TFontManager.MakeString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+
+Var
+  T : Array of Cardinal;
+  C,I : Integer;
+  
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TUnicodeStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,C);
+  For I:=1 to C do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Result);
+end;
+
+Procedure TFontManager.DoMakeString (Text : Array of cardinal; ABitmaps  : TBaseStringBitmaps);
+
 var g : PMgrGlyph;
     bm : PFT_BitmapGlyph;
     gl : PFT_Glyph;
-    e, prevIndex, prevx, c, r, rx : integer;
+    e, prevIndex, prevx, r, rx : integer;
     pos, kern : FT_Vector;
     buf : PByteArray;
     reverse : boolean;
 begin
-  CurFont := GetFont(FontID);
-  InitMakeString (FontID, Size);
-  c := length(text);
-  result := TStringBitmaps.Create(c);
   if (CurRenderMode = FT_RENDER_MODE_MONO) then
-    result.FMode := btBlackWhite
+    ABitmaps.FMode := btBlackWhite
   else
-    result.FMode := bt256Gray;
+    ABitmaps.FMode := bt256Gray;
   prevIndex := 0;
   prevx := 0;
   pos.x := 0;
   pos.y := 0;
-  for r := 0 to c-1 do
+  for r := 0 to length(text)-1 do
     begin
     // retrieve loaded glyph
-    g := GetGlyph (Text[r+1]);
+    g := GetGlyph (Text[r]);
     // check kerning
     if UseKerning and (g^.glyphindex <>0) and (PrevIndex <> 0) then
       begin
@@ -719,7 +804,7 @@ begin
     FTCheck(FT_Glyph_To_Bitmap (gl, CurRenderMode, @pos, true),sErrMakingString4);
     // Copy what is needed to record
     bm := PFT_BitmapGlyph(gl);
-    with result.Bitmaps[r]^ do
+    with ABitmaps.Bitmaps[r]^ do
       begin
       with gl^.advance do
         begin
@@ -761,8 +846,7 @@ begin
     // finish rendered glyph
     FT_Done_Glyph (gl);
     end;
-  result.FText := Text;
-  result.CalculateGlobals;
+  ABitmaps.CalculateGlobals;
 end;
 
 function TFontManager.GetString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
@@ -795,6 +879,36 @@ begin
   result := MakeString (FontID, text, Size);
 end;
 
+function TFontManager.GetString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+// Black and white
+begin
+  CurRenderMode := FT_RENDER_MODE_MONO;
+  result := MakeString (FontID, text, Size, angle);
+end;
+
+function TFontManager.GetStringGray (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+// Anti Aliased gray scale
+begin
+  CurRenderMode := FT_RENDER_MODE_NORMAL;
+  result := MakeString (FontID, text, Size, angle);
+end;
+
+{ Procedures without angle have own implementation to have better speed }
+
+function TFontManager.GetString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+// Black and white, following the direction of the font (left to right, top to bottom, ...)
+begin
+  CurRenderMode := FT_RENDER_MODE_MONO;
+  result := MakeString (FontID, text, Size);
+end;
+
+function TFontManager.GetStringGray (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+// Anti Aliased gray scale, following the direction of the font (left to right, top to bottom, ...)
+begin
+  CurRenderMode := FT_RENDER_MODE_NORMAL;
+  result := MakeString (FontID, text, Size);
+end;
+
 function TFontManager.RequestFont (afilename:string) : integer;
 begin
   result := RequestFont (afilename,0);
@@ -821,17 +935,17 @@ end;
 
 { TStringBitmaps }
 
-function TStringBitmaps.GetCount : integer;
+function TBaseStringBitmaps.GetCount : integer;
 begin
   result := FList.Count;
 end;
 
-function TStringBitmaps.GetBitmap (index:integer) : PFontBitmap;
+function TBaseStringBitmaps.GetBitmap (index:integer) : PFontBitmap;
 begin
   result := PFontBitmap(FList[index]);
 end;
 
-constructor TStringBitmaps.Create (ACount : integer);
+constructor TBaseStringBitmaps.Create (ACount : integer);
 var r : integer;
     bm : PFontBitmap;
 begin
@@ -846,7 +960,7 @@ begin
     end;
 end;
 
-destructor TStringBitmaps.destroy;
+destructor TBaseStringBitmaps.destroy;
 var r : integer;
     bm : PFontBitmap;
 begin
@@ -868,7 +982,7 @@ begin
 end;
 *)
 
-procedure TStringBitmaps.CalculateGlobals;
+procedure TBAseStringBitmaps.CalculateGlobals;
 var
   l,r : integer;
 
@@ -907,7 +1021,7 @@ begin
     end;
 end;
 
-procedure TStringBitmaps.GetBoundRect (out aRect : TRect);
+procedure TBaseStringBitmaps.GetBoundRect (out aRect : TRect);
 begin
   aRect := FBounds;
 end;
diff --git a/packages/fcl-image/src/ftfont.pp b/packages/fcl-image/src/ftfont.pp
index 27cb9d2850..7615d7772a 100644
--- a/packages/fcl-image/src/ftfont.pp
+++ b/packages/fcl-image/src/ftfont.pp
@@ -27,12 +27,13 @@ type
   private
     FResolution : longword;
     FAntiAliased : boolean;
-    FLastText : TStringBitmaps;
+    FLastText : TBaseStringBitmaps;
     FIndex, FFontID : integer;
     FFace : PFT_Face;
     FAngle : real;
     procedure ClearLastText;
   protected
+    procedure DrawLastText (atX,atY:integer);
     procedure DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer); virtual;
     procedure DrawCharBW (x,y:integer; data:PByteArray; pitch, width, height:integer); virtual;
     procedure SetName (AValue:string); override;
@@ -47,7 +48,12 @@ type
     procedure DoGetTextSize (text:string; var w,h:integer); override;
     function DoGetTextHeight (text:string) : integer; override;
     function DoGetTextWidth (text:string) : integer; override;
+    procedure DoDrawText (atx,aty:integer; atext: unicodestring); override;
+    procedure DoGetTextSize (text:unicodestring; var w,h:integer); override;
+    function DoGetTextHeight (text:unicodestring) : integer; override;
+    function DoGetTextWidth (text: unicodestring) : integer; override;
     procedure GetText (aText:string);
+    procedure GetText (aText:unicodestring);
     procedure GetFace;
   public
     constructor create; override;
@@ -180,6 +186,36 @@ begin
     result := right - left;
 end;
 
+procedure TFreeTypeFont.DoGetTextSize (text:unicodestring; var w,h:integer);
+var r : TRect;
+begin
+  GetText (text);
+  FLastText.GetBoundRect (r);
+  with r do
+    begin
+    w := right - left;
+    h := top - bottom;
+    end;
+end;
+
+function TFreeTypeFont.DoGetTextHeight (text:unicodestring) : integer;
+var r : TRect;
+begin
+  GetText (text);
+  FLastText.GetBoundRect (r);
+  with r do
+    result := top - bottom;
+end;
+
+function TFreeTypeFont.DoGetTextWidth (text:unicodestring) : integer;
+var r : TRect;
+begin
+  GetText (text);
+  FLastText.GetBoundRect (r);
+  with r do
+    result := right - left;
+end;
+
 procedure TFreeTypeFont.SetFlags (index:integer; AValue:boolean);
 begin
   if not (index in [5,6]) then   // bold,italic
@@ -213,7 +249,39 @@ var b : boolean;
 begin
   if assigned (FLastText) then
     begin
-    if CompareStr(FLastText.Text,aText) <> 0 then
+    if FLastText.InheritsFrom(TUnicodeStringBitmaps) or  (CompareStr(TStringBitMaps(FLastText).Text,aText) <> 0) then
+      begin
+      FLastText.Free;
+      b := true;
+      end
+    else
+      begin
+      if FAntiAliased then
+        b := (FLastText.mode <> bt256Gray)
+      else
+        b := (FLastText.mode <> btBlackWhite);
+      if b then
+        FLastText.Free;
+      end;
+    end
+  else
+    b := true;
+  if b then
+    begin
+    FontMgr.Resolution := FResolution;
+    if FAntiAliased then
+      FLastText := FontMgr.GetStringGray (FFontId, aText, Size, Angle)
+    else
+      FLastText := FontMgr.GetString (FFontId, aText, Size, Angle);
+    end;
+end;
+
+procedure TFreeTypeFont.GetText (aText:Unicodestring);
+var b : boolean;
+begin
+  if assigned (FLastText) then
+    begin
+    if FLastText.InheritsFrom(TStringBitmaps) or  (TUnicodeStringBitMaps(FLastText).Text<>aText) then
       begin
       FLastText.Free;
       b := true;
@@ -240,10 +308,25 @@ begin
     end;
 end;
 
+procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:unicodestring);
+
+begin
+  GetText (atext);
+  DrawLastText(atX,atY);
+end;
+
 procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:string);
-var r : integer;
+
 begin
   GetText (atext);
+  DrawLastText(atX,atY);
+end;
+
+procedure TFreeTypeFont.DrawLastText (atX,atY:integer);
+
+var r : integer;
+
+begin
   with FLastText do
     for r := 0 to count-1 do
       with Bitmaps[r]^ do
diff --git a/packages/fcl-js/examples/fpjsmin.pp b/packages/fcl-js/examples/fpjsmin.pp
new file mode 100644
index 0000000000..2381c00080
--- /dev/null
+++ b/packages/fcl-js/examples/fpjsmin.pp
@@ -0,0 +1,21 @@
+{$mode objfpc}{$h+}
+{$inline on}
+program fpjsmin;
+
+uses jsminifier;
+
+
+begin
+  if ParamCount<>2 then
+    begin
+    Writeln('Usage: fpjsmin infile outfile');
+    halt(1);
+    end;
+  With TJSONMinifier.Create(Nil) do
+    try
+       FileHeader.Add(paramstr(1));
+       Execute(ParamStr(1),ParamStr(2));
+    finally
+      Free
+    end;
+end.
diff --git a/packages/fcl-js/fpmake.pp b/packages/fcl-js/fpmake.pp
index 315adb4db4..9d4e0ed9b3 100644
--- a/packages/fcl-js/fpmake.pp
+++ b/packages/fcl-js/fpmake.pp
@@ -25,6 +25,8 @@ begin
     P.Description := 'Javascript scanner/parser/syntax tree units';
     P.OSes:=AllOSes-[embedded,msdos];
 
+    P.Dependencies.Add('fcl-base');
+
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');
 
@@ -37,6 +39,8 @@ begin
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('jswriter.pp');
       T.ResourceStrings:=true;
+    T:=P.Targets.AddUnit('jsminifier.pp');
+      T.ResourceStrings:=true;
 {$ifndef ALLPACKAGES}
     Run;
     end;
diff --git a/packages/fcl-js/src/jsbase.pp b/packages/fcl-js/src/jsbase.pp
index 2ed58539e3..bfa0d27867 100644
--- a/packages/fcl-js/src/jsbase.pp
+++ b/packages/fcl-js/src/jsbase.pp
@@ -1,3 +1,18 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript base definitions
+            
+    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 jsbase;
 
 {$mode objfpc}{$H+}
@@ -10,7 +25,9 @@ uses
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,JSTCompletion);
 
-  TJSString = WideString;
+  TJSString = UnicodeString;
+  TJSChar = WideChar;
+  TJSPChar = PWideChar;
   TJSNumber = Double;
 
   { TJSValue }
@@ -24,6 +41,7 @@ Type
       1 : (F : TJSNumber);
       2 : (I : Integer);
     end;
+    FCustomValue: TJSString;
     procedure ClearValue(ANewValue: TJSType);
     function GetAsBoolean: Boolean;
     function GetAsCompletion: TObject;
@@ -49,6 +67,7 @@ Type
     Constructor Create(AString: TJSString);
     Destructor Destroy; override;
     Property ValueType : TJSType Read FValueType;
+    Property CustomValue: TJSString Read FCustomValue Write FCustomValue;
     Property IsUndefined : Boolean Read GetIsUndefined Write SetIsUndefined;
     Property IsNull : Boolean Read GetIsNull Write SetIsNull;
     Property AsNumber : TJSNumber Read GetAsNumber Write SetAsNumber;
@@ -59,10 +78,90 @@ Type
     Property AsCompletion : TObject Read GetAsCompletion Write SetAsCompletion;
   end;
 
+function IsValidJSIdentifier(Name: TJSString; AllowEscapeSeq: boolean = false): boolean;
+
 implementation
 
-{ TJSValue }
+function IsValidJSIdentifier(Name: TJSString; AllowEscapeSeq: boolean): boolean;
+var
+  p: TJSPChar;
+  i: Integer;
+begin
+  Result:=false;
+  if Name='' then exit;
+  p:=TJSPChar(Name);
+  repeat
+    case p^ of
+    #0:
+      if p-TJSPChar(Name)=length(Name) then
+        exit(true)
+      else
+        exit;
+    '0'..'9':
+      if p=TJSPChar(Name) then
+        exit
+      else
+        inc(p);
+    'a'..'z','A'..'Z','_','$': inc(p);
+    '\':
+      begin
+      if not AllowEscapeSeq then exit;
+      inc(p);
+      if p^='x' then
+        begin
+        // \x00
+        for i:=1 to 2 do
+          begin
+          inc(p);
+          if not (p^ in ['0'..'9','a'..'f','A'..'F']) then exit;
+          end;
+        end
+      else if p^='u' then
+        begin
+        inc(p);
+        if p^='{' then
+          begin
+          // \u{00000}
+          i:=0;
+          repeat
+            inc(p);
+            case p^ of
+            '}': break;
+            '0'..'9': i:=i*16+ord(p^)-ord('0');
+            'a'..'f': i:=i*16+ord(p^)-ord('a')+10;
+            'A'..'F': i:=i*16+ord(p^)-ord('A')+10;
+            else exit;
+            end;
+            if i>$10FFFF then exit;
+          until false;
+          inc(p);
+          end
+        else
+          begin
+          // \u0000
+          for i:=1 to 4 do
+            begin
+            inc(p);
+            if not (p^ in ['0'..'9','a'..'f','A'..'F']) then exit;
+            end;
+          end;
+        end
+      else
+        exit; // unknown sequence
+      end;
+    #$200C,#$200D: inc(p); // zero width non-joiner/joiner
+    #$00AA..#$2000,
+    #$200E..#$D7FF:
+      inc(p); // ToDo: only those with ID_START/ID_CONTINUE see https://codepoints.net/search?IDC=1
+    #$D800..#$DBFF:
+      inc(p,2); // see above
+    else
+      exit;
+    end;
+  until false;
+end;
 
+{ TJSValue }
 
 function TJSValue.GetAsBoolean: Boolean;
 begin
@@ -80,25 +179,33 @@ end;
 function TJSValue.GetAsNumber: TJSNumber;
 begin
   If (ValueType=jstNumber) then
-    Result:=FValue.F;
+    Result:=FValue.F
+  else
+    Result:=0.0;
 end;
 
 function TJSValue.GetAsObject: TObject;
 begin
   If (ValueType=jstObject) then
-    Result:=TObject(FValue.P);
+    Result:=TObject(FValue.P)
+  else
+    Result:=nil;
 end;
 
 function TJSValue.GetAsReference: TObject;
 begin
   If (ValueType=jstReference) then
-    Result:=TObject(FValue.P);
+    Result:=TObject(FValue.P)
+  else
+    Result:=nil;
 end;
 
 function TJSValue.GetAsString: TJSString;
 begin
   If (ValueType=jstString) then
-    Result:=String(FValue.P);
+    Result:=TJSString(FValue.P)
+  else
+    Result:='';
 end;
 
 function TJSValue.GetIsNull: Boolean;
@@ -121,6 +228,7 @@ begin
     FValue.I:=0;
   end;
   FValueType:=ANewValue;
+  FCustomValue:='';
 end;
 
 procedure TJSValue.SetAsBoolean(const AValue: Boolean);
@@ -156,45 +264,51 @@ end;
 procedure TJSValue.SetAsString(const AValue: TJSString);
 begin
   ClearValue(jstString);
-  String(FValue.P):=AValue;
+  TJSString(FValue.P):=AValue;
 end;
 
 procedure TJSValue.SetIsNull(const AValue: Boolean);
 begin
-  ClearValue(jstNull);
+  if AValue then
+    ClearValue(jstNull)
+  else if IsNull then
+    ClearValue(jstUNDEFINED);
 end;
 
 procedure TJSValue.SetIsUndefined(const AValue: Boolean);
 begin
-  ClearValue(jstUndefined);
+  if AValue then
+    ClearValue(jstUndefined)
+  else if IsUndefined then
+    ClearValue(jstNull);
 end;
 
-Constructor TJSValue.CreateNull;
+constructor TJSValue.CreateNull;
 begin
   IsNull:=True;
 end;
 
-Constructor TJSValue.Create;
+constructor TJSValue.Create;
 begin
   IsUndefined:=True;
 end;
 
-Constructor TJSValue.Create(ANumber: TJSNumber);
+constructor TJSValue.Create(ANumber: TJSNumber);
 begin
   AsNumber:=ANumber;
 end;
 
-Constructor TJSValue.Create(ABoolean: Boolean);
+constructor TJSValue.Create(ABoolean: Boolean);
 begin
   AsBoolean:=ABoolean;
 end;
 
-Constructor TJSValue.Create(AString: TJSString);
+constructor TJSValue.Create(AString: TJSString);
 begin
-  AsString:=AString
+  AsString:=AString;
 end;
 
-Destructor TJSValue.Destroy;
+destructor TJSValue.Destroy;
 begin
   ClearValue(jstUndefined);
   inherited Destroy;
diff --git a/packages/fcl-js/src/jsminifier.pp b/packages/fcl-js/src/jsminifier.pp
new file mode 100644
index 0000000000..4a7e24b485
--- /dev/null
+++ b/packages/fcl-js/src/jsminifier.pp
@@ -0,0 +1,440 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript minifier
+            
+    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.
+                                
+  **********************************************************************}
+{ ---------------------------------------------------------------------
+  Javascript minifier, based on an implementation by Douglas Crockford,
+  see original copyright.
+  ---------------------------------------------------------------------}
+{ jsmin.c
+   2013-03-29
+
+Copyright (c) 2002 Douglas Crockford  (www.crockford.com)
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+The Software shall be used for Good, not Evil.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+}
+
+unit jsminifier;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses sysutils,classes,bufstream;
+
+
+Const
+  EOS = #0;
+
+Type
+
+  { TJSONMinifier }
+  EJSONMinifier = Class(Exception);
+
+  TJSONMinifier = Class(TComponent)
+  Private
+    FA : char;
+    FB : char;
+    FFileHeader: TStrings;
+    FLookahead : char;
+    FX : char;
+    FY : char ;
+    Fin : TStream;
+    Fout : TStream;
+    procedure SetFileHeader(AValue: TStrings);
+  Protected
+    // Token reading routines
+    function Peek : char;
+    function Get : char;inline;
+    function Next : char;
+    // Token writing routines
+    procedure Putc(c: char);inline;
+    Procedure Reset;
+    procedure DoHeader; virtual;
+    procedure Error(Const Msg: string);
+    Class Function isAlphaNum(c: char): boolean;
+    Class Function iif(B : Boolean; Const ifTrue,ifFalse : integer) : integer; inline;
+    procedure Action(d: Byte);
+    procedure Minify;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Execute(Const SourceFilename,DestFilename : String);
+    Procedure Execute(Source,Dest : TStream);
+    Procedure Execute(SourceFilenames : TStrings; Const DestFilename : String);
+    Procedure Execute(SourceFileNames : Array of string; Const DestFilename : String);
+  Published
+    Property FileHeader : TStrings Read FFileHeader Write SetFileHeader;
+  end;
+
+Implementation
+
+Resourcestring
+  SErrUnterminatedComment = 'Unterminated comment.';
+  SErrUnterminatedStringLiteral = 'Unterminated string literal.';
+  SErrUnterminatedSetInRegexp = 'Unterminated set in Regular Expression literal.';
+  SerrUnterminatedRegexp = 'Unterminated Regular Expression literal.';
+
+class function TJSONMinifier.iif(B: Boolean; const ifTrue, ifFalse: integer
+  ): integer;
+
+begin
+  if B then
+    Result:=ifTrue
+  else
+    Result:=ifFalse;
+end;
+
+procedure TJSONMinifier.Error(const Msg: string);
+
+begin
+  Raise EJSONMinifier.Create('JSMIN Error: '+Msg);
+end;
+
+procedure TJSONMinifier.SetFileHeader(AValue: TStrings);
+begin
+  if FFileHeader=AValue then Exit;
+  FFileHeader.Assign(AValue);
+end;
+
+procedure TJSONMinifier.Reset;
+
+begin
+  FA:=EOS;
+  FB:=EOS;
+  FLookahead:=EOS;
+  FX:=EOS;
+  FY:=EOS;
+end;
+
+class function TJSONMinifier.isAlphaNum(c: char): boolean;
+
+begin
+  Result:= (C in ['a'..'z']) or (c in ['0'..'9']) or (c in ['A'..'Z']) or (C in ['_','$','\']) or (c > #126);
+end;
+
+
+function TJSONMinifier.Get: char;
+
+begin
+  Result:=FLookahead;
+  FLookahead:=EOS;
+  if (Result=EOS) then
+    if Fin.Read(Result,sizeof(Result))=0 then exit;
+  if (Result>' ') or (Result in [#10,EOS]) then
+    Exit;
+  if (Result=#13) then
+    Result:=#10
+  else
+    Result:=' ';
+end;
+
+
+function TJSONMinifier.Peek: char;
+begin
+  FLookahead := get();
+  result:=FLookahead;
+end;
+
+function TJSONMinifier.Next: char;
+
+var
+ c : char;
+
+begin
+  c:= get();
+  if (c='/') then
+    case peek of
+      '/': Repeat
+             c := get();
+           until (c <= #10);
+      '*':
+           begin
+           Get();
+           while (c <> ' ') do
+             case get of
+               '*':
+                 begin
+                 if (peek()= '/') then
+                   begin
+                   get();
+                   c:=' ';
+                   end;
+                 end;
+               EOS:
+                 Error(SErrUnterminatedComment);
+              end;
+           end;
+    end;
+  FY:=FX;
+  FX:=c;
+  Result:=c;
+end;
+
+procedure TJSONMinifier.Putc(c: char);
+
+begin
+  Fout.writebuffer(c,sizeof(c));
+end;
+
+procedure TJSONMinifier.Action(d : Byte);
+
+  Procedure Do1;
+
+  begin
+    putc(FA);
+    if ((FY in [#10,' '])
+        and (FA in ['+','-','*','/'])
+        and (FB in ['+','-','*','/'])) then
+      putc(FY);
+  end;
+
+  Procedure Do2;
+
+  begin
+    FA:=FB;
+    if (FA in ['''','"','`']) then
+      While true do
+        begin
+        putc(FA);
+        FA:= get();
+        if (FA=FB) then
+          break;
+        if (FA='\') then
+          begin
+          putc(FA);
+          FA:=get();
+          end;
+        if (FA=EOS) then
+          Error(SErrUnterminatedStringLiteral);
+        end;
+  end;
+
+begin
+  if (D=1) then
+    Do1;
+  if (D in [1,2]) then
+    Do2;
+  FB := next();
+  if (FB='/') and (FA in ['(',',','=',':','[','!','&','|','?','+','-','~','*','/','{',#10]) then
+    begin
+    putc(FA);
+    if (FA in ['/','*']) then
+       putc(' ');
+    putc(FB);
+    While true do
+      begin
+      FA := get();
+      if (FA='[') then
+        begin
+        While true do
+          begin
+          putc(FA);
+          FA := get();
+          if (FA = ']') then
+            break;
+          if (FA = '\') then
+            begin
+            putc(FA);
+            FA := get();
+            end;
+          if (FA = EOS) then
+            Error(SErrUnterminatedSetInRegexp);
+          end
+        end
+      else if (FA = '/') then
+        begin
+        case (peek()) of
+           '/', '*':
+            Error(SErrUnterminatedSetInRegexp);
+        end;
+        Break;
+        end
+      else if (FA ='\') then
+        begin
+        putc(FA);
+        FA := get();
+        end;
+      if (FA = EOS) then
+        Error(SErrUnterminatedRegexp);
+      putc(FA);
+      end;
+    FB := next();
+    end;
+end;
+
+
+procedure TJSONMinifier.Minify;
+
+begin
+  if (peek()= #$EF) then
+    begin
+    get();
+    get();
+    get();
+    end;
+  FA:=#10;
+  action(3);
+  while (FA <> EOS) do
+    begin
+    case (FA) of
+      ' ':
+        action(iif(isAlphanum(FB),1,2));
+      #10:
+        case (FB) of
+          '{', '[', '(', '+', '-', '!', '~':
+            Action(1);
+          ' ':
+                Action(3);
+        else
+          Action(iif(isAlphanum(FB), 1 , 2));
+        end;
+    else
+      case (FB) of
+        ' ':
+          Action(iif(isAlphanum(FA),1,3));
+        #10:
+          case (FA) of
+            '}',']',')','+','-','"', '''', '`':
+              Action(1);
+          else
+            Action(iif(isAlphanum(FA), 1, 3));
+         end;
+      else
+        Action(1);
+      end;
+    end;
+    end;
+end;
+
+constructor TJSONMinifier.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FFileHeader:=TStringList.Create;
+end;
+
+destructor TJSONMinifier.Destroy;
+begin
+  FreeAndNil(FFileHeader);
+  inherited Destroy;
+end;
+
+procedure TJSONMinifier.Execute(const SourceFilename, DestFilename: String);
+
+Var
+ Src,Dest : TBufStream;
+
+begin
+ Dest:=Nil;
+ Src:=TReadBufStream.Create(TFileStream.Create(SourceFileName,fmOpenRead or fmShareDenyWrite),1000);
+ try
+   Src.SourceOwner:=True;
+   Dest:=TWriteBufStream.Create(TFileStream.create(DestFileName,fmCreate),1000);
+   Dest.SourceOwner:=True;
+   Execute(Src,Dest);
+ finally
+   Src.Free;
+   Dest.Free;
+ end;
+end;
+
+procedure TJSONMinifier.DoHeader;
+
+Var
+  S,L : String;
+
+begin
+  For S in FFileHeader do
+    begin
+    L:='// '+S+sLineBreak;
+    Fout.WriteBuffer(L[1],Length(L));
+    end;
+end;
+
+procedure TJSONMinifier.Execute(Source, Dest: TStream);
+
+begin
+  Fin:=Source;
+  Fout:=Dest;
+  try
+    Reset;
+    DoHeader;
+    Minify;
+  finally
+    Fin:=Nil;
+    Fout:=Nil;
+  end;
+end;
+
+procedure TJSONMinifier.Execute(SourceFilenames: TStrings;const DestFilename: String);
+
+Var
+  Src,Dest : TBufStream;
+  I : Integer;
+
+begin
+ Dest:=Src;
+ Dest:=TWriteBufStream.Create(TFileStream.create(DestFileName,fmCreate),1000);
+ try
+   Dest.SourceOwner:=True;
+   for I:=0 to SourceFileNames.Count-1 do
+     begin
+     Src:=TReadBufStream.Create(TFileStream.Create(SourceFileNames[i],fmOpenRead or fmShareDenyWrite),1000);
+     Src.SourceOwner:=True;
+     Execute(Src,Dest);
+     FreeAndNil(Src);
+     end;
+ finally
+   FreeAndNil(Src);
+   FreeAndNil(Dest);
+ end;
+end;
+
+procedure TJSONMinifier.Execute(SourceFileNames: array of string;
+  const DestFilename: String);
+
+Var
+  S : TStrings;
+
+begin
+  S:=TStringList.Create;
+  try
+    S.AddStrings(SourceFileNames);
+    Execute(S,DestFileName);
+  finally
+    S.Free;
+  end;
+end;
+
+
+end.
+
diff --git a/packages/fcl-js/src/jsparser.pp b/packages/fcl-js/src/jsparser.pp
index c231635e6d..dcfb242ceb 100644
--- a/packages/fcl-js/src/jsparser.pp
+++ b/packages/fcl-js/src/jsparser.pp
@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript parser
+            
+    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 jsparser;
 
 { $define debugparser}
@@ -25,8 +39,6 @@ Type
     FPrevious,
     FCurrent : TJSToken;
     FCurrentString : String;
-    FNextNewLine : Boolean;
-    FNextBol : Boolean;
     FFreeScanner : Boolean;
     FCurrentVars : TJSElementNodes;
     FPeekToken: TJSToken;
@@ -141,7 +153,7 @@ Resourcestring
   SErrCatchFinallyExpected   = 'Unexpected token: Expected ''catch'' or ''finally''';
   SErrArgumentsExpected      = 'Unexpected token: Expected '','' or '')'', got %s';
   SErrArrayEnd               = 'Unexpected token: Expected '','' or '']'', got %s';
-  SErrObjectEnd              = 'Unexpected token: Expected '','' or ''}'', got %s';
+  //SErrObjectEnd              = 'Unexpected token: Expected '','' or ''}'', got %s';
   SErrObjectElement          = 'Unexpected token: Expected string, identifier or number after '','' got: %s';
   SErrLiteralExpected        = 'Unexpected token: Expected: null, true, false, number, string, or regex, got: %s';
   SErrInvalidnumber          = 'Invalid numerical value: %s';
@@ -176,6 +188,7 @@ begin
     FCurrent:=FScanner.FetchToken;
     FCurrentString:=FScanner.CurTokenString;
     end;
+  Result:=FCurrent;
   {$ifdef debugparser}Writeln('GetNextToken (',FScanner.CurLine,',',FScanner.CurColumn,'): ',GetEnumName(TypeInfo(TJSToken),Ord(FCurrent)), ' As string: ',FCurrentString);{$endif debugparser}
 end;
 
@@ -557,8 +570,6 @@ function TJSParser.ParseObjectLiteral: TJSElement;
 Var
   N : TJSObjectLiteral;
   E : TJSObjectLiteralElement;
-  I : Integer;
-
 begin
   Consume(tjsCurlyBraceOpen);
   N:=TJSObjectLiteral(CreateElement(TJSObjectLiteral));
@@ -618,9 +629,6 @@ function TJSParser.ParseStringLiteral: TJSElement;
 
 Var
   L : TJSLiteral;
-  D : Double;
-  I : Integer;
-
 begin
     {$ifdef debugparser} Writeln('Parsing string literal');{$endif debugparser}
   Result:=Nil;
@@ -746,7 +754,6 @@ Var
   M  : TJSDotMemberExpression;
   N  : TJSNewMemberExpression;
   B  : TJSBracketMemberExpression;
-  C : TJSCallExpression;
   Done : Boolean;
 
 begin
@@ -758,7 +765,7 @@ begin
                   N:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression));
                   try
                     Result:=N;
-                    N.Mexpr:=ParseMemberExpression();
+                    N.MExpr:=ParseMemberExpression();
                     if (CurrentToken=tjsBraceOpen) then
                       N.Args:=ParseArguments;
                   except
@@ -1378,7 +1385,6 @@ end;
 function TJSParser.ParseVariableStatement : TJSElement;
 
 Var
-  E : TJSElement;
   V : TJSVariableStatement;
 
 begin
@@ -1429,7 +1435,7 @@ begin
     I:=TJSIfStatement(CreateElement(TJSIfStatement));
     I.Cond:=C;
     I.BTrue:=Btrue;
-    I.bfalse:=BFalse;
+    I.BFalse:=BFalse;
     Result:=I;
   except
     FreeAndNil(C);
@@ -1641,8 +1647,6 @@ function TJSParser.ParseWithStatement : TJSElement;
 
 Var
   W : TJSWithStatement;
-  N : TJSElement;
-
 begin
   W:=TJSWithStatement(CreateElement(TJSWithStatement));
   try
@@ -1655,6 +1659,7 @@ begin
     FreeAndNil(W);
     Raise;
   end;
+  Result:=W;
 end;
 
 function TJSParser.ParseSwitchStatement : TJSElement;
@@ -1662,7 +1667,6 @@ function TJSParser.ParseSwitchStatement : TJSElement;
 
 Var
   N : TJSSwitchStatement;
-  C : TJSElement;
   Ca : TJSCaseElement;
 
 begin
@@ -1813,6 +1817,7 @@ begin
         end
       else
         n:='';
+      if n='' then ; // what to do with that?
       Consume(tjsBraceOpen);
       F.AFunction:= TJSFuncDef.Create;
       Args:=ParseFormalParameterList;
@@ -1883,8 +1888,6 @@ function TJSParser.ParseLabeledStatement : TJSElement;
 Var
   OL : TJSLabelSet;
   LS : TJSLabeledStatement;
-  LN : String;
-
 begin
   LS:=TJSLabeledStatement(CreateElement(TJSLabeledStatement));
   try
@@ -2046,7 +2049,7 @@ begin
           If (PeekNextToken<>tjsBraceOpen) then
             begin
             F:=Self.ParseFunctionDeclaration;
-            Result.functions.AddNode.Node:=F;
+            Result.Functions.AddNode.Node:=F;
             end
           else
             begin
@@ -2095,8 +2098,6 @@ end;
 Function TJSParser.ParseProgram: TJSFunctionDeclarationStatement;
 
 Var
-  F : TJSFunctionDeclarationStatement;
-  FD : TJSFuncDef;
   B : TJSElement;
 begin
   {$ifdef debugparser} Writeln('>>> Entering FunctionDeclarationStatement');{$endif}
diff --git a/packages/fcl-js/src/jsscanner.pp b/packages/fcl-js/src/jsscanner.pp
index 884fca6be5..86c5564939 100644
--- a/packages/fcl-js/src/jsscanner.pp
+++ b/packages/fcl-js/src/jsscanner.pp
@@ -79,7 +79,6 @@ Type
     FCurToken: TJSToken;
     FCurTokenString: string;
     FCurLine: string;
-    FDefines: TStrings;
     TokenStr: PChar;
     FWasEndOfLine : Boolean;
     FSourceStream : TStream;
@@ -377,7 +376,7 @@ function TJSScanner.DoStringLiteral: TJSToken;
 Var
   Delim : Char;
   TokenStart : PChar;
-  Len,OLen,I : Integer;
+  Len,OLen: Integer;
   S : String;
 
 begin
@@ -516,18 +515,15 @@ begin
       FCurToken := Result;
       exit;
       end;
+    {$Push}
+    {$R-}
     I:=Succ(I);
+    {$Pop}
     end
 end;
 
 Function TJSScanner.FetchToken: TJSToken;
 
-
-var
-  TokenStart, CurPos: PChar;
-  i: TJSToken;
-  OldLength, SectionLength, NestingLevel, Index: Integer;
-
 begin
   if not (FCurtoken in [tjsWhiteSpace,tjsComment]) then
     FWasEndOfLine:=False;
@@ -541,7 +537,7 @@ begin
         exit;
         end;
       end;
-    CurPos:=TokenStr;
+    //CurPos:=TokenStr;
     FCurTokenString := '';
     case TokenStr[0] of
       #0:         // Empty line
diff --git a/packages/fcl-js/src/jssrcmap.pas b/packages/fcl-js/src/jssrcmap.pas
new file mode 100644
index 0000000000..94ca276603
--- /dev/null
+++ b/packages/fcl-js/src/jssrcmap.pas
@@ -0,0 +1,621 @@
+{ *********************************************************************
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 Mattias Gaertner.
+
+    Javascript Source Map
+
+    See Source Maps Revision 3:
+    https://docs.google.com/document/d/1U1RGAehQwRypUTovF1KRlpiOFze0b-_2gc6fAH0KY0k/edit?hl=en_US&pli=1&pli=1#
+
+    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 JSSrcMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, fpjson;
+
+const
+  Base64Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+  DefaultSrcMapHeader = ')]}'+LineEnding;
+
+type
+
+  { TSourceMapSegment }
+
+  TSourceMapSegment = class
+  public
+    Index: integer; // index in FNodes
+    GeneratedLine: integer;
+    GeneratedColumn: integer;
+    SrcFileIndex: integer; // index in FSources
+    SrcLine: integer;
+    SrcColumn: integer;
+    NameIndex: integer; // index in FNames
+  end;
+
+  TSourceMapSrc = class
+  public
+    Filename: string;
+    Source: String;
+  end;
+
+  { TSourceMap }
+
+  TSourceMap = class
+  private
+    type
+
+      { TStringToIndex }
+
+      TStringToIndex = class
+      private
+        FItems: TFPHashList;
+      public
+        constructor Create;
+        destructor Destroy; override;
+        procedure Clear;
+        procedure Add(const Value: String; Index: integer);
+        function FindValue(const Value: String): integer;
+      end;
+  private
+    FAddMonotonous: boolean;
+    FHeader: String;
+    FGeneratedFilename: string;
+    FNames: TStrings; // in adding order
+    FNameToIndex: TStringToIndex; // name to index in FNames
+    FItems: TFPList; // TSourceMapSegment, in adding order
+    FSourceRoot: string;
+    FSources: TFPList; // list of TSourceMapSrc, in adding order
+    FSourceToIndex: TStringToIndex; // srcfile to index in FSources
+    FVersion: integer;
+    function GetNames(Index: integer): string;
+    function GetItems(Index: integer): TSourceMapSegment;
+    function GetSourceContents(Index: integer): String;
+    function GetSourceFiles(Index: integer): String;
+    procedure SetGeneratedFilename(const AValue: string);
+    procedure SetSourceContents(Index: integer; const AValue: String);
+  public
+    constructor Create(const aGeneratedFilename: string);
+    destructor Destroy; override;
+    procedure Clear; virtual;
+    function AddMapping(
+      GeneratedLine: integer; // 1-based
+      GeneratedCol: integer = 0; // 0-based
+      const SourceFile: string = ''; // can be empty ''
+      SrcLine: integer = 1; // 1-based
+      SrcCol: integer = 0; // 0-based
+      const Name: String = ''): TSourceMapSegment; virtual;
+    property AddMonotonous: boolean read FAddMonotonous
+      write FAddMonotonous default true;// true = AddMapping GeneratedLine/Col must be behind last add, false = check all adds for duplicate
+    function CreateMappings: String; virtual;
+    function ToJSON: TJSONObject; virtual;
+    procedure SaveToStream(aStream: TStream); virtual;
+    procedure SaveToFile(Filename: string); virtual;
+    function ToString: string; override;
+    property GeneratedFilename: string read FGeneratedFilename write SetGeneratedFilename;
+    function IndexOfName(const Name: string; AddIfNotExists: boolean = false): integer;
+    function IndexOfSourceFile(const SrcFile: string; AddIfNotExists: boolean = false): integer;
+    function Count: integer;
+    property Items[Index: integer]: TSourceMapSegment read GetItems; default; // segments
+    function SourceCount: integer;
+    property SourceRoot: string read FSourceRoot write FSourceRoot;
+    property SourceFiles[Index: integer]: String read GetSourceFiles;
+    property SourceContents[Index: integer]: String read GetSourceContents write SetSourceContents;
+    function NameCount: integer;
+    property Names[Index: integer]: string read GetNames;
+    property Version: integer read FVersion; // 3
+    property Header: String read FHeader write FHeader; // DefaultSrcMapHeader
+  end;
+
+function EncodeBase64VLQ(i: NativeInt): String; // base64 Variable Length Quantity
+function DecodeBase64VLQ(const s: string): NativeInt; // base64 Variable Length Quantity
+function DecodeBase64VLQ(var p: PChar): NativeInt; // base64 Variable Length Quantity
+
+implementation
+
+function EncodeBase64VLQ(i: NativeInt): String;
+{ Convert signed number to base64-VLQ:
+  Each base64 has 6bit, where the most significant bit is the continuation bit
+  (1=there is a next base64 character).
+  The first character contains the 5 least significant bits of the number.
+  The last bit of the first character is the sign bit (1=negative).
+  For example:
+  A = 0 = %000000 => 0
+  B = 1 = %000001 => -0
+  C = 2 = %000010 => 1
+  iF = 34 5 = %100010 %000101 = 00010 00101 = 1000101 = 69
+}
+
+  procedure RaiseRange;
+  begin
+    raise ERangeError.Create('EncodeBase64VLQ');
+  end;
+
+var
+  digits: NativeInt;
+begin
+  Result:='';
+  if i<0 then
+    begin
+    i:=-i;
+    if i>(High(NativeInt)-1) shr 1 then
+      RaiseRange;
+    i:=(i shl 1)+1;
+    end
+  else
+    begin
+    if i>High(NativeInt) shr 1 then
+      RaiseRange;
+    i:=i shl 1;
+    end;
+  repeat
+    digits:=i and %11111;
+    i:=i shr 5;
+    if i>0 then
+      inc(digits,%100000); // need another char -> set continuation bit
+    Result:=Result+Base64Chars[digits+1];
+  until i=0;
+end;
+
+function DecodeBase64VLQ(const s: string): NativeInt;
+var
+  p: PChar;
+begin
+  if s='' then
+    raise EConvertError.Create('DecodeBase64VLQ empty');
+  p:=PChar(s);
+  Result:=DecodeBase64VLQ(p);
+  if p-PChar(s)<>length(s) then
+    raise EConvertError.Create('DecodeBase64VLQ waste');
+end;
+
+function DecodeBase64VLQ(var p: PChar): NativeInt;
+{ Convert base64-VLQ to signed number,
+  For the fomat see EncodeBase64VLQ
+}
+
+  procedure RaiseInvalid;
+  begin
+    raise ERangeError.Create('DecodeBase64VLQ');
+  end;
+
+const
+  MaxShift = 63-5; // actually log2(High(NativeInt))-5
+var
+  c: Char;
+  digit, Shift: Integer;
+begin
+  Result:=0;
+  Shift:=0;
+  repeat
+    c:=p^;
+    case c of
+    'A'..'Z': digit:=ord(c)-ord('A');
+    'a'..'z': digit:=ord(c)-ord('a')+26;
+    '0'..'9': digit:=ord(c)-ord('0')+52;
+    '+': digit:=62;
+    '/': digit:=63;
+    else RaiseInvalid;
+    end;
+    inc(p);
+    if Shift>MaxShift then
+      RaiseInvalid;
+    inc(Result,(digit and %11111) shl Shift);
+    inc(Shift,5);
+  until digit<%100000;
+  if (Result and 1)>0 then
+    Result:=-(Result shr 1)
+  else
+    Result:=Result shr 1;
+end;
+
+{ TSourceMap.TStringToIndex }
+
+constructor TSourceMap.TStringToIndex.Create;
+begin
+  FItems:=TFPHashList.Create;
+end;
+
+destructor TSourceMap.TStringToIndex.Destroy;
+begin
+  FItems.Clear;
+  FreeAndNil(FItems);
+  inherited Destroy;
+end;
+
+procedure TSourceMap.TStringToIndex.Clear;
+begin
+  FItems.Clear;
+end;
+
+procedure TSourceMap.TStringToIndex.Add(const Value: String; Index: integer);
+begin
+  // Note: nil=0 means not found in TFPHashList
+  FItems.Add(Value,{%H-}Pointer(PtrInt(Index+1)));
+end;
+
+function TSourceMap.TStringToIndex.FindValue(const Value: String
+  ): integer;
+begin
+  // Note: nil=0 means not found in TFPHashList
+  Result:=integer({%H-}PtrInt(FItems.Find(Value)))-1;
+end;
+
+{ TSourceMap }
+
+procedure TSourceMap.SetGeneratedFilename(const AValue: string);
+begin
+  if FGeneratedFilename=AValue then Exit;
+  FGeneratedFilename:=AValue;
+end;
+
+procedure TSourceMap.SetSourceContents(Index: integer; const AValue: String);
+begin
+  TSourceMapSrc(FSources[Index]).Source:=AValue;
+end;
+
+function TSourceMap.GetItems(Index: integer): TSourceMapSegment;
+begin
+  Result:=TSourceMapSegment(FItems[Index]);
+end;
+
+function TSourceMap.GetSourceContents(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).Source;
+end;
+
+function TSourceMap.GetNames(Index: integer): string;
+begin
+  Result:=FNames[Index];
+end;
+
+function TSourceMap.GetSourceFiles(Index: integer): String;
+begin
+  Result:=TSourceMapSrc(FSources[Index]).Filename;
+end;
+
+constructor TSourceMap.Create(const aGeneratedFilename: string);
+begin
+  FVersion:=3;
+  FNames:=TStringList.Create;
+  FNameToIndex:=TStringToIndex.Create;
+  FItems:=TFPList.Create;
+  FSources:=TFPList.Create;
+  FSourceToIndex:=TStringToIndex.Create;
+  FAddMonotonous:=true;
+  FHeader:=DefaultSrcMapHeader;
+  GeneratedFilename:=aGeneratedFilename;
+end;
+
+destructor TSourceMap.Destroy;
+begin
+  Clear;
+  FreeAndNil(FSourceToIndex);
+  FreeAndNil(FSources);
+  FreeAndNil(FItems);
+  FreeAndNil(FNameToIndex);
+  FreeAndNil(FNames);
+  inherited Destroy;
+end;
+
+procedure TSourceMap.Clear;
+var
+  i: Integer;
+begin
+  FSourceToIndex.Clear;
+  for i:=0 to FSources.Count-1 do
+    TObject(FSources[i]).Free;
+  FSources.Clear;
+  for i:=0 to FItems.Count-1 do
+    TObject(FItems[i]).Free;
+  FItems.Clear;
+  FNameToIndex.Clear;
+  FNames.Clear;
+end;
+
+function TSourceMap.AddMapping(GeneratedLine: integer; GeneratedCol: integer;
+  const SourceFile: string; SrcLine: integer; SrcCol: integer;
+  const Name: String): TSourceMapSegment;
+
+  procedure RaiseInvalid(Msg: string);
+  begin
+    raise Exception.CreateFmt('%s (GeneratedLine=%d GeneratedCol=%d SrcFile="%s" SrcLine=%d SrcCol=%d Name="%s")',
+      [Msg,GeneratedLine,GeneratedCol,SourceFile,SrcLine,SrcCol,Name]);
+  end;
+
+var
+  NodeCnt, i: Integer;
+  OtherNode: TSourceMapSegment;
+begin
+  if GeneratedLine<1 then
+    RaiseInvalid('invalid GeneratedLine');
+  if GeneratedCol<0 then
+    RaiseInvalid('invalid GeneratedCol');
+  if SourceFile='' then
+    begin
+    if Count=0 then
+      RaiseInvalid('missing source file');
+    if SrcLine<>1 then
+      RaiseInvalid('invalid SrcLine');
+    if SrcCol<>0 then
+      RaiseInvalid('invalid SrcCol');
+    if Name<>'' then
+      RaiseInvalid('invalid Name');
+    end
+  else
+    begin
+    if SrcLine<1 then
+      RaiseInvalid('invalid SrcLine');
+    if SrcCol<0 then
+      RaiseInvalid('invalid SrcCol');
+    end;
+
+  // check if generated line/col already exists
+  NodeCnt:=Count;
+  if AddMonotonous then
+    begin
+    if NodeCnt>0 then
+      begin
+      OtherNode:=Items[NodeCnt-1];
+      if (OtherNode.GeneratedLine>GeneratedLine)
+          or ((OtherNode.GeneratedLine=GeneratedLine)
+            and (OtherNode.GeneratedColumn>GeneratedCol)) then
+        RaiseInvalid('GeneratedLine/Col not monotonous');
+      // Note: same line/col is allowed
+      end;
+    end
+  else
+    begin
+    for i:=0 to NodeCnt-1 do
+      begin
+      OtherNode:=Items[i];
+      if (OtherNode.GeneratedLine=GeneratedLine) and (OtherNode.GeneratedColumn=GeneratedCol) then
+        RaiseInvalid('duplicate GeneratedLine/Col');
+      end;
+    end;
+
+  // add
+  Result:=TSourceMapSegment.Create;
+  Result.Index:=FItems.Count;
+  Result.GeneratedLine:=GeneratedLine;
+  Result.GeneratedColumn:=GeneratedCol;
+  if SourceFile='' then
+    Result.SrcFileIndex:=-1
+  else
+    Result.SrcFileIndex:=IndexOfSourceFile(SourceFile,true);
+  Result.SrcLine:=SrcLine;
+  Result.SrcColumn:=SrcCol;
+  if Name<>'' then
+    Result.NameIndex:=IndexOfName(Name,true)
+  else
+    Result.NameIndex:=-1;
+  FItems.Add(Result);
+end;
+
+function TSourceMap.CreateMappings: String;
+
+  procedure Add(ms: TMemoryStream; const s: string);
+  begin
+    if s<>'' then
+      ms.Write(s[1],length(s));
+  end;
+
+var
+  ms: TMemoryStream;
+  i, LastGeneratedLine, LastGeneratedColumn, j, LastSrcFileIndex, LastSrcLine,
+    LastSrcColumn, SrcLine, LastNameIndex: Integer;
+  Item: TSourceMapSegment;
+begin
+  Result:='';
+  LastGeneratedLine:=1;
+  LastGeneratedColumn:=0;
+  LastSrcFileIndex:=0;
+  LastSrcLine:=0;
+  LastSrcColumn:=0;
+  LastNameIndex:=0;
+  ms:=TMemoryStream.Create;
+  try
+    for i:=0 to Count-1 do
+      begin
+      Item:=Items[i];
+      if LastGeneratedLine<Item.GeneratedLine then
+        begin
+        // new line
+        LastGeneratedColumn:=0;
+        for j:=LastGeneratedLine+1 to Item.GeneratedLine do
+          ms.WriteByte(ord(';'));
+        LastGeneratedLine:=Item.GeneratedLine;
+        end
+      else if i>0 then
+        begin
+        // not the first segment
+        if (LastGeneratedLine=Item.GeneratedLine)
+            and (LastGeneratedColumn=Item.GeneratedColumn) then
+          continue;
+        ms.WriteByte(ord(','));
+        end;
+      // column diff
+      Add(ms,EncodeBase64VLQ(Item.GeneratedColumn-LastGeneratedColumn));
+      LastGeneratedColumn:=Item.GeneratedColumn;
+
+      if Item.SrcFileIndex<0 then
+        continue; // no source -> segment length 1
+      // src file index diff
+      Add(ms,EncodeBase64VLQ(Item.SrcFileIndex-LastSrcFileIndex));
+      LastSrcFileIndex:=Item.SrcFileIndex;
+      // src line diff
+      SrcLine:=Item.SrcLine-1; // 0 based in version 3
+      Add(ms,EncodeBase64VLQ(SrcLine-LastSrcLine));
+      LastSrcLine:=SrcLine;
+      // src column diff
+      Add(ms,EncodeBase64VLQ(Item.SrcColumn-LastSrcColumn));
+      LastSrcColumn:=Item.SrcColumn;
+      // name index
+      if Item.NameIndex<0 then
+        continue; // no name -> segment length 4
+      Add(ms,EncodeBase64VLQ(Item.NameIndex-LastNameIndex));
+      LastNameIndex:=Item.NameIndex;
+      end;
+    SetLength(Result,ms.Size);
+    if Result<>'' then
+      Move(ms.Memory^,Result[1],ms.Size);
+  finally
+    ms.Free;
+  end;
+end;
+
+function TSourceMap.ToJSON: TJSONObject;
+var
+  Obj: TJSONObject;
+  i: Integer;
+  Arr: TJSONArray;
+  Mappings: String;
+begin
+  Result:=nil;
+  Mappings:=CreateMappings;
+
+  Obj:=TJSONObject.Create;
+  try
+    // "version" - integer
+    Obj.Add('version',Version);
+
+    // "file" - GeneratedFilename
+    if GeneratedFilename<>'' then
+      Obj.Add('file',GeneratedFilename);
+
+    // "sourceRoot" - SourceRoot
+    if SourceRoot<>'' then
+      Obj.Add('sourceRoot',SourceRoot);
+
+    // "sources" - array of filenames
+    Arr:=TJSONArray.Create;
+    Obj.Add('sources',Arr);
+    for i:=0 to SourceCount-1 do
+      Arr.Add(SourceFiles[i]);
+
+    // "sourcesContent" - array of source content: null or source as string
+    // only needed if there is a source
+    i:=SourceCount-1;
+    while i>=0 do
+      if SourceContents[i]='' then
+        dec(i)
+      else
+        begin
+        // there is a source -> add array
+        Arr:=TJSONArray.Create;
+        Obj.Add('sourcesContent',Arr);
+        for i:=0 to SourceCount-1 do
+          if SourceContents[i]='' then
+            Arr.Add(TJSONNull.Create)
+          else
+            Arr.Add(SourceContents[i]);
+        break;
+        end;
+
+    // "names" - array of names
+    Arr:=TJSONArray.Create;
+    Obj.Add('names',Arr);
+    for i:=0 to NameCount-1 do
+      Arr.Add(Names[i]);
+
+    // "mappings" - string
+    Obj.Add('mappings',Mappings);
+
+    Result:=Obj;
+  finally
+    if Result=nil then
+      Obj.Free;
+  end;
+end;
+
+procedure TSourceMap.SaveToStream(aStream: TStream);
+var
+  Obj: TJSONObject;
+begin
+  Obj:=ToJSON;
+  try
+    if Header<>'' then
+      aStream.Write(Header[1],length(Header));
+    Obj.DumpJSON(aStream);
+  finally
+    Obj.Free;
+  end;
+end;
+
+procedure TSourceMap.SaveToFile(Filename: string);
+var
+  TheStream: TMemoryStream;
+begin
+  TheStream:=TMemoryStream.Create;
+  try
+    SaveToStream(TheStream);
+    TheStream.Position:=0;
+    TheStream.SaveToFile(Filename);
+  finally
+    TheStream.Free;
+  end;
+end;
+
+function TSourceMap.ToString: string;
+var
+  Obj: TJSONObject;
+begin
+  Obj:=ToJSON;
+  try
+    Result:=Header+Obj.AsJSON;
+  finally
+    Obj.Free;
+  end;
+end;
+
+function TSourceMap.IndexOfName(const Name: string; AddIfNotExists: boolean
+  ): integer;
+begin
+  Result:=FNameToIndex.FindValue(Name);
+  if (Result>=0) or not AddIfNotExists then exit;
+  Result:=FNames.Count;
+  FNames.Add(Name);
+  FNameToIndex.Add(Name,Result);
+end;
+
+function TSourceMap.IndexOfSourceFile(const SrcFile: string;
+  AddIfNotExists: boolean): integer;
+var
+  Src: TSourceMapSrc;
+begin
+  Result:=FSourceToIndex.FindValue(SrcFile);
+  if (Result>=0) or not AddIfNotExists then exit;
+  Src:=TSourceMapSrc.Create;
+  Src.Filename:=SrcFile;
+  Result:=FSources.Count;
+  FSources.Add(Src);
+  FSourceToIndex.Add(SrcFile,Result);
+end;
+
+function TSourceMap.Count: integer;
+begin
+  Result:=FItems.Count;
+end;
+
+function TSourceMap.SourceCount: integer;
+begin
+  Result:=FSources.Count;
+end;
+
+function TSourceMap.NameCount: integer;
+begin
+  Result:=FNames.Count;
+end;
+
+end.
+
diff --git a/packages/fcl-js/src/jstoken.pp b/packages/fcl-js/src/jstoken.pp
index 1099f2fd22..4554bcdb0c 100644
--- a/packages/fcl-js/src/jstoken.pp
+++ b/packages/fcl-js/src/jstoken.pp
@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript token definitions
+            
+    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 jstoken;
 
 {$mode objfpc}{$H+}
@@ -8,7 +22,7 @@ type
 
   TJSToken = (tjsUnknown,
      // Specials
-     tjsEOF,tjsWhiteSpace,tjsChar,tjsString, tjsIdentifier,tjsNumber, tjsComment,tjsREGEX, tjsRESERVED,
+     tjsEOF,tjsWhiteSpace,tjsChar,tjsString{this bites TJSString}, tjsIdentifier,tjsNumber, tjsComment,tjsREGEX, tjsRESERVED,
      tjsANDAND, tjsANDEQ,
      tjsBraceOpen,tjsBraceClose,tjsSQuaredBraceOpen,tjsSQuaredBraceClose,tjsCurlyBraceOpen,tjsCurlyBraceClose,
      tjsCOMMA,tjsCOLON,  tjsDOT,tjsSEMICOLON, tjsASSIGN,tjsGT,tjsLT, tjsConditional,
diff --git a/packages/fcl-js/src/jstree.pp b/packages/fcl-js/src/jstree.pp
index 74b58c8e19..c67ee4ec03 100644
--- a/packages/fcl-js/src/jstree.pp
+++ b/packages/fcl-js/src/jstree.pp
@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript syntax tree definitions
+            
+    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 jstree;
 
 {$mode objfpc}{$H+}
@@ -73,76 +87,81 @@ Type
   TJSObject = Class(TObject);
 
 
-    { TJSLabelSet }
+  { TJSLabelSet }
 
-    TJSLabelSet = Class(TJSObject)
-    private
-      FCOnt: Boolean;
-      FNext: TJSLabelSet;
-      FTarget: Cardinal;
-    Public
-      Property Target : Cardinal Read FTarget Write FTarget;
-      Property Next : TJSLabelSet Read FNext Write FNext; // Linked list
-      Property Continuable : Boolean Read FCOnt Write FCont;
-    end;
+  TJSLabelSet = Class(TJSObject)
+  private
+    FCont: Boolean;
+    FNext: TJSLabelSet;
+    FTarget: Cardinal;
+  Public
+    Property Target : Cardinal Read FTarget Write FTarget;
+    Property Next : TJSLabelSet Read FNext Write FNext; // Linked list
+    Property Continuable : Boolean Read FCont Write FCont;
+  end;
 
-    { TJSLabel }
-
-    TJSLabel = Class(TJSObject)
-    private
-      FLabelSet: TJSLabelSet;
-      FLocationLine: Integer;
-      FLocationPos: Integer;
-      FLocationSource: String;
-      FName: String;
-      FNext: TJSLabel;
-    Public
-      Property Name : String Read FName Write FName;
-      Property LabelSet : TJSLabelSet Read FLabelSet Write FLabelSet;
-      Property LocationSource : String Read FLocationSource Write FLocationSource;
-      Property LocationLine : Integer Read FLocationLine Write FLocationLine;
-      Property LocationPos : Integer Read FLocationPos Write FLocationPos;
-      Property Next : TJSLabel Read FNext Write FNext;
-    end;
+  { TJSLabel }
+
+  TJSLabel = Class(TJSObject)
+  private
+    FLabelSet: TJSLabelSet;
+    FLocationLine: Integer;
+    FLocationPos: Integer;
+    FLocationSource: String;
+    FName: String;
+    FNext: TJSLabel;
+  Public
+    Property Name : String Read FName Write FName;
+    Property LabelSet : TJSLabelSet Read FLabelSet Write FLabelSet;
+    Property LocationSource : String Read FLocationSource Write FLocationSource;
+    Property LocationLine : Integer Read FLocationLine Write FLocationLine;
+    Property LocationPos : Integer Read FLocationPos Write FLocationPos;
+    Property Next : TJSLabel Read FNext Write FNext;
+  end;
+
+  TJSString = jsbase.TJSString; // beware of jstoken.tjsString
 
-  { TJSFuncDef }
+  { TJSFuncDef - part of TJSFunctionDeclarationStatement, e.g. 'function Name(Params)Body' }
 
   TJSFuncDef = Class(TJSObject)
   private
     FBody: TJSFunctionBody;
     FIsEmpty: Boolean;
-    FName: String;
+    FName: TJSString;
     FParams: TStrings;
     procedure SetParams(const AValue: TStrings);
   Public
     Constructor Create;
     Destructor Destroy; override;
     Property Params : TStrings Read FParams Write SetParams;
-    Property Body : TJSFunctionBody Read FBody Write FBody;
-    Property Name : String Read FName Write FName;
+    Property Body : TJSFunctionBody Read FBody Write FBody; // can be nil
+    Property Name : TJSString Read FName Write FName;
     Property IsEmpty : Boolean Read FIsEmpty Write FIsEmpty;
   end;
 
-  TJSString = WideString;
+  { TJSElement }
 
-  TJSElement = Class (TJSObject)
+  TJSElement = Class(TJSObject)
   private
     FFlags: TJSElementFlags;
     FLine: Integer;
-    FRow: Integer;
+    FColumn: Integer;
     FSource: String;
   Public
-    Constructor Create(ALine,ARow : Integer; Const ASource : String = ''); virtual;
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); virtual;
     Property Source : String Read FSource Write FSource;
-    Property Row : Integer Read FRow Write FRow;
     Property Line : Integer Read FLine Write FLine;
+    Property Column : Integer Read FColumn Write FColumn;
     Property Flags : TJSElementFlags Read FFlags Write FFlags;
   end;
   TJSElementClass = Class of TJSElement;
 
-  { TJSEmptyBlockStatement }
+  { TJSEmptyBlockStatement - empty curly brackets }
 
   TJSEmptyBlockStatement = Class(TJSElement);
+
+  { TJSEmptyStatement - a dummy placeholder, needs sometimes a single semicolon }
+
   TJSEmptyStatement = Class(TJSElement);
 
   { TJSLiteral }
@@ -151,20 +170,11 @@ Type
   private
     FValue: TJSValue;
   Public
-    Constructor Create(ALine,ARow : Integer; Const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Value : TJSValue Read FValue Write FValue;
   end;
 
-(*  { TJSStringLiteral }
-
-  TJSStringLiteral = Class(TJSElement)
-  private
-    FValue: TJSString;
-  Public
-    Property Value : TJSString Read FValue Write FValue;
-  end;
-*)
   { TJSRegularExpressionLiteral }
 
   TJSRegularExpressionLiteral = Class(TJSElement)
@@ -175,25 +185,27 @@ Type
     function GetA(AIndex : integer): TJSValue;
     procedure SetA(AIndex : integer; const AValue: TJSValue);
   Public
-    Constructor Create(ALine,ARow : Integer; Const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; Const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Pattern : TJSValue Read FPattern Write FPattern;
     Property PatternFlags : TJSValue Read FPatternFlags Write FPatternFlags;
     Property Argv[AIndex : integer] : TJSValue Read GetA Write SetA;
   end;
 
-  { TJSPrimaryExpressionIdent }
   TJSPrimaryExpression = Class(TJSElement);
 
+  TJSPrimaryExpressionThis = Class(TJSPrimaryExpression); // 'this'
+
+  { TJSPrimaryExpressionIdent }
+
   TJSPrimaryExpressionIdent = Class(TJSPrimaryExpression)
   private
     FName: TJSString;
   Public
     Property Name : TJSString Read FName Write FName;
   end;
-  TJSPrimaryExpressionThis = Class(TJSPrimaryExpression);
 
-  { TJSArrayLiteralElement }
+  { TJSArrayLiteralElement - an item of a TJSArrayLiteralElements }
 
   TJSArrayLiteralElement = Class(TCollectionItem)
   private
@@ -201,11 +213,11 @@ Type
     FFindex: Integer;
   Public
     Destructor Destroy; override;
-    Property Expr : TJSelement Read FExpr Write FExpr;
+    Property Expr : TJSElement Read FExpr Write FExpr;
     Property ElementIndex : Integer Read FFindex Write FFIndex;
   end;
 
-  { TJSArrayLiteralElements }
+  { TJSArrayLiteralElements - Elements property of TJSArrayLiteral }
 
   TJSArrayLiteralElements = Class(TCollection)
   private
@@ -221,12 +233,13 @@ Type
   private
     FElements: TJSArrayLiteralElements;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
+    procedure AddElement(El: TJSElement);
     Destructor Destroy; override;
     Property Elements : TJSArrayLiteralElements Read FElements;
   end;
 
-  { TJSObjectLiteralElement }
+  { TJSObjectLiteralElement - an item of TJSObjectLiteralElements }
 
   TJSObjectLiteralElement = Class(TCollectionItem)
   private
@@ -238,7 +251,7 @@ Type
     Property Name : TJSString Read FName Write FName;
   end;
 
-  { TJSObjectLiteralElements }
+  { TJSObjectLiteralElements - Elements property of TJSObjectLiteral }
 
   TJSObjectLiteralElements = Class(TCollection)
   private
@@ -254,7 +267,7 @@ Type
   private
     FElements: TJSObjectLiteralElements;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Elements : TJSObjectLiteralElements Read FElements;
   end;
@@ -263,27 +276,28 @@ Type
 
   TJSArguments = Class(TJSArrayLiteral);
 
-  { TJSMemberExpression }
+  { TJSMemberExpression - base class }
 
   TJSMemberExpression = Class(TJSElement)
   private
     FMexpr: TJSElement;
   Public
     Destructor Destroy; override;
-    Property Mexpr : TJSElement Read FMexpr Write FMexpr;
+    Property MExpr : TJSElement Read FMexpr Write FMexpr;
   end;
 
-  { TJSNewMemberExpression }
+  { TJSNewMemberExpression - e.g. 'new MExpr(Args)' }
 
   TJSNewMemberExpression = Class(TJSMemberExpression)
   private
     FArgs: TJSArguments;
   Public
     Destructor Destroy; override;
+    procedure AddArg(El: TJSElement);
     Property Args : TJSArguments Read FArgs Write FArgs;
   end;
 
-  { TJSDotMemberExpression }
+  { TJSDotMemberExpression - e.g. 'MExpr.Name' }
 
   TJSDotMemberExpression = Class(TJSMemberExpression)
   private
@@ -292,7 +306,7 @@ Type
     Property Name : TJSString Read FName Write FName;
   end;
 
-  { TJSBracketMemberExpression }
+  { TJSBracketMemberExpression - e.g. 'MExpr[Name]' }
 
   TJSBracketMemberExpression = Class(TJSMemberExpression)
   private
@@ -302,7 +316,7 @@ Type
     Property Name : TJSElement Read FName Write FName;
   end;
 
-  { TJSCallExpression }
+  { TJSCallExpression - e.g. 'Expr(Args)'}
 
   TJSCallExpression = Class(TJSElement)
   private
@@ -310,11 +324,12 @@ Type
     FExpr: TJSElement;
   Public
     Destructor Destroy; override;
+    procedure AddArg(El: TJSElement);
     Property Expr : TJSElement Read FExpr Write FExpr;
     Property Args : TJSArguments Read FArgs Write FArgs;
   end;
 
-  { TJSUnary }
+  { TJSUnary - e.g. 'PrefixOperator A PostFixOperator', '--i' }
 
   TJSUnary = Class(TJSElement)
   private
@@ -329,87 +344,102 @@ Type
   end;
   TJSUnaryClass = class of TJSUnary;
 
-  { TJSVariableStatement }
+  { TJSVariableStatement - e.g. 'var A' }
+
   TJSVariableStatement = Class(TJSUnary);
+
+  { TJSExpressionStatement - A; }
+
   TJSExpressionStatement = Class(TJSUnary);
 
-  { TJSThrowStatement }
+  { TJSThrowStatement - e.g. 'throw A' }
 
   TJSThrowStatement = Class(TJSUnary)
+  Public
     Class function PrefixOperatorToken : tjsToken; Override;
   end;
 
   TJSUnaryExpression = Class(TJSUnary);
 
-  { TJSUnaryDeleteExpression }
+  { TJSUnaryDeleteExpression - e.g. 'delete A' }
 
   TJSUnaryDeleteExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryVoidExpression }
+  { TJSUnaryVoidExpression - e.g. 'void A' }
 
   TJSUnaryVoidExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryTypeOfExpression }
+  { TJSUnaryTypeOfExpression - e.g. 'typeof A' }
 
   TJSUnaryTypeOfExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryPrePlusPlusExpression }
+  { TJSUnaryPrePlusPlusExpression - e.g. '++A' }
 
   TJSUnaryPrePlusPlusExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryPreMinusMinusExpression }
+  { TJSUnaryPreMinusMinusExpression - e.g. '--A' }
 
   TJSUnaryPreMinusMinusExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryPlusExpression }
+  { TJSUnaryPlusExpression - e.g. '+A' }
 
   TJSUnaryPlusExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryMinusExpression }
+  { TJSUnaryMinusExpression - e.g. '-A' }
 
   TJSUnaryMinusExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryInvExpression }
+  { TJSUnaryInvExpression - e.g. '~A' }
 
   TJSUnaryInvExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryNotExpression }
+  { TJSUnaryNotExpression - e.g. '!A' }
 
   TJSUnaryNotExpression = Class(TJSUnaryExpression)
+  Public
     Class function PrefixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryPostPlusPlusExpression }
+  { TJSUnaryPostPlusPlusExpression - e.g. 'A++' }
 
   TJSUnaryPostPlusPlusExpression = Class(TJSUnaryExpression)
+  Public
     Class function PostFixOperatorToken : tjsToken; override;
   end;
 
-  { TJSUnaryPostMinusMinusExpression }
+  { TJSUnaryPostMinusMinusExpression - e.g. 'A--' }
 
   TJSUnaryPostMinusMinusExpression = Class(TJSUnaryExpression)
+  Public
     Class function PostFixOperatorToken : tjsToken; override;
   end;
 
 
-
-  { TJSBinary }
+  { TJSBinary - base class }
 
   TJSBinary = Class(TJSElement)
   private
@@ -422,45 +452,52 @@ Type
   end;
   TJSBinaryClass = Class of TJSBinary;
 
-  { TJSStatementList }
+  { TJSStatementList - a list of statements enclosed in curly brackets }
 
   TJSStatementList = Class(TJSBinary); // A->first statement, B->next in list, chained.
-  TJSVariableDeclarationList = Class(TJSBinary);
+
+  { TJSVariableDeclarationList }
+
+  TJSVariableDeclarationList = Class(TJSBinary); // A->first variable, B->next in list, chained.
+
+  { TJSWithStatement - with(A)do B; }
+
   TJSWithStatement = Class(TJSBinary); // A-> with expression, B->statement(s)
 
-  { TJSBinaryExpression }
+  { TJSBinaryExpression - e.g. A operator B }
 
   TJSBinaryExpression = Class(TJSBinary)
+  Public
     Class function OperatorToken : tjsToken; virtual;
     Class function OperatorString : string;
     Class Function AllowCompact : Boolean; virtual;
   end;
 
-  { TJSLogicalOrExpression }
+  { TJSLogicalOrExpression - e.g. A || B }
 
   TJSLogicalOrExpression = Class (TJSBinaryExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSLogicalAndExpression }
+  { TJSLogicalAndExpression - e.g. A && B }
 
   TJSLogicalAndExpression = Class (TJSBinaryExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSBitwiseAndExpression }
+  { TJSBitwiseAndExpression - e.g. A & B }
 
   TJSBitwiseAndExpression = Class (TJSBinaryExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSBitwiseOrExpression }
+  { TJSBitwiseOrExpression - e.g. A | B }
 
   TJSBitwiseOrExpression = Class (TJSBinaryExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSBitwiseXOrExpression }
+  { TJSBitwiseXOrExpression - e.g. A ^ B }
 
   TJSBitwiseXOrExpression = Class (TJSBinaryExpression)
     Class function OperatorToken : tjsToken; override;
@@ -468,25 +505,25 @@ Type
 
   TJSEqualityExpression = Class (TJSBinaryExpression);
 
-  { TJSEqualityExpressionEQ }
+  { TJSEqualityExpressionEQ - e.g. A == B }
 
   TJSEqualityExpressionEQ = Class(TJSEqualityExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSEqualityExpressionNE }
+  { TJSEqualityExpressionNE - e.g. A != B }
 
   TJSEqualityExpressionNE = Class(TJSEqualityExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSEqualityExpressionSEQ }
+  { TJSEqualityExpressionSEQ strict equal - e.g. A === B }
 
   TJSEqualityExpressionSEQ = Class(TJSEqualityExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSEqualityExpressionSNE }
+  { TJSEqualityExpressionSNE not strict equal - e.g. A !== B }
 
   TJSEqualityExpressionSNE = Class(TJSEqualityExpression)
     Class function OperatorToken : tjsToken; override;
@@ -494,38 +531,38 @@ Type
 
   TJSRelationalExpression = Class(TJSBinaryExpression);
 
-  { TJSRelationalExpressionLT }
+  { TJSRelationalExpressionLT lower than - e.g. A < B }
 
   TJSRelationalExpressionLT = Class(TJSRelationalExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSRelationalExpressionGT }
+  { TJSRelationalExpressionGT greater than - e.g. A > B }
 
   TJSRelationalExpressionGT = Class(TJSRelationalExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSRelationalExpressionLE }
+  { TJSRelationalExpressionLE lower equal - e.g. A <= B }
 
   TJSRelationalExpressionLE = Class(TJSRelationalExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSRelationalExpressionGE }
+  { TJSRelationalExpressionGE greater equal - e.g. A >= B }
 
   TJSRelationalExpressionGE = Class(TJSRelationalExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSRelationalExpressionIn }
+  { TJSRelationalExpressionIn - e.g. A in B }
 
   TJSRelationalExpressionIn = Class(TJSRelationalExpression)
     Class function OperatorToken : tjsToken; override;
     Class Function AllowCompact : Boolean; override;
   end;
 
-  { TJSRelationalExpressionInstanceOf }
+  { TJSRelationalExpressionInstanceOf - e.g. A instanceof B }
 
   TJSRelationalExpressionInstanceOf = Class(TJSRelationalExpression)
     Class function OperatorToken : tjsToken; override;
@@ -534,19 +571,19 @@ Type
 
   TJSShiftExpression = Class(TJSBinaryExpression);
 
-  { TJSLShiftExpression }
+  { TJSLShiftExpression - e.g. A << B }
 
   TJSLShiftExpression = Class(TJSShiftExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSRShiftExpression }
+  { TJSRShiftExpression right shift keep sign - e.g. A >> B }
 
   TJSRShiftExpression = Class(TJSShiftExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSURShiftExpression }
+  { TJSURShiftExpression right shift unsigned, insert zeroes - e.g. A >>> B }
 
   TJSURShiftExpression = Class(TJSShiftExpression)
     Class function OperatorToken : tjsToken; override;
@@ -554,13 +591,13 @@ Type
 
   TJSAdditiveExpression = Class(TJSBinaryExpression);
 
-  { TJSAdditiveExpressionPlus }
+  { TJSAdditiveExpressionPlus - e.g. A + B }
 
   TJSAdditiveExpressionPlus = Class(TJSAdditiveExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSAdditiveExpressionMinus }
+  { TJSAdditiveExpressionMinus - e.g. A - B }
 
   TJSAdditiveExpressionMinus = Class(TJSAdditiveExpression)
     Class function OperatorToken : tjsToken; override;
@@ -568,31 +605,31 @@ Type
 
   TJSMultiplicativeExpression = Class(TJSBinaryExpression);
 
-  { TJSMultiplicativeExpressionMul }
+  { TJSMultiplicativeExpressionMul - e.g. A * B }
 
   TJSMultiplicativeExpressionMul = Class(TJSMultiplicativeExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSMultiplicativeExpressionDiv }
+  { TJSMultiplicativeExpressionDiv - e.g. A / B }
 
   TJSMultiplicativeExpressionDiv = Class(TJSMultiplicativeExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSMultiplicativeExpressionMod }
+  { TJSMultiplicativeExpressionMod - e.g. A % B }
 
   TJSMultiplicativeExpressionMod = Class(TJSMultiplicativeExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSCommaExpression }
+  { TJSCommaExpression - e.g. A , B }
 
   TJSCommaExpression = Class(TJSBinaryExpression)
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSConditionalExpression }
+  { TJSConditionalExpression - e.g. A ? B :C }
 
   TJSConditionalExpression = Class(TJSElement)
   private
@@ -606,7 +643,7 @@ Type
     Property C : TJSElement Read FC Write FC;
   end;
 
-  { TJSAssignStatement }
+  { TJSAssignStatement - e.g. LHS operator Expr }
 
   TJSAssignStatement = Class(TJSElement)
   private
@@ -622,79 +659,91 @@ Type
 
   TJSAssignStatementClass = Class of TJSAssignStatement;
 
-  { TJSSimpleAssignStatement }
+  { TJSSimpleAssignStatement - e.g. LHS=Expr }
 
   TJSSimpleAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSMulEqAssignStatement }
+  { TJSMulEqAssignStatement - e.g. LHS*=Expr }
 
   TJSMulEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSDivEqAssignStatement }
+  { TJSDivEqAssignStatement - e.g. LHS/=Expr }
 
   TJSDivEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSModEqAssignStatement }
+  { TJSModEqAssignStatement - e.g. LHS%=Expr }
 
   TJSModEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSAddEqAssignStatement }
+  { TJSAddEqAssignStatement - e.g. LHS+=Expr }
 
   TJSAddEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSSubEqAssignStatement }
+  { TJSSubEqAssignStatement - e.g. LHS-=Expr }
 
   TJSSubEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSLShiftEqAssignStatement }
+  { TJSLShiftEqAssignStatement - e.g. LHS<<=Expr }
 
   TJSLShiftEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSRShiftEqAssignStatement }
+  { TJSRShiftEqAssignStatement - e.g. LHS>>=Expr keep sign }
 
   TJSRShiftEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSURShiftEqAssignStatement }
+  { TJSURShiftEqAssignStatement - e.g. LHS>>>=Expr unsigned, insert zeroes }
 
   TJSURShiftEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSANDEqAssignStatement }
+  { TJSANDEqAssignStatement - e.g. LHS&=Expr }
 
   TJSANDEqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSOREqAssignStatement }
+  { TJSOREqAssignStatement - e.g. LHS|=Expr }
 
   TJSOREqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSXOREqAssignStatement }
+  { TJSXOREqAssignStatement - e.g. LHS^=Expr }
 
   TJSXOREqAssignStatement = Class(TJSAssignStatement)
+  Public
     Class function OperatorToken : tjsToken; override;
   end;
 
-  { TJSVarDeclaration }
+  { TJSVarDeclaration - e.g. Name=Init }
 
   TJSVarDeclaration = Class(TJSElement)
   private
@@ -706,7 +755,7 @@ Type
     Property Init : TJSElement Read FInit Write FInit;
   end;
 
-  { TJSIfStatement }
+  { TJSIfStatement - e.g. if (Cond) btrue else bfalse }
 
   TJSIfStatement = Class(TJSElement)
   private
@@ -716,13 +765,13 @@ Type
   Public
     Destructor Destroy; override;
     Property Cond : TJSElement Read FCond Write FCond;
-    Property btrue : TJSElement Read FBTrue Write FBTrue;
-    Property bfalse : TJSElement Read FBFalse Write FBFalse;
+    Property BTrue : TJSElement Read FBTrue Write FBTrue;
+    Property BFalse : TJSElement Read FBFalse Write FBFalse;
   end;
 
-  { TJSWhileStatement }
-
-  { TJSTargetStatement }
+  { TJSTargetStatement
+    - base class for statements targetable by continue and break
+    - TargetName can be empty }
 
   TJSTargetStatement = Class(TJSElement)
   private
@@ -733,17 +782,17 @@ Type
     Property TargetName : TJSString Read FTargetName Write FTargetName;
   end;
 
-  { TJSBodyStatement }
+  { TJSBodyStatement - base class }
 
   TJSBodyStatement = Class(TJSTargetStatement)
   private
     FBody: TJSElement;
   Public
     Destructor Destroy; override;
-    Property body : TJSElement Read FBody Write FBody;
+    Property Body : TJSElement Read FBody Write FBody;
   end;
 
-  { TJSCondLoopStatement }
+  { TJSCondLoopStatement - base class for do..while and while..do }
 
   TJSCondLoopStatement = Class(TJSBodyStatement)
   private
@@ -753,10 +802,15 @@ Type
     Property Cond : TJSElement Read FCond Write FCond;
   end;
 
+  { TJSWhileStatement - e.g. 'while(Cond) Body' }
+
   TJSWhileStatement = Class(TJSCondLoopStatement);
+
+  { TJSDoWhileStatement - e.g. 'do Body while(Cond)' }
+
   TJSDoWhileStatement = Class(TJSWhileStatement);
 
-  { TJSForStatement }
+  { TJSForStatement - e.g. 'for(Init;Cond;Incr) Body' }
 
   TJSForStatement = Class(TJSCondLoopStatement)
   private
@@ -768,7 +822,7 @@ Type
     Property Init : TJSElement Read FInit Write FInit;
   end;
 
-  { TJSForInStatement }
+  { TJSForInStatement - e.g. 'for(LHS in List) Body' }
 
   TJSForInStatement = Class(TJSBodyStatement)
   private
@@ -780,11 +834,15 @@ Type
     Property List : TJSElement Read FList Write FList;
   end;
 
+  { TJSContinueStatement - e.g. 'continue'}
+
   TJSContinueStatement = Class(TJSTargetStatement);
 
+  { TJSBreakStatement - e.g. 'break' }
+
   TJSBreakStatement = Class(TJSTargetStatement);
 
-  { TJSReturn }
+  { TJSReturn - e.g. 'return Expr'}
 
   TJSReturnStatement = Class(TJSElement)
   private
@@ -794,7 +852,7 @@ Type
     Property Expr : TJSElement Read FExpr Write FExpr;
   end;
 
-  { TJSCaseElement }
+  { TJSCaseElement - element of TJSCaseElements, e.g. 'case Expr: Body' }
 
   TJSCaseElement = Class(TCollectionItem)
   private
@@ -806,7 +864,7 @@ Type
     Property Body : TJSElement Read FBody Write FBody;
   end;
 
-  { TJSCaseElements }
+  { TJSCaseElements - Cases property of TJSSwitch }
 
   TJSCaseElements = Class(TCollection)
   private
@@ -816,7 +874,7 @@ Type
     Property Cases[AIndex : Integer] : TJSCaseElement Read GetC ;default;
   end;
 
-  { TJSSwitch }
+  { TJSSwitch - e.g. switch(Cond) Cases }
 
   TJSSwitchStatement = Class(TJSTargetStatement)
   private
@@ -824,14 +882,14 @@ Type
     FCond: TJSelement;
     FDefault: TJSCaseElement;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
     Destructor Destroy; override;
     Property Cond : TJSelement Read FCond Write FCond;
     Property Cases : TJSCaseElements Read FCases;
-    Property TheDefault : TJSCaseelement Read FDefault Write FDefault;
+    Property TheDefault : TJSCaseElement Read FDefault Write FDefault; // one of Cases
   end;
 
-  { TJSLabeledStatement }
+  { TJSLabeledStatement - e.g. 'TheLabel : A' }
 
   TJSLabeledStatement = Class(TJSUnary)
   private
@@ -839,11 +897,11 @@ Type
     FTarget: Integer;
   Public
     Destructor Destroy; override;
-    Property target: Integer Read FTarget Write FTarget;
+    Property Target: Integer Read FTarget Write FTarget;
     Property TheLabel : TJSLabel Read FLabel Write Flabel;
   end;
 
-  { TJSTryStatement }
+  { TJSTryStatement - e.g. 'try Block catch(Ident) BCatch finally BFinally' }
 
   TJSTryStatement = Class(TJSElement)
   private
@@ -864,9 +922,9 @@ Type
   TJSTryFinallyStatement = Class(TJSTryStatement);
 
 
-  { TJSFunction }
+  { TJSFunctionDeclarationStatement - as TJSFuncDef, except as a statement }
 
-  TJSFunctionDeclarationStatement = Class(TJSelement)
+  TJSFunctionDeclarationStatement = Class(TJSElement)
   private
     FFuncDef: TJSFuncDef;
   Public
@@ -874,16 +932,16 @@ Type
     Property AFunction : TJSFuncDef Read FFuncDef Write FFuncDef;
   end;
 
-  { TJSFunctionBody }
+  { TJSFunctionBody - the statement block of a function }
 
   TJSFunctionBody = Class(TJSUnary)
   private
-    FisProgram: Boolean;
+    FIsProgram: Boolean;
   Public
-    Property isProgram : Boolean Read FisProgram Write FIsProgram;
+    Property isProgram : Boolean Read FIsProgram Write FIsProgram;
   end;
 
-  { TJSElementNode }
+  { TJSElementNode - element of TJSElementNodes }
 
   TJSElementNode = Class(TCollectionItem)
   private
@@ -893,7 +951,7 @@ Type
     Property Node : TJSElement Read FNode Write FNode;
   end;
 
-  { TJSElementNodes }
+  { TJSElementNodes - see TJSSourceElements }
 
   TJSElementNodes = Class(TCollection)
   private
@@ -903,21 +961,22 @@ Type
     Property Nodes[AIndex : Integer] : TJSElementNode Read GetN ; default;
   end;
 
-  { TJSSourceElements }
+  { TJSSourceElements - a list of elements, every element ends in semicolon,
+    first Vars, then Functions, finally Statements }
+
   TJSSourceElements = Class(TJSElement)
   private
     FFunctions: TJSElementNodes;
     FStatements: TJSElementNodes;
     FVars: TJSElementNodes;
   Public
-    Constructor Create(ALine,ARow : Integer; const ASource : String = ''); override;
+    Constructor Create(ALine,AColumn : Integer; const ASource : String = ''); override;
     Destructor Destroy; override;
-    Property Statements : TJSElementNodes Read FStatements;
-    Property functions : TJSElementNodes Read FFunctions;
     Property Vars : TJSElementNodes Read FVars;
+    Property Functions : TJSElementNodes Read FFunctions;
+    Property Statements : TJSElementNodes Read FStatements;
   end;
 
-
 implementation
 
 {$IFDEF NOCLASSES}
@@ -1444,10 +1503,10 @@ end;
 
 { TJSElement }
 
-constructor TJSElement.Create(ALine, ARow: Integer; Const ASource: String = '');
+constructor TJSElement.Create(ALine, AColumn: Integer; const ASource: String);
 begin
   FLine:=ALine;
-  FRow:=ARow;
+  FColumn:=AColumn;
   FSource:=ASource;
 end;
 
@@ -1464,10 +1523,10 @@ begin
   FArgv[AIndex]:=Avalue;
 end;
 
-constructor TJSRegularExpressionLiteral.Create(ALine, ARow: Integer;
+constructor TJSRegularExpressionLiteral.Create(ALine, AColumn: Integer;
   const ASource: String);
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FPattern:=TJSValue.Create;
   FPatternFlags:=TJSValue.Create;
 end;
@@ -1493,12 +1552,17 @@ end;
 
 { TJSArrayLiteral }
 
-constructor TJSArrayLiteral.Create(ALine, ARow: Integer; Const ASource: String = '');
+constructor TJSArrayLiteral.Create(ALine, AColumn: Integer; const ASource: String);
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FElements:=TJSArrayLiteralElements.Create(TJSArrayLiteralElement);
 end;
 
+procedure TJSArrayLiteral.AddElement(El: TJSElement);
+begin
+  Elements.AddElement.Expr:=El;
+end;
+
 destructor TJSArrayLiteral.Destroy;
 begin
   FreeAndNil(FElements);
@@ -1521,9 +1585,9 @@ end;
 
 { TJSObjectLiteral }
 
-constructor TJSObjectLiteral.Create(ALine, ARow: Integer; const ASource: String = '');
+constructor TJSObjectLiteral.Create(ALine, AColumn: Integer; const ASource: String = '');
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FElements:=TJSObjectLiteralElements.Create(TJSObjectLiteralElement);
 end;
 
@@ -1557,6 +1621,11 @@ begin
   inherited Destroy;
 end;
 
+procedure TJSNewMemberExpression.AddArg(El: TJSElement);
+begin
+  Args.Elements.AddElement.Expr:=El;
+end;
+
 { TJSMemberExpression }
 
 destructor TJSMemberExpression.Destroy;
@@ -1574,6 +1643,11 @@ begin
   inherited Destroy;
 end;
 
+procedure TJSCallExpression.AddArg(El: TJSElement);
+begin
+  Args.Elements.AddElement.Expr:=El;
+end;
+
 { TJSUnary }
 
 Class function TJSUnary.PrefixOperatorToken: tjsToken;
@@ -1740,9 +1814,9 @@ end;
 
 { TJSSwitch }
 
-constructor TJSSwitchStatement.Create(ALine, ARow: Integer; const ASource: String);
+constructor TJSSwitchStatement.Create(ALine, AColumn: Integer; const ASource: String);
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FCases:=TJSCaseElements.Create(TJSCaseElement);
 end;
 
@@ -1778,10 +1852,10 @@ end;
 
 { TJSSourceElements }
 
-constructor TJSSourceElements.Create(ALine, ARow: Integer; const ASource: String
+constructor TJSSourceElements.Create(ALine, AColumn: Integer; const ASource: String
   );
 begin
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
   FStatements:=TJSElementNodes.Create(TJSElementNode);
   FFunctions:=TJSElementNodes.Create(TJSElementNode);
   FVars:=TJSElementNodes.Create(TJSElementNode);
@@ -1809,7 +1883,6 @@ begin
   Result:=TJSElementNode(Items[Aindex])
 end;
 
-
 function TJSElementNodes.AddNode: TJSElementNode;
 begin
   Result:=TJSElementNode(Add);
@@ -1861,10 +1934,10 @@ end;
 
 { TJSLiteral }
 
-constructor TJSLiteral.Create(ALine, ARow: Integer; const ASource: String);
+constructor TJSLiteral.Create(ALine, AColumn: Integer; const ASource: String);
 begin
   FValue:=TJSValue.Create;
-  inherited Create(ALine, ARow, ASource);
+  inherited Create(ALine, AColumn, ASource);
 end;
 
 destructor TJSLiteral.Destroy;
diff --git a/packages/fcl-js/src/jswriter.pp b/packages/fcl-js/src/jswriter.pp
index 0386fe0d80..4ea5d9a8c9 100644
--- a/packages/fcl-js/src/jswriter.pp
+++ b/packages/fcl-js/src/jswriter.pp
@@ -1,3 +1,17 @@
+{ ********************************************************************* 
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 Michael Van Canneyt.
+       
+    Javascript minifier
+            
+    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 jswriter;
 
 {$mode objfpc}{$H+}
@@ -6,18 +20,28 @@ unit jswriter;
 interface
 
 uses
-  {Classes, } SysUtils, jstoken, jsbase, jstree;
+  SysUtils, jstoken, jsbase, jstree;
 
 Type
+  TTextWriter = class;
+
+  TTextWriterWriting = procedure(Sender: TTextWriter) of object;
 
   { TTextWriter }
 
   TTextWriter = Class(TObject)
+  private
+    FCurElement: TJSElement;
+    FCurLine: integer;
+    FCurColumn: integer;
+    FOnWriting: TTextWriterWriting;
   protected
     Function DoWrite(Const S : AnsiString) : Integer; virtual; abstract;
     Function DoWrite(Const S : UnicodeString) : Integer; virtual; abstract;
+    Procedure Writing; // called before adding new characters
   Public
-    // All functions return the numberof bytes copied to output stream.
+    // All functions return the number of bytes copied to output stream.
+    constructor Create;
     Function Write(Const S : UnicodeString) : Integer;
     Function Write(Const S : AnsiString) : Integer;
     Function WriteLn(Const S : AnsiString) : Integer;
@@ -25,6 +49,10 @@ Type
     Function WriteLn(Const Fmt : AnsiString; Args : Array of const) : Integer;
     Function Write(Const Args : Array of const) : Integer;
     Function WriteLn(Const Args : Array of const) : Integer;
+    Property CurLine: integer read FCurLine write FCurLine;
+    Property CurColumn: integer read FCurColumn write FCurColumn;// char index, not codepoint
+    Property CurElement: TJSElement read FCurElement write FCurElement;
+    Property OnWriting: TTextWriterWriting read FOnWriting write FOnWriting;
   end;
 
   { TFileWriter }
@@ -44,6 +72,7 @@ Type
   end;
 
   { TBufferWriter }
+
   TBytes = Array of byte;
   TBufferWriter = Class(TTextWriter)
   private
@@ -69,8 +98,14 @@ Type
     Property AsUnicodeString : UnicodeString Read GetUnicodeString;
   end;
 
+  TJSEscapeQuote = (
+    jseqSingle,
+    jseqDouble,
+    jseqBoth
+    );
 
   { TJSWriter }
+
   TWriteOption = (woCompact,
                   woUseUTF8,
                   woTabIndent,
@@ -84,13 +119,14 @@ Type
   TJSWriter = Class
   private
     FCurIndent : Integer;
-    FLinePos : Integer;
-    FIndentSize: Byte;
+    FFreeWriter : Boolean;
     FIndentChar : Char;
+    FIndentSize: Byte;
+    FLinePos : Integer;
     FOptions: TWriteOptions;
+    FSkipCurlyBrackets : Boolean;
+    FSkipRoundBrackets : Boolean;
     FWriter: TTextWriter;
-    FFreeWriter : Boolean;
-    FSkipBrackets : Boolean;
     function GetUseUTF8: Boolean;
     procedure SetOptions(AValue: TWriteOptions);
   Protected
@@ -105,13 +141,13 @@ Type
     // one per type of statement
     Procedure WriteValue(V : TJSValue);  virtual;
     Procedure WriteRegularExpressionLiteral(El: TJSRegularExpressionLiteral);
-    Procedure WriteVariableStatement(el: TJSVariableStatement);
+    Procedure WriteVariableStatement(El: TJSVariableStatement);
     Procedure WriteEmptyBlockStatement(El: TJSEmptyBlockStatement); virtual;
     Procedure WriteEmptyStatement(El: TJSEmptyStatement);virtual;
     Procedure WriteLiteral(El: TJSLiteral);virtual;
     Procedure WriteArrayLiteral(El: TJSArrayLiteral);virtual;
     Procedure WriteObjectLiteral(El: TJSObjectLiteral);virtual;
-    Procedure WriteMemberExpression(el: TJSMemberExpression);virtual;
+    Procedure WriteMemberExpression(El: TJSMemberExpression);virtual;
     Procedure WriteCallExpression(El: TJSCallExpression);virtual;
     Procedure WriteSwitchStatement(El: TJSSwitchStatement);virtual;
     Procedure WriteUnary(El: TJSUnary);virtual;
@@ -122,21 +158,23 @@ Type
     Procedure WriteIfStatement(El: TJSIfStatement);virtual;
     Procedure WriteSourceElements(El: TJSSourceElements);virtual;
     Procedure WriteStatementList(El: TJSStatementList);virtual;
-    Procedure WriteTryStatement(el: TJSTryStatement);virtual;
+    Procedure WriteTryStatement(El: TJSTryStatement);virtual;
     Procedure WriteVarDeclaration(El: TJSVarDeclaration);virtual;
     Procedure WriteWithStatement(El: TJSWithStatement);virtual;
     Procedure WriteVarDeclarationList(El: TJSVariableDeclarationList);virtual;
     Procedure WriteConditionalExpression(El: TJSConditionalExpression);virtual;
-    Procedure WriteFunctionBody(el: TJSFunctionBody);virtual;
+    Procedure WriteFunctionBody(El: TJSFunctionBody);virtual;
     Procedure WriteFunctionDeclarationStatement(El: TJSFunctionDeclarationStatement);virtual;
     Procedure WriteLabeledStatement(El: TJSLabeledStatement);virtual;
-    Procedure WriteReturnStatement(EL: TJSReturnStatement);virtual;
+    Procedure WriteReturnStatement(El: TJSReturnStatement);virtual;
     Procedure WriteTargetStatement(El: TJSTargetStatement);virtual;
     Procedure WriteFuncDef(FD: TJSFuncDef);virtual;
     Procedure WritePrimaryExpression(El: TJSPrimaryExpression);virtual;
     Procedure WriteBinary(El: TJSBinary);virtual;
+    Function IsEmptyStatement(El: TJSElement): boolean;
+    Function HasLineEnding(El: TJSElement): boolean;
   Public
-    Class Function EscapeString(const S: TJSString): TJSString;
+    Function EscapeString(const S: TJSString; Quote: TJSEscapeQuote = jseqDouble): TJSString;
     Constructor Create(AWriter : TTextWriter);
     Constructor Create(Const AFileName : String);
     Destructor Destroy; override;
@@ -144,11 +182,13 @@ Type
     Procedure Indent;
     Procedure Undent;
     Property Writer : TTextWriter Read FWriter;
-    Property options : TWriteOptions Read FOptions Write SetOptions;
+    Property Options : TWriteOptions Read FOptions Write SetOptions;
     Property IndentSize : Byte Read FIndentSize Write FIndentSize;
     Property UseUTF8 : Boolean Read GetUseUTF8;
   end;
-  EJSWriter = CLass(Exception);
+  EJSWriter = Class(Exception);
+
+Function UTF16ToUTF8(const S: UnicodeString): string;
 
 implementation
 
@@ -156,6 +196,23 @@ Resourcestring
   SErrUnknownJSClass = 'Unknown javascript element class : %s';
   SErrNilNode = 'Nil node in Javascript';
 
+function HexDump(p: PChar; Count: integer): string;
+var
+  i: Integer;
+begin
+  Result:='';
+  for i:=0 to Count-1 do
+    Result:=Result+HexStr(ord(p[i]),2);
+end;
+
+function UTF16ToUTF8(const S: UnicodeString): string;
+begin
+  Result:=UTF8Encode(S);
+  // prevent UTF8 codepage appear in the strings - we don't need codepage
+  // conversion magic
+  SetCodePage(RawByteString(Result), CP_ACP, False);
+end;
+
 { TBufferWriter }
 
 function TBufferWriter.GetBufferLength: Integer;
@@ -207,10 +264,11 @@ Var
 
 begin
   Result:=Length(S)*SizeOf(Char);
+  if Result=0 then exit;
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
     begin
-    DesLen:=Round(FCapacity*1.25);
+    DesLen:=(FCapacity*5) div 4;
     if DesLen>MinLen then
       MinLen:=DesLen;
     Capacity:=MinLen;
@@ -226,10 +284,11 @@ Var
 
 begin
   Result:=Length(S)*SizeOf(UnicodeChar);
+  if Result=0 then exit;
   MinLen:=Result+FBufPos;
   If (MinLen>Capacity) then
     begin
-    DesLen:=Round(FCapacity*1.25);
+    DesLen:=(FCapacity*5) div 4;
     if DesLen>MinLen then
       MinLen:=DesLen;
     Capacity:=MinLen;
@@ -240,6 +299,7 @@ end;
 
 Constructor TBufferWriter.Create(Const ACapacity: Cardinal);
 begin
+  inherited Create;
   Capacity:=ACapacity;
 end;
 
@@ -275,29 +335,29 @@ begin
   Result:=(woUseUTF8 in Options)
 end;
 
-Procedure TJSWriter.Error(Const Msg: String);
+procedure TJSWriter.Error(const Msg: String);
 begin
   Raise EJSWriter.Create(Msg);
 end;
 
-Procedure TJSWriter.Error(Const Fmt: String; Args: Array of const);
+procedure TJSWriter.Error(const Fmt: String; Args: array of const);
 begin
   Raise EJSWriter.CreateFmt(Fmt,Args);
 end;
 
-Procedure TJSWriter.WriteIndent;
+procedure TJSWriter.WriteIndent;
 
 begin
   If (FLinePos=0) then
     FLinePos:=Writer.Write(StringOfChar(FIndentChar,FCurIndent));
 end;
 
-Procedure TJSWriter.Indent;
+procedure TJSWriter.Indent;
 begin
   Inc(FCurIndent,FIndentSIze);
 end;
 
-Procedure TJSWriter.Undent;
+procedure TJSWriter.Undent;
 begin
   if (FCurIndent>=FIndentSIze) then
     Dec(FCurIndent,FIndentSIze)
@@ -305,23 +365,23 @@ begin
     FCurIndent:=0;
 end;
 
-Procedure TJSWriter.Write(Const U: UnicodeString);
+procedure TJSWriter.Write(const U: UnicodeString);
 
 Var
-  S : UTF8String;
+  S : String;
 
 begin
   WriteIndent;
   if UseUTF8 then
     begin
-    S:=UTF8Encode(U);
+    S:=UTF16ToUTF8(U);
     FLinePos:=FLinePos+Writer.Write(S);
     end
   else
     FLinePos:=FLinePos+Writer.Write(U);
 end;
 
-Procedure TJSWriter.Write(Const S: AnsiString);
+procedure TJSWriter.Write(const S: AnsiString);
 begin
   if Not (woUseUTF8 in Options) then
     Write(UnicodeString(S))
@@ -332,7 +392,7 @@ begin
     end;
 end;
 
-Procedure TJSWriter.WriteLn(Const S: AnsiString);
+procedure TJSWriter.WriteLn(const S: AnsiString);
 begin
   if Not (woUseUTF8 in Options) then
     Writeln(UnicodeString(S))
@@ -344,14 +404,14 @@ begin
     end;
 end;
 
-Procedure TJSWriter.WriteLn(Const U: UnicodeString);
+procedure TJSWriter.WriteLn(const U: UnicodeString);
 Var
-  S : UTF8String;
+  S : String;
 
 begin
   if UseUTF8 then
     begin
-    S:=UTF8Encode(U);
+    S:=UTF16ToUTF8(U);
     Writeln(S);
     end
   else
@@ -362,77 +422,171 @@ begin
     end;
 end;
 
-Class Function TJSWriter.EscapeString(const S : TJSString) : TJSString;
+function TJSWriter.EscapeString(const S: TJSString; Quote: TJSEscapeQuote
+  ): TJSString;
 
 Var
   I,J,L : Integer;
-  P : PWideChar;
+  P : TJSPChar;
+  R: TJSString;
 
 begin
   I:=1;
   J:=1;
-  Result:='';
+  R:='';
   L:=Length(S);
-  P:=PWideChar(S);
+  P:=TJSPChar(S);
   While I<=L do
     begin
-    if (AnsiChar(P^) in ['"','/','\',#8,#9,#10,#12,#13]) then
+    if (P^ in [#0..#31,'"','''','/','\']) then
       begin
-      Result:=Result+Copy(S,J,I-J);
+      R:=R+Copy(S,J,I-J);
       Case P^ of
-        '\' : Result:=Result+'\\';
-        '/' : Result:=Result+'\/';
-        '"' : Result:=Result+'\"';
-        #8  : Result:=Result+'\b';
-        #9  : Result:=Result+'\t';
-        #10 : Result:=Result+'\n';
-        #12 : Result:=Result+'\f';
-        #13 : Result:=Result+'\r';
+        '\' : R:=R+'\\';
+        '/' : R:=R+'\/';
+        '"' : if Quote=jseqSingle then R:=R+'"' else R:=R+'\"';
+        '''': if Quote=jseqDouble then R:=R+'''' else R:=R+'\''';
+        #0..#7,#11,#14..#31: R:=R+'\x'+TJSString(hexStr(ord(P^),2));
+        #8  : R:=R+'\b';
+        #9  : R:=R+'\t';
+        #10 : R:=R+'\n';
+        #12 : R:=R+'\f';
+        #13 : R:=R+'\r';
       end;
       J:=I+1;
       end;
     Inc(I);
     Inc(P);
     end;
-  Result:=Result+Copy(S,J,I-1);
+  R:=R+Copy(S,J,I-1);
+  Result:=R;
 end;
 
-Procedure TJSWriter.WriteValue(V: TJSValue);
+procedure TJSWriter.WriteValue(V: TJSValue);
+const
+  TabWidth = 4;
+
+  function GetLineIndent(var p: PWideChar): integer;
+  var
+    h: PWideChar;
+  begin
+    h:=p;
+    Result:=0;
+    repeat
+      case h^ of
+      #0: break;
+      #9: Result:=Result+(TabWidth-Result mod TabWidth);
+      ' ': inc(Result);
+      else break;
+      end;
+      inc(h);
+    until false;
+    p:=h;
+  end;
+
+  function SkipToNextLineStart(p: PWideChar): PWideChar;
+  begin
+    repeat
+      case p^ of
+      #0: break;
+      #10,#13:
+        begin
+        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+          inc(p,2)
+        else
+          inc(p);
+        break;
+        end
+      else inc(p);
+      end;
+    until false;
+    Result:=p;
+  end;
 
 Var
   S : String;
+  JS: TJSString;
+  p, StartP: PWideChar;
+  MinIndent, CurLineIndent: Integer;
 begin
+  if V.CustomValue<>'' then
+    begin
+    JS:=V.CustomValue;
+    if JS='' then exit;
+
+    p:=SkipToNextLineStart(PWideChar(JS));
+    if p^=#0 then
+      begin
+      // simple value
+      Write(JS);
+      exit;
+      end;
+
+    // multi line value
+
+    // find minimum indent
+    MinIndent:=-1;
+    repeat
+      CurLineIndent:=GetLineIndent(p);
+      if (MinIndent<0) or (MinIndent>CurLineIndent) then
+        MinIndent:=CurLineIndent;
+      p:=SkipToNextLineStart(p);
+    until p^=#0;
+
+    // write value lines indented
+    p:=PWideChar(JS);
+    GetLineIndent(p); // the first line is already indented, skip
+    repeat
+      StartP:=p;
+      p:=SkipToNextLineStart(StartP);
+      Write(copy(JS,StartP-PWideChar(JS)+1,p-StartP));
+      if p^=#0 then break;
+      CurLineIndent:=GetLineIndent(p);
+      Write(StringOfChar(FIndentChar,FCurIndent+CurLineIndent-MinIndent));
+    until false;
+
+    exit;
+    end;
   Case V.ValueType of
-     jstUNDEFINED : S:='undefined';
-     jstNull : s:='null';
-     jstBoolean : if V.AsBoolean then s:='true' else s:='false';
-     jstString : S:='"'+EscapeString(V.AsString)+'"';
-     jstNumber :
-       if Frac(V.AsNumber)=0 then // this needs to be improved
-         Str(Round(V.AsNumber),S)
-       else
-         Str(V.AsNumber,S);
-     jstObject : ;
-     jstReference : ;
-     JSTCompletion : ;
+    jstUNDEFINED : S:='undefined';
+    jstNull : s:='null';
+    jstBoolean : if V.AsBoolean then s:='true' else s:='false';
+    jstString :
+      begin
+      JS:=V.AsString;
+      if Pos('"',JS)>0 then
+        JS:=''''+EscapeString(JS,jseqSingle)+''''
+      else
+        JS:='"'+EscapeString(JS,jseqDouble)+'"';
+      Write(JS);
+      exit;
+      end;
+    jstNumber :
+      if Frac(V.AsNumber)=0 then // this needs to be improved
+        Str(Round(V.AsNumber),S)
+      else
+        Str(V.AsNumber,S);
+    jstObject : ;
+    jstReference : ;
+    JSTCompletion : ;
   end;
   Write(S);
 end;
 
-Constructor TJSWriter.Create(AWriter: TTextWriter);
+constructor TJSWriter.Create(AWriter: TTextWriter);
 begin
   FWriter:=AWriter;
   FIndentChar:=' ';
   FOptions:=[woUseUTF8];
 end;
 
-Constructor TJSWriter.Create(Const AFileName: String);
+constructor TJSWriter.Create(const AFileName: String);
 begin
   Create(TFileWriter.Create(AFileName));
   FFreeWriter:=True;
 end;
 
-Destructor TJSWriter.Destroy;
+destructor TJSWriter.Destroy;
 begin
   If FFreeWriter then
     begin
@@ -442,11 +596,12 @@ begin
   inherited Destroy;
 end;
 
-Procedure TJSWriter.WriteFuncDef(FD: TJSFuncDef);
+procedure TJSWriter.WriteFuncDef(FD: TJSFuncDef);
 
 Var
   C : Boolean;
   I : Integer;
+  A: TJSElement;
 
 begin
   C:=(woCompact in Options);
@@ -465,13 +620,19 @@ begin
   if Not (C or FD.IsEmpty) then
     begin
     Writeln('');
-    indent;
+    Indent;
     end;
   if Assigned(FD.Body) then
     begin
-    FSkipBrackets:=True;
+    FSkipCurlyBrackets:=True;
+    //writeln('TJSWriter.WriteFuncDef '+FD.Body.ClassName);
     WriteJS(FD.Body);
-    If not (FD.Body.A is TJSStatementList) then
+    A:=FD.Body.A;
+    If (Assigned(A))
+        and (not (A is TJSStatementList))
+        and (not (A is TJSSourceElements))
+        and (not (A is TJSEmptyBlockStatement))
+    then
       if C then
         Write('; ')
       else
@@ -481,13 +642,14 @@ begin
     Write('}')
   else
     begin
-    undent;
-    Writeln('}');
+    Undent;
+    Write('}'); // do not writeln
     end;
 end;
 
-Procedure TJSWriter.WriteEmptyBlockStatement(El: TJSEmptyBlockStatement);
+procedure TJSWriter.WriteEmptyBlockStatement(El: TJSEmptyBlockStatement);
 begin
+  if El=nil then ;
   if woCompact in Options then
     Write('{}')
   else
@@ -497,77 +659,83 @@ begin
     end;
 end;
 
-Procedure TJSWriter.WriteEmptyStatement(El: TJSEmptyStatement);
+procedure TJSWriter.WriteEmptyStatement(El: TJSEmptyStatement);
 begin
-  if woEmptyStatementAsComment in options then
+  if El=nil then ;
+  if woEmptyStatementAsComment in Options then
     Write('/* Empty statement */')
 end;
 
-Procedure TJSWriter.WriteRegularExpressionLiteral(El: TJSRegularExpressionLiteral);
+procedure TJSWriter.WriteRegularExpressionLiteral(
+  El: TJSRegularExpressionLiteral);
 
 begin
   Write('/');
-  Write(EscapeString(EL.Pattern.AsString));
+  Write(EscapeString(El.Pattern.AsString,jseqBoth));
   Write('/');
-  If Assigned(EL.PatternFlags) then
-    Write(EscapeString(EL.PatternFlags.AsString));
+  If Assigned(El.PatternFlags) then
+    Write(EscapeString(El.PatternFlags.AsString,jseqBoth));
 end;
 
-Procedure TJSWriter.WriteLiteral(El: TJSLiteral);
+procedure TJSWriter.WriteLiteral(El: TJSLiteral);
 begin
-  WriteValue(el.Value);
+  WriteValue(El.Value);
 end;
 
-Procedure TJSWriter.WritePrimaryExpression(El: TJSPrimaryExpression);
+procedure TJSWriter.WritePrimaryExpression(El: TJSPrimaryExpression);
 
 begin
   if El is TJSPrimaryExpressionThis then
     Write('this')
-  else if el is TJSPrimaryExpressionIdent then
-    Write(TJSPrimaryExpressionIdent(El).Name);
+  else if El is TJSPrimaryExpressionIdent then
+    Write(TJSPrimaryExpressionIdent(El).Name)
+  else
+    Error(SErrUnknownJSClass,[El.ClassName]);
 end;
 
-Procedure TJSWriter.WriteArrayLiteral(El : TJSArrayLiteral);
-
-
+procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
 
 Var
   Chars : Array[Boolean] of string[2] = ('[]','()');
 
 Var
   i,C : Integer;
-  isArgs,WC : Boolean;
+  isArgs,WC , MultiLine: Boolean;
   BC : String[2];
 
 begin
-  isArgs:=el is TJSArguments;
+  isArgs:=El is TJSArguments;
   BC:=Chars[isArgs];
-  C:=EL.Elements.Count-1;
+  C:=El.Elements.Count-1;
   if C=-1 then
     begin
-    if isArgs then
-      Write(bc)
-    else
-      Write(bc);
+    Write(bc);
     Exit;
     end;
   WC:=(woCompact in Options) or
       ((Not isArgs) and (woCompactArrayLiterals in Options)) or
       (isArgs and (woCompactArguments in Options)) ;
-  if WC then
-    Write(Copy(BC,1,1))
-  else
+  MultiLine:=(not WC) and (C>4);
+  if MultiLine then
     begin
     Writeln(Copy(BC,1,1));
     Indent;
-    end;
+    end
+  else
+    Write(Copy(BC,1,1));
   For I:=0 to C do
-   begin
-   WriteJS(EL.Elements[i].Expr);
-   if I<C then
-     if WC then Write(', ') else Writeln(',')
-   end;
-  if not WC then
+    begin
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Elements[i].Expr);
+    if I<C then
+      if WC then
+        Write(',')
+      else if MultiLine then
+        Writeln(',')
+      else
+        Write(', ');
+    end;
+  if MultiLine then
     begin
     Writeln('');
     Undent;
@@ -576,7 +744,7 @@ begin
 end;
 
 
-Procedure TJSWriter.WriteObjectLiteral(El : TJSObjectLiteral);
+procedure TJSWriter.WriteObjectLiteral(El: TJSObjectLiteral);
 
 
 Var
@@ -585,7 +753,7 @@ Var
   S : TJSString;
 
 begin
-  C:=EL.Elements.Count-1;
+  C:=El.Elements.Count-1;
   QE:=(woQuoteElementNames in Options);
   if C=-1 then
     begin
@@ -602,16 +770,18 @@ begin
     end;
   For I:=0 to C do
    begin
-   S:=EL.Elements[i].Name;
-   if QE then
+   S:=El.Elements[i].Name;
+   if QE or not IsValidJSIdentifier(S) then
      S:='"'+S+'"';
    Write(S+': ');
    Indent;
-   WriteJS(EL.Elements[i].Expr);
+   FSkipRoundBrackets:=true;
+   WriteJS(El.Elements[i].Expr);
    if I<C then
      if WC then Write(', ') else Writeln(',');
    Undent;
    end;
+  FSkipRoundBrackets:=false;
   if not WC then
     begin
     Writeln('');
@@ -620,54 +790,74 @@ begin
   Write('}');
 end;
 
-Procedure TJSWriter.WriteMemberExpression(el : TJSMemberExpression);
+procedure TJSWriter.WriteMemberExpression(El: TJSMemberExpression);
 
-Var
-  I : integer;
-  A : TJSArguments;
+var
+  MExpr: TJSElement;
+  Args: TJSArguments;
 begin
-  if el is TJSNewMemberExpression then
+  if El is TJSNewMemberExpression then
     Write('new ');
-  WriteJS(el.mexpr);
-  if el is TJSDotMemberExpression then
+  MExpr:=El.MExpr;
+  if (MExpr is TJSPrimaryExpression)
+      or (MExpr is TJSDotMemberExpression)
+      or (MExpr is TJSBracketMemberExpression)
+      // Note: new requires brackets in this case: new (a())()
+      or ((MExpr is TJSCallExpression) and not (El is TJSNewMemberExpression))
+      or (MExpr is TJSLiteral) then
+    WriteJS(MExpr)
+  else
+    begin
+    Write('(');
+    WriteJS(MExpr);
+    Write(')');
+    end;
+  if El is TJSDotMemberExpression then
     begin
     write('.');
-    Write(TJSDotMemberExpression(el).Name);
+    Write(TJSDotMemberExpression(El).Name);
     end
-  else if el is TJSBracketMemberExpression then
+  else if El is TJSBracketMemberExpression then
     begin
     write('[');
-    WriteJS(TJSBracketMemberExpression(el).Name);
+    FSkipRoundBrackets:=true;
+    WriteJS(TJSBracketMemberExpression(El).Name);
+    FSkipRoundBrackets:=false;
     write(']');
     end
-  else if (el is TJSNewMemberExpression) then
+  else if (El is TJSNewMemberExpression) then
     begin
-    if (Assigned(TJSNewMemberExpression(el).Args)) then
-      WriteArrayLiteral(TJSNewMemberExpression(el).Args)
+    Args:=TJSNewMemberExpression(El).Args;
+    if Assigned(Args) then
+      begin
+      Writer.CurElement:=Args;
+      WriteArrayLiteral(Args);
+      end
     else
       Write('()');
     end;
 end;
 
-Procedure TJSWriter.WriteCallExpression(El : TJSCallExpression);
+procedure TJSWriter.WriteCallExpression(El: TJSCallExpression);
 
-Var
-  I : integer;
-  A : TJSArguments;
 begin
   WriteJS(El.Expr);
   if Assigned(El.Args) then
-    WriteArrayLiteral(EL.Args)
+    begin
+    Writer.CurElement:=El.Args;
+    WriteArrayLiteral(El.Args);
+    end
   else
     Write('()');
 end;
 
-Procedure TJSWriter.WriteUnary(El : TJSUnary);
+procedure TJSWriter.WriteUnary(El: TJSUnary);
 
 Var
   S : String;
 
 begin
+  FSkipRoundBrackets:=false;
   S:=El.PreFixOperator;
   if (S<>'') then
     Write(S);
@@ -680,140 +870,228 @@ begin
     end;
 end;
 
-Procedure TJSWriter.WriteStatementList(El : TJSStatementList);
+procedure TJSWriter.WriteStatementList(El: TJSStatementList);
 
 Var
   C : Boolean;
   B : Boolean;
+  LastEl: TJSElement;
 
 begin
+  //write('TJSWriter.WriteStatementList '+BoolToStr(FSkipCurlyBrackets,true));
+  //if El.A<>nil then write(' El.A='+El.A.ClassName) else write(' El.A=nil');
+  //if El.B<>nil then write(' El.B='+El.B.ClassName) else write(' El.B=nil');
+  //writeln(' ');
+
   C:=(woCompact in Options);
-  B:= Not FSkipBrackets;
+  B:= Not FSkipCurlyBrackets;
   if B then
     begin
     Write('{');
+    Indent;
     if not C then writeln('');
     end;
-  if Assigned(EL.A) then
+  if not IsEmptyStatement(El.A) then
     begin
-    WriteJS(EL.A);
-    if Assigned(EL.B) then
+    WriteJS(El.A);
+    LastEl:=El.A;
+    if Assigned(El.B) then
       begin
-      if C then
-        Write('; ')
-      else
-        Writeln(';');
-      FSkipBrackets:=True;
-      WriteJS(EL.B);
+      if not (LastEl is TJSStatementList) then
+        begin
+        if C then
+          Write('; ')
+        else
+          Writeln(';');
+        end;
+      FSkipCurlyBrackets:=True;
+      WriteJS(El.B);
+      LastEl:=El.B;
       end;
-    if not C then writeln(';');
+    if (not C) and not (LastEl is TJSStatementList) then
+      writeln(';');
+    end
+  else if Assigned(El.B) then
+    begin
+    WriteJS(El.B);
+    if (not C) and not (El.B is TJSStatementList) then
+      writeln(';');
     end;
   if B then
     begin
-    Write('}');
-    if not C then writeln('');
+    Undent;
+    Write('}'); // do not writeln
     end;
 end;
 
-Procedure TJSWriter.WriteWithStatement(El : TJSWithStatement);
+procedure TJSWriter.WriteWithStatement(El: TJSWithStatement);
 begin
    Write('with (');
-   WriteJS(EL.A);
+   FSkipRoundBrackets:=true;
+   WriteJS(El.A);
+   FSkipRoundBrackets:=false;
    if (woCompact in Options) then
      Write(') ')
    else
      WriteLn(')');
    Indent;
-   WriteJS(EL.B);
+   WriteJS(El.B);
    Undent;
 end;
 
-Procedure TJSWriter.WriteVarDeclarationList(El : TJSVariableDeclarationList);
+procedure TJSWriter.WriteVarDeclarationList(El: TJSVariableDeclarationList);
 
 begin
-  WriteJS(EL.A);
-  If Assigned(EL.B) then
+  WriteJS(El.A);
+  If Assigned(El.B) then
     begin
     Write(', ');
-    WriteJS(EL.B);
+    WriteJS(El.B);
     end;
 end;
 
-Procedure TJSWriter.WriteBinary(El : TJSBinary);
+procedure TJSWriter.WriteBinary(El: TJSBinary);
 
 Var
   S : AnsiString;
-  B : Boolean;
-  T : TJSToken;
-
-begin
-  Write('(');
-  WriteJS(EL.A);
-  B:=False;
-  if (el is TJSBinaryExpression) then
+  AllowCompact, WithBrackets: Boolean;
+begin
+  {$IFDEF VerboseJSWriter}
+  System.writeln('TJSWriter.WriteBinary SkipRoundBrackets=',FSkipRoundBrackets);
+  {$ENDIF}
+  WithBrackets:=not FSkipRoundBrackets;
+  if WithBrackets then
+    Write('(');
+  FSkipRoundBrackets:=false;
+  WriteJS(El.A);
+  AllowCompact:=False;
+  if (El is TJSBinaryExpression) then
     begin
     S:=TJSBinaryExpression(El).OperatorString;
-    B:=TJSBinaryExpression(El).AllowCompact;
+    AllowCompact:=TJSBinaryExpression(El).AllowCompact;
     end;
-  If Not (B and (woCompact in Options)) then
+  If Not (AllowCompact and (woCompact in Options)) then
     S:=' '+S+' ';
-  Write(s);
-  WriteJS(EL.B);
-  Write(')');
+  Write(S);
+  WriteJS(El.B);
+  if WithBrackets then
+    Write(')');
+end;
+
+function TJSWriter.IsEmptyStatement(El: TJSElement): boolean;
+begin
+  if (El=nil) then
+    exit(true);
+  if (El.ClassType=TJSEmptyStatement) and not (woEmptyStatementAsComment in Options) then
+    exit(true);
+  Result:=false;
+end;
+
+function TJSWriter.HasLineEnding(El: TJSElement): boolean;
+begin
+  if El<>nil then
+    begin
+    if (El.ClassType=TJSStatementList) or (El.ClassType=TJSSourceElements) then
+      exit(true);
+    end;
+  Result:=false;
 end;
 
-Procedure TJSWriter.WriteConditionalExpression(El : TJSConditionalExpression);
+procedure TJSWriter.WriteConditionalExpression(El: TJSConditionalExpression);
 
 begin
   write('(');
-  WriteJS(EL.A);
+  WriteJS(El.A);
   write(' ? ');
-  WriteJS(EL.B);
+  WriteJS(El.B);
   write(' : ');
-  WriteJS(EL.C);
+  WriteJS(El.C);
   write(')');
 end;
 
-Procedure TJSWriter.WriteAssignStatement(El : TJSAssignStatement);
+procedure TJSWriter.WriteAssignStatement(El: TJSAssignStatement);
 
 Var
   S : AnsiString;
-  T : TJSToken;
 begin
-  WriteJS(EL.LHS);
+  WriteJS(El.LHS);
   S:=El.OperatorString;
   If Not (woCompact in Options) then
-      S:=' '+S+' ';
+    S:=' '+S+' ';
   Write(s);
-  WriteJS(EL.Expr);
+  FSkipRoundBrackets:=true;
+  WriteJS(El.Expr);
+  FSkipRoundBrackets:=false;
 end;
 
-Procedure TJSWriter.WriteVarDeclaration(El : TJSVarDeclaration);
+procedure TJSWriter.WriteVarDeclaration(El: TJSVarDeclaration);
 
 begin
-  Write(EL.Name);
-  if Assigned(EL.Init) then
+  Write(El.Name);
+  if Assigned(El.Init) then
     begin
     Write(' = ');
-    WriteJS(EL.Init);
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Init);
+    FSkipRoundBrackets:=false;
     end;
 end;
 
-Procedure TJSWriter.WriteIfStatement(El : TJSIfStatement);
+procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
 
+var
+  HasBTrue, C, HasBFalse, BTrueNeedBrackets: Boolean;
 begin
+  C:=woCompact in Options;
   Write('if (');
-  WriteJS(EL.Cond);
-  Write(') ');
-  WriteJS(El.BTrue);
-  if Assigned(El.BFalse) then
+  FSkipRoundBrackets:=true;
+  WriteJS(El.Cond);
+  FSkipRoundBrackets:=false;
+  Write(')');
+  If Not C then
+    Write(' ');
+  HasBTrue:=not IsEmptyStatement(El.BTrue);
+  HasBFalse:=not IsEmptyStatement(El.BFalse);
+  if HasBTrue then
     begin
-    Write(' else ');
+    // Note: the 'else' needs {} in front
+    BTrueNeedBrackets:=HasBFalse and not (El.BTrue is TJSStatementList)
+      and not (El.BTrue is TJSEmptyBlockStatement);
+    if BTrueNeedBrackets then
+      if C then
+        Write('{')
+      else
+        begin
+        Writeln('{');
+        Indent;
+        end;
+    WriteJS(El.BTrue);
+    if BTrueNeedBrackets then
+      if C then
+        Write('}')
+      else
+        begin
+        Undent;
+        Writeln('}');
+        end;
+    end;
+  if HasBFalse then
+    begin
+    if not HasBTrue then
+      begin
+      if C then
+        Write('{}')
+      else
+        Writeln('{}');
+      end
+    else
+      Write(' ');
+    Write('else ');
     WriteJS(El.BFalse)
     end;
 end;
 
-Procedure TJSWriter.WriteForInStatement(El : TJSForInStatement);
+procedure TJSWriter.WriteForInStatement(El: TJSForInStatement);
 
 begin
   Write('for (');
@@ -823,11 +1101,11 @@ begin
   if Assigned(El.List) then
     WriteJS(El.List);
   Write(') ');
-  if Assigned(El.body) then
+  if Assigned(El.Body) then
     WriteJS(El.Body);
 end;
 
-Procedure TJSWriter.WriteForStatement(El : TJSForStatement);
+procedure TJSWriter.WriteForStatement(El: TJSForStatement);
 
 begin
   Write('for (');
@@ -835,41 +1113,56 @@ begin
     WriteJS(El.Init);
   Write('; ');
   if Assigned(El.Cond) then
+    begin
+    FSkipRoundBrackets:=true;
     WriteJS(El.Cond);
+    FSkipRoundBrackets:=false;
+    end;
   Write('; ');
   if Assigned(El.Incr) then
     WriteJS(El.Incr);
   Write(') ');
-  if Assigned(El.body) then
+  if Assigned(El.Body) then
     WriteJS(El.Body);
 end;
 
-Procedure TJSWriter.WriteWhileStatement(El : TJSWhileStatement);
+procedure TJSWriter.WriteWhileStatement(El: TJSWhileStatement);
 
 
 begin
   if El is TJSDoWhileStatement then
     begin
     Write('do ');
-    if Assigned(El.body) then
+    if Assigned(El.Body) then
+      begin
+      FSkipCurlyBrackets:=false;
       WriteJS(El.Body);
+      end;
     Write(' while (');
     If Assigned(El.Cond) then
+      begin
+      FSkipRoundBrackets:=true;
       WriteJS(EL.Cond);
+      FSkipRoundBrackets:=false;
+      end;
     Write(')');
     end
   else
     begin
     Write('while (');
     If Assigned(El.Cond) then
+      begin
+      FSkipRoundBrackets:=true;
       WriteJS(EL.Cond);
+      FSkipRoundBrackets:=false;
+      end;
     Write(') ');
-    if Assigned(El.body) then
+    if Assigned(El.Body) then
       WriteJS(El.Body);
     end;
 end;
 
-Procedure TJSWriter.WriteSwitchStatement(El : TJSSwitchStatement);
+procedure TJSWriter.WriteSwitchStatement(El: TJSSwitchStatement);
 
 Var
   C : Boolean;
@@ -888,63 +1181,86 @@ begin
   C:=(woCompact in Options);
   Write('switch (');
   If Assigned(El.Cond) then
-    WriteJS(EL.Cond);
+    begin
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Cond);
+    FSkipRoundBrackets:=false;
+    end;
   if C then
     Write(') {')
   else
     Writeln(') {');
-  For I:=0 to EL.Cases.Count-1 do
+  For I:=0 to El.Cases.Count-1 do
     begin
-    EC:=EL.Cases[i];
-    if EC=EL.TheDefault then
+    EC:=El.Cases[i];
+    if EC=El.TheDefault then
       Write('default')
     else
       begin
       Write('case ');
+      FSkipRoundBrackets:=true;
       WriteJS(EC.Expr);
+      FSkipRoundBrackets:=false;
       end;
-    If C then
-      Write(': ')
-    else
-      Writeln(':');
     if Assigned(EC.Body) then
       begin
+      FSkipCurlyBrackets:=true;
+      If C then
+        Write(': ')
+      else
+        Writeln(':');
+      Indent;
       WriteJS(EC.Body);
-      if C then
+      Undent;
+      if (EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement) then
         begin
-        if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
-          write('; ')
+        if C then
+          begin
+          if I<El.Cases.Count-1 then
+            Write(' ');
+          end
+        else
+          Writeln('');
         end
+      else if C then
+        Write('; ')
+      else
+        Writeln(';');
+      end
+    else
+      begin
+      if C then
+        Write(': ')
       else
-        Writeln('');
+        Writeln(':');
       end;
     end;
   Write('}');
 end;
 
-Procedure TJSWriter.WriteTargetStatement(El : TJSTargetStatement);
+procedure TJSWriter.WriteTargetStatement(El: TJSTargetStatement);
 
 Var
   TN : TJSString;
 
 begin
-  TN:=EL.TargetName;
+  TN:=El.TargetName;
   if (El is TJSForStatement) then
     WriteForStatement(TJSForStatement(El))
   else if (El is TJSSwitchStatement) then
     WriteSwitchStatement(TJSSwitchStatement(El))
   else if (El is TJSForInStatement) then
     WriteForInStatement(TJSForInStatement(El))
-  else if EL is TJSWhileStatement then
+  else if El is TJSWhileStatement then
     WriteWhileStatement(TJSWhileStatement(El))
-  else if (EL is TJSContinueStatement) then
+  else if (El is TJSContinueStatement) then
     begin
     if (TN<>'') then
       Write('continue '+TN)
     else
       Write('continue');
     end
-  else if (EL is TJSBreakStatement) then
+  else if (El is TJSBreakStatement) then
     begin
    if (TN<>'') then
       Write('break '+TN)
@@ -952,31 +1268,38 @@ begin
       Write('break');
     end
   else
-    Error('Unknown target statement class: "%s"',[EL.ClassName])
+    Error('Unknown target statement class: "%s"',[El.ClassName])
 end;
 
-Procedure TJSWriter.WriteReturnStatement(EL: TJSReturnStatement);
+procedure TJSWriter.WriteReturnStatement(El: TJSReturnStatement);
 
 begin
-  Write('return ');
-  WriteJS(EL.Expr);
+  if El.Expr=nil then
+    Write('return')
+  else
+    begin
+    Write('return ');
+    FSkipRoundBrackets:=true;
+    WriteJS(El.Expr);
+    FSkipRoundBrackets:=false;
+    end;
 end;
 
-Procedure TJSWriter.WriteLabeledStatement(El : TJSLabeledStatement);
+procedure TJSWriter.WriteLabeledStatement(El: TJSLabeledStatement);
 begin
-  if Assigned(EL.TheLabel) then
+  if Assigned(El.TheLabel) then
     begin
-    Write(EL.TheLabel.Name);
+    Write(El.TheLabel.Name);
     if woCompact in Options then
       Write(': ')
     else
       Writeln(':');
     end;
   // Target ??
-  WriteJS(EL.A);
+  WriteJS(El.A);
 end;
 
-Procedure TJSWriter.WriteTryStatement(el :TJSTryStatement);
+procedure TJSWriter.WriteTryStatement(El: TJSTryStatement);
 
 Var
   C : Boolean;
@@ -984,104 +1307,110 @@ Var
 begin
   C:=woCompact in Options;
   Write('try {');
-  if Not C then writeln('');
-  FSkipBrackets:=True;
-  Indent;
-  WriteJS(El.Block);
-  Undent;
-  If C then
-    Write('} ')
-  else
+  if not IsEmptyStatement(El.Block) then
     begin
-    Writeln('');
-    Writeln('}');
+    if Not C then writeln('');
+    FSkipCurlyBrackets:=True;
+    Indent;
+    WriteJS(El.Block);
+    if (Not C) and (not (El.Block is TJSStatementList)) then writeln('');
+    Undent;
     end;
+  Write('}');
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
     begin
-    Write('catch ('+El.Ident);
+    Write(' catch');
+    if El.Ident<>'' then Write(' ('+El.Ident+')');
     If C then
-      Write(') {')
-    else
-      Writeln(') {');
-    Indent;
-    WriteJS(EL.BCatch);
-    Undent;
-    If C then
-      if (El is TJSTryCatchFinallyStatement) then
-        Write('} ')
-      else
-        Write('}')
+      Write(' {')
     else
+      Writeln(' {');
+    if not IsEmptyStatement(El.BCatch) then
       begin
-      Writeln('');
-      Writeln('}');
+      FSkipCurlyBrackets:=True;
+      Indent;
+      WriteJS(El.BCatch);
+      Undent;
+      if (Not C) and (not (El.BCatch is TJSStatementList)) then writeln('');
       end;
+    Write('}');
     end;
   If (El is TJSTryCatchFinallyStatement) or (El is TJSTryFinallyStatement) then
     begin
     If C then
-      Write('finally {')
-    else
-      Writeln('finally {');
-    Indent;
-    WriteJS(EL.BFinally);
-    Undent;
-    If C then
-      Write('}')
+      Write(' finally {')
     else
+      Writeln(' finally {');
+    if not IsEmptyStatement(El.BFinally) then
       begin
-      Writeln('');
-      Writeln('}');
+      Indent;
+      FSkipCurlyBrackets:=True;
+      WriteJS(El.BFinally);
+      Undent;
+      if (Not C) and (not (El.BFinally is TJSStatementList)) then writeln('');
       end;
+    Write('}');
     end;
 end;
 
-Procedure TJSWriter.WriteFunctionBody(el : TJSFunctionBody);
+procedure TJSWriter.WriteFunctionBody(El: TJSFunctionBody);
 
 begin
-  if Assigned(EL.A) then
-    WriteJS(EL.A);
+  //writeln('TJSWriter.WriteFunctionBody '+El.A.ClassName+' FSkipBrackets='+BoolToStr(FSkipCurlyBrackets,'true','false'));
+  if not IsEmptyStatement(El.A) then
+    WriteJS(El.A);
 end;
 
-Procedure TJSWriter.WriteFunctionDeclarationStatement(El : TJSFunctionDeclarationStatement);
+procedure TJSWriter.WriteFunctionDeclarationStatement(
+  El: TJSFunctionDeclarationStatement);
 
 begin
-  if Assigned(EL.AFunction) then
-    WriteFuncDef(EL.AFunction);
+  if Assigned(El.AFunction) then
+    WriteFuncDef(El.AFunction);
 end;
 
-Procedure TJSWriter.WriteSourceElements(El :TJSSourceElements);
+procedure TJSWriter.WriteSourceElements(El: TJSSourceElements);
 
 Var
-  I : Integer;
   C : Boolean;
-  E : TJSElement;
+
+  Procedure WriteElements(Elements: TJSElementNodes);
+  Var
+    I : Integer;
+    E : TJSElement;
+  begin
+    if Elements=nil then exit;
+    For I:=0 to Elements.Count-1 do
+      begin
+      E:=Elements.Nodes[i].Node;
+      WriteJS(E);
+      if Not C then
+        WriteLn(';')
+      else
+        if I<Elements.Count-1 then
+          Write('; ')
+        else
+          Write(';')
+      end;
+  end;
 
 begin
   C:=(woCompact in Options);
-  For I:=0 to EL.Statements.Count-1 do
-    begin
-    E:=EL.Statements.Nodes[i].Node;
-    WriteJS(E);
-    if Not C then
-      WriteLn(';')
-    else
-      if I<EL.Statements.Count-1 then
-        Write('; ')
-      else
-        Write(';')
-    end;
+  WriteElements(El.Vars);
+  WriteElements(El.Functions);
+  WriteElements(El.Statements);
 end;
 
-
-Procedure TJSWriter.WriteVariableStatement(el : TJSVariableStatement);
+procedure TJSWriter.WriteVariableStatement(El: TJSVariableStatement);
 
 begin
   Write('var ');
-  WriteJS(EL.A);
+  WriteJS(El.A);
 end;
 
-Procedure TJSWriter.WriteJS(El: TJSElement);
+procedure TJSWriter.WriteJS(El: TJSElement);
+var
+  LastWritingEl: TJSElement;
 begin
 {$IFDEF DEBUGJSWRITER}
   if (EL<>Nil) then
@@ -1089,64 +1418,67 @@ begin
   else
     system.Writeln('WriteJS : El = Nil');
 {$ENDIF}
+  LastWritingEl:=Writer.CurElement;
+  Writer.CurElement:=El;
   if (El is TJSEmptyBlockStatement ) then
-    WriteEmptyBlockStatement(TJSEmptyBlockStatement(el))
+    WriteEmptyBlockStatement(TJSEmptyBlockStatement(El))
   else if (El is TJSEmptyStatement) then
-    WriteEmptyStatement(TJSEmptyStatement(el))
-  else if (el is TJSLiteral) then
-    WriteLiteral(TJSLiteral(el))
-  else if (el is TJSPrimaryExpression) then
-    WritePrimaryExpression(TJSPrimaryExpression(el))
-  else if (el is TJSArrayLiteral) then
-    WriteArrayLiteral(TJSArrayLiteral(el))
-  else if (el is TJSObjectLiteral) then
-    WriteObjectLiteral(TJSObjectLiteral(el))
-  else if (el is TJSMemberExpression) then
-    WriteMemberExpression(TJSMemberExpression(el))
-  else if (el is TJSRegularExpressionLiteral) then
+    WriteEmptyStatement(TJSEmptyStatement(El))
+  else if (El is TJSLiteral) then
+    WriteLiteral(TJSLiteral(El))
+  else if (El is TJSPrimaryExpression) then
+    WritePrimaryExpression(TJSPrimaryExpression(El))
+  else if (El is TJSArrayLiteral) then
+    WriteArrayLiteral(TJSArrayLiteral(El))
+  else if (El is TJSObjectLiteral) then
+    WriteObjectLiteral(TJSObjectLiteral(El))
+  else if (El is TJSMemberExpression) then
+    WriteMemberExpression(TJSMemberExpression(El))
+  else if (El is TJSRegularExpressionLiteral) then
     WriteRegularExpressionLiteral(TJSRegularExpressionLiteral(El))
-  else if (el is TJSCallExpression) then
-    WriteCallExpression(TJSCallExpression(el))
-  else if (el is TJSLabeledStatement) then // Before unary
-    WriteLabeledStatement(TJSLabeledStatement(el))
-  else if (el is TJSFunctionBody) then // Before unary
-    WriteFunctionBody(TJSFunctionBody(el))
-  else if (el is TJSVariableStatement) then // Before unary
-    WriteVariableStatement(TJSVariableStatement(el))
-  else if (el is TJSUNary) then
-    WriteUnary(TJSUnary(el))
-  else if (el is TJSVariableDeclarationList) then
-    WriteVarDeclarationList(TJSVariableDeclarationList(el)) // Must be before binary
-  else if (el is TJSStatementList) then
-    WriteStatementList(TJSStatementList(el)) // Must be before binary
-  else if (el is TJSWithStatement) then
+  else if (El is TJSCallExpression) then
+    WriteCallExpression(TJSCallExpression(El))
+  else if (El is TJSLabeledStatement) then // Before unary
+    WriteLabeledStatement(TJSLabeledStatement(El))
+  else if (El is TJSFunctionBody) then // Before unary
+    WriteFunctionBody(TJSFunctionBody(El))
+  else if (El is TJSVariableStatement) then // Before unary
+    WriteVariableStatement(TJSVariableStatement(El))
+  else if (El is TJSUNary) then
+    WriteUnary(TJSUnary(El))
+  else if (El is TJSVariableDeclarationList) then
+    WriteVarDeclarationList(TJSVariableDeclarationList(El)) // Must be before binary
+  else if (El is TJSStatementList) then
+    WriteStatementList(TJSStatementList(El)) // Must be before binary
+  else if (El is TJSWithStatement) then
     WriteWithStatement(TJSWithStatement(El)) // Must be before binary
-  else if (el is TJSBinary) then
-    WriteBinary(TJSBinary(el))
-  else if (el is TJSConditionalExpression) then
-    WriteConditionalExpression(TJSConditionalExpression(el))
-  else if (el is TJSAssignStatement) then
-    WriteAssignStatement(TJSAssignStatement(el))
-  else if (el is TJSVarDeclaration) then
-    WriteVarDeclaration(TJSVarDeclaration(el))
-  else if (el is TJSIfStatement) then
-    WriteIfStatement(TJSIfStatement(el))
-  else if (el is TJSTargetStatement) then
-    WriteTargetStatement(TJSTargetStatement(el))
-  else if (el is TJSReturnStatement) then
-    WriteReturnStatement(TJSReturnStatement(el))
-  else if (el is TJSTryStatement) then
-    WriteTryStatement(TJSTryStatement(el))
-  else if (el is TJSFunctionDeclarationStatement) then
-    WriteFunctionDeclarationStatement(TJSFunctionDeclarationStatement(el))
-  else if (el is TJSSourceElements) then
-    WriteSourceElements(TJSSourceElements(el))
-  else if EL=Nil then
+  else if (El is TJSBinary) then
+    WriteBinary(TJSBinary(El))
+  else if (El is TJSConditionalExpression) then
+    WriteConditionalExpression(TJSConditionalExpression(El))
+  else if (El is TJSAssignStatement) then
+    WriteAssignStatement(TJSAssignStatement(El))
+  else if (El is TJSVarDeclaration) then
+    WriteVarDeclaration(TJSVarDeclaration(El))
+  else if (El is TJSIfStatement) then
+    WriteIfStatement(TJSIfStatement(El))
+  else if (El is TJSTargetStatement) then
+    WriteTargetStatement(TJSTargetStatement(El))
+  else if (El is TJSReturnStatement) then
+    WriteReturnStatement(TJSReturnStatement(El))
+  else if (El is TJSTryStatement) then
+    WriteTryStatement(TJSTryStatement(El))
+  else if (El is TJSFunctionDeclarationStatement) then
+    WriteFunctionDeclarationStatement(TJSFunctionDeclarationStatement(El))
+  else if (El is TJSSourceElements) then
+    WriteSourceElements(TJSSourceElements(El))
+  else if El=Nil then
     Error(SErrNilNode)
   else
     Error(SErrUnknownJSClass,[El.ClassName]);
-//  Write('/* '+EL.ClassName+' */');
-  FSkipBrackets:=False;
+//  Write('/* '+El.ClassName+' */');
+  FSkipCurlyBrackets:=False;
+  Writer.CurElement:=LastWritingEl;
 end;
 
 { TFileWriter }
@@ -1165,6 +1497,7 @@ end;
 
 Constructor TFileWriter.Create(Const AFileNAme: String);
 begin
+  inherited Create;
   FFileName:=AFileName;
   Assign(FFile,AFileName);
   Rewrite(FFile);
@@ -1188,33 +1521,103 @@ end;
 
 { TTextWriter }
 
-Function TTextWriter.Write(Const S: UnicodeString) : Integer;
+procedure TTextWriter.Writing;
+begin
+  if Assigned(OnWriting) then
+    OnWriting(Self);
+end;
+
+constructor TTextWriter.Create;
+begin
+  FCurLine:=1;
+  FCurColumn:=1;
+end;
+
+function TTextWriter.Write(const S: UnicodeString): Integer;
+var
+  p: PWideChar;
+  c: WideChar;
 begin
+  if S='' then exit;
+  Writing;
   Result:=DoWrite(S);
+  p:=PWideChar(S);
+  repeat
+    c:=p^;
+    case c of
+    #0:
+      if p-PWideChar(S)=length(S)*2 then
+        break
+      else
+        inc(FCurColumn);
+    #10,#13:
+      begin
+      FCurColumn:=1;
+      inc(FCurLine);
+      inc(p);
+      if (p^ in [#10,#13]) and (c<>p^) then inc(p);
+      continue;
+      end;
+    else
+      // ignore low/high surrogate, CurColumn is char index, not codepoint
+      inc(FCurColumn);
+    end;
+    inc(p);
+  until false;
 end;
 
-Function TTextWriter.Write(Const S: String) : integer;
+function TTextWriter.Write(const S: AnsiString): Integer;
+var
+  p: PChar;
+  c: Char;
 begin
+  if S='' then exit;
+  Writing;
   Result:=DoWrite(S);
+  p:=PChar(S);
+  repeat
+    c:=p^;
+    case c of
+    #0:
+      if p-PChar(S)=length(S) then
+        break
+      else
+        inc(FCurColumn);
+    #10,#13:
+      begin
+      FCurColumn:=1;
+      inc(FCurLine);
+      inc(p);
+      if (p^ in [#10,#13]) and (c<>p^) then inc(p);
+      continue;
+      end;
+    else
+      // ignore UTF-8 multibyte chars, CurColumn is char index, not codepoint
+      inc(FCurColumn);
+    end;
+    inc(p);
+  until false;
 end;
 
-Function TTextWriter.WriteLn(Const S: String) : Integer;
+function TTextWriter.WriteLn(const S: AnsiString): Integer;
 begin
-  Result:=DoWrite(S)+DoWrite(sLineBreak);
+  Result:=Write(S)+Write(sLineBreak);
 end;
 
-Function TTextWriter.Write(Const Fmt: String; Args: Array of const) : Integer;
+function TTextWriter.Write(const Fmt: AnsiString;
+  Args: array of const): Integer;
 
 begin
-  Result:=DoWrite(Format(Fmt,Args));
+  Result:=Write(Format(Fmt,Args));
 end;
 
-Function TTextWriter.WriteLn(Const Fmt: String; Args: Array of const) : integer;
+function TTextWriter.WriteLn(const Fmt: AnsiString;
+  Args: array of const): Integer;
 begin
   Result:=WriteLn(Format(Fmt,Args));
 end;
 
-Function TTextWriter.Write(Const Args: Array of const) : Integer;
+function TTextWriter.Write(const Args: array of const): Integer;
 
 Var
   I : Integer;
@@ -1250,11 +1653,11 @@ begin
     if (U<>'') then
       Result:=Result+Write(u)
     else if (S<>'') then
-      Result:=Result+write(s);
+      Result:=Result+Write(s);
     end;
 end;
 
-Function TTextWriter.WriteLn(Const Args: Array of const) : integer;
+function TTextWriter.WriteLn(const Args: array of const): Integer;
 begin
   Result:=Write(Args)+Writeln('');
 end;
diff --git a/packages/fcl-js/tests/tcparser.pp b/packages/fcl-js/tests/tcparser.pp
index 67a960f368..cd2150de69 100644
--- a/packages/fcl-js/tests/tcparser.pp
+++ b/packages/fcl-js/tests/tcparser.pp
@@ -5,7 +5,7 @@ unit tcparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, jsParser, jstree, jsbase;
+  Classes, SysUtils, fpcunit, testregistry, jsParser, jstree, jsbase;
 
 type
 
@@ -172,9 +172,6 @@ Function TTestJSParser.GetFirstStatement: TJSElement;
 
 Var
   E : TJSElementNodes;
-  N : TJSElement;
-  X : TJSExpressionStatement;
-
 begin
   E:=GetStatements;
   AssertNotNull('Have statements',E);
@@ -186,8 +183,6 @@ end;
 Function TTestJSParser.GetFirstVar: TJSElement;
 Var
   E : TJSElementNodes;
-  N : TJSElement;
-  X : TJSExpressionStatement;
 begin
   E:=GetVars;
   AssertNotNull('Have statements',E);
@@ -202,8 +197,6 @@ Function TTestJSParser.GetExpressionStatement: TJSExpressionStatement;
 
 Var
   N : TJSElement;
-  X : TJSExpressionStatement;
-
 begin
   N:=GetFirstStatement;
   CheckClass(N,TJSExpressionStatement);
@@ -2247,8 +2240,6 @@ procedure TTestJSParser.TestSwitchEmpty;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
-
 begin
   CreateParser('switch (a) {}');
   E:=GetFirstStatement;
@@ -2265,7 +2256,6 @@ procedure TTestJSParser.TestSwitchOne;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
   C : TJSCaseElement;
 begin
   CreateParser('switch (a) { case c : {}}');
@@ -2286,7 +2276,6 @@ procedure TTestJSParser.TestSwitchTwo;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
   C : TJSCaseElement;
 begin
   CreateParser('switch (a) { case c: {}'+sLineBreak+' case d: {}}');
@@ -2310,7 +2299,6 @@ procedure TTestJSParser.TestSwitchTwoDefault;
 Var
   E : TJSElement;
   S : TJSSwitchStatement;
-  P : TJSPrimaryExpressionIdent;
   C : TJSCaseElement;
 begin
   CreateParser('switch (a) { case c: {} case d: {} default: {}}');
diff --git a/packages/fcl-js/tests/tcscanner.pp b/packages/fcl-js/tests/tcscanner.pp
index 292707b44f..d305c58ad4 100644
--- a/packages/fcl-js/tests/tcscanner.pp
+++ b/packages/fcl-js/tests/tcscanner.pp
@@ -5,7 +5,7 @@ unit tcscanner;
 interface
 
 uses
-  Classes, SysUtils, Typinfo, fpcunit, testutils, testregistry, jstoken, jsscanner;
+  Classes, SysUtils, Typinfo, fpcunit, testregistry, jstoken, jsscanner;
 
 type
 
@@ -190,7 +190,6 @@ end;
 procedure TTestJSScanner.AssertEquals(AMessage : String; AExpected, AActual: TJSToken);
 
 Var
-  J : TJSToken;
   S,EN1,EN2 : String;
 
 begin
@@ -857,7 +856,6 @@ procedure TTestJSScanner.DoTestString(S: String);
 
 Var
   J : TJSToken;
-  T : String;
 begin
   CreateScanner(S);
   try
diff --git a/packages/fcl-js/tests/tcsrcmap.pas b/packages/fcl-js/tests/tcsrcmap.pas
new file mode 100644
index 0000000000..65927a9ace
--- /dev/null
+++ b/packages/fcl-js/tests/tcsrcmap.pas
@@ -0,0 +1,175 @@
+unit TCSrcMap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, JSSrcMap;
+
+type
+
+  { TCustomTestSrcMap }
+
+  TCustomTestSrcMap = class(TTestCase)
+  protected
+    procedure CheckEl(aName: String; El: TJSONData; aClass: TClass);
+    function GetEl(Obj: TJSONObject; aName: String; aClass: TClass): TJSONData;
+  end;
+
+  { TTestSrcMap }
+
+  TTestSrcMap = class(TCustomTestSrcMap)
+  published
+    procedure Test_Base64VLQ;
+    procedure TestSrcMapIgnoreDuplicate;
+    procedure TestSrcMapNames;
+  end;
+
+implementation
+
+{ TCustomTestSrcMap }
+
+procedure TCustomTestSrcMap.CheckEl(aName: String; El: TJSONData; aClass: TClass);
+begin
+  AssertNotNull('json "'+aName+'" exists',El);
+  AssertEquals('json "'+aName+'" class',El.ClassType,aClass);
+end;
+
+function TCustomTestSrcMap.GetEl(Obj: TJSONObject; aName: String; aClass: TClass): TJSONData;
+begin
+  Result:=Obj.Elements[aName];
+  CheckEl(aName,Result,aClass);
+end;
+
+{ TTestSrcMap }
+
+procedure TTestSrcMap.Test_Base64VLQ;
+var
+  i: Integer;
+  s: String;
+  p: PChar;
+  j: NativeInt;
+begin
+  for i:=-511 to 511 do
+  begin
+    s:=EncodeBase64VLQ(i);
+    p:=PChar(s);
+    j:=DecodeBase64VLQ(p);
+    if i<>j then
+      Fail('Encode/DecodeBase64VLQ OrigIndex='+IntToStr(i)+' Code="'+s+'" NewIndex='+IntToStr(j));
+  end;
+end;
+
+procedure TTestSrcMap.TestSrcMapIgnoreDuplicate;
+var
+  sm: TSourceMap;
+  Obj: TJSONObject;
+  El: TJSONData;
+  Arr: TJSONArray;
+begin
+  Obj:=nil;
+  sm:=TSourceMap.Create('generated.js');
+  try
+    sm.AddMapping(1,0,'a.js',1,0);
+    sm.AddMapping(2,0);
+    sm.AddMapping(2,0);
+    sm.AddMapping(3,0,'a.js',2,0);
+
+    //writeln(sm.ToString);
+    {
+      version: 3,
+      file: 'generated.js',
+      sources: ['a.js'],
+      names: [],
+      mappings: 'AAAA;A;AACA'
+    }
+    Obj:=sm.ToJSON;
+
+    // version
+    El:=GetEl(Obj,'version',TJSONIntegerNumber);
+    AssertEquals('json "version" value',El.AsInt64,3);
+
+    // file
+    El:=GetEl(Obj,'file',TJSONString);
+    AssertEquals('json "file" value',El.AsString,'generated.js');
+
+    // sources
+    Arr:=TJSONArray(GetEl(Obj,'sources',TJSONArray));
+    AssertEquals('json "sources".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('sources[0]',El,TJSONString);
+    AssertEquals('json "sources[0]" value',El.AsString,'a.js');
+
+    // names
+    Arr:=TJSONArray(GetEl(Obj,'names',TJSONArray));
+    AssertEquals('json "names".count',Arr.Count,0);
+
+    // mappings
+    El:=GetEl(Obj,'mappings',TJSONString);
+    AssertEquals('json "mappings" value',El.AsString,'AAAA;A;AACA');
+
+  finally
+    Obj.Free;
+    sm.Free;
+  end;
+end;
+
+procedure TTestSrcMap.TestSrcMapNames;
+var
+  sm: TSourceMap;
+  Obj: TJSONObject;
+  El: TJSONData;
+  Arr: TJSONArray;
+begin
+  Obj:=nil;
+  sm:=TSourceMap.Create('generated.js');
+  try
+    sm.AddMapping(1,1,'a.js',2,2,'foo');
+    sm.AddMapping(3,3,'a.js',4,4,'foo');
+    writeln(sm.ToString);
+    {
+      version: 3,
+      file: 'generated.js',
+      sources: ['a.js'],
+      names: ['foo'],
+      mappings: 'CACEA;;GAEEA'
+    }
+    Obj:=sm.ToJSON;
+
+    // version
+    El:=GetEl(Obj,'version',TJSONIntegerNumber);
+    AssertEquals('json "version" value',El.AsInt64,3);
+
+    // file
+    El:=GetEl(Obj,'file',TJSONString);
+    AssertEquals('json "file" value',El.AsString,'generated.js');
+
+    // sources
+    Arr:=TJSONArray(GetEl(Obj,'sources',TJSONArray));
+    AssertEquals('json "sources".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('sources[0]',El,TJSONString);
+    AssertEquals('json "sources[0]" value',El.AsString,'a.js');
+
+    // names
+    Arr:=TJSONArray(GetEl(Obj,'names',TJSONArray));
+    AssertEquals('json "names".count',Arr.Count,1);
+    El:=Arr[0];
+    CheckEl('names[0]',El,TJSONString);
+    AssertEquals('json "names[0]" value',El.AsString,'foo');
+
+    // mappings
+    El:=GetEl(Obj,'mappings',TJSONString);
+    AssertEquals('json "mappings" value',El.AsString,'CACEA;;GAEEA');
+
+  finally
+    Obj.Free;
+    sm.Free;
+  end;
+end;
+
+initialization
+  RegisterTests([TTestSrcMap]);
+end.
+
diff --git a/packages/fcl-js/tests/tcwriter.pp b/packages/fcl-js/tests/tcwriter.pp
index af53781636..a9d05086ed 100644
--- a/packages/fcl-js/tests/tcwriter.pp
+++ b/packages/fcl-js/tests/tcwriter.pp
@@ -5,7 +5,7 @@ unit tcwriter;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, jsbase, jstree, jswriter;
+  Classes, SysUtils, fpcunit, testregistry, jsbase, jstree, jswriter;
 
 type
 
@@ -84,6 +84,8 @@ type
   Public
     Procedure TestAssignment(Const Msg : String; AClass : TJSAssignStatementClass; Result : String;ACompact : Boolean);
     Function CreateAssignment(AClass : TJSAssignStatementClass) : TJSAssignStatement;
+    Function CreateStatementListOneElement : TJSStatementList;
+    Function CreateStatementListTwoElement2 : TJSStatementList;
   published
     Procedure TestEmptyStatement;
     Procedure TestEmptyStatementComment;
@@ -130,6 +132,7 @@ type
     Procedure TestAssignmentStatementBinaryAndCompact;
     Procedure TestForStatementEmpty;
     Procedure TestForStatementFull;
+    Procedure TestForStatementFull1;
     Procedure TestForStatementCompact;
     Procedure TestForInStatement;
     Procedure TestWhileStatement;
@@ -152,6 +155,7 @@ type
     Procedure TestStatementListOneStatementCompact;
     Procedure TestStatementListTwoStatements;
     Procedure TestStatementListTwoStatementsCompact;
+    Procedure TestStatementListFor;
     Procedure TestEmptyFunctionDef;
     Procedure TestEmptyFunctionDefCompact;
     Procedure TestFunctionDefParams;
@@ -628,7 +632,7 @@ begin
   U.Args:=TJSArguments.Create(0,0);
   U.Args.Elements.AddElement;
   U.Args.Elements[0].Expr:=CreateLiteral(123);
-  AssertWrite('member b of object a (a[b])','new a('+slinebreak+'123'+sLineBreak+')',U);
+  AssertWrite('member b of object a (a[b])','new a(123)',U);
 end;
 
 Procedure TTestExpressionWriter.TestNewMemberCompact;
@@ -666,7 +670,8 @@ begin
   U.Args:=TJSArguments.Create(0,0);
   U.Args.Elements.AddElement;
   U.Args.Elements[0].Expr:=CreateLiteral(123);
-  AssertWrite('call a(123)','a('+slinebreak+'123'+sLineBreak+')',U);
+  AssertWrite('call a(123)',
+     'a(123)',U);
 end;
 
 Procedure TTestExpressionWriter.TestCallCompact;
@@ -696,7 +701,7 @@ begin
   U.Args.Elements[0].Expr:=CreateLiteral(123);
   U.Args.Elements.AddElement;
   U.Args.Elements[1].Expr:=CreateLiteral(456);
-  AssertWrite('call a(123,456)','a(123, 456)',U);
+  AssertWrite('call a(123,456)','a(123,456)',U);
 
 end;
 
@@ -767,6 +772,19 @@ begin
   Result.Expr:=CreateIdent('b');
 end;
 
+function TTestStatementWriter.CreateStatementListOneElement: TJSStatementList;
+begin
+  Result:=TJSStatementList.Create(0,0);
+  Result.A:=CreateAssignment(nil);
+end;
+
+function TTestStatementWriter.CreateStatementListTwoElement2: TJSStatementList;
+begin
+  Result:=TJSStatementList.Create(0,0);
+  Result.A:=CreateAssignment(nil);
+  Result.B:=CreateAssignment(nil);
+end;
+
 Procedure TTestStatementWriter.TestEmptyStatement;
 
 begin
@@ -801,8 +819,6 @@ Procedure TTestStatementWriter.TestVarDeclaration;
 
 Var
   V : TJSVarDeclaration;
-  L : TJSPrimaryExpressionIdent;
-
 begin
   V:=TJSVarDeclaration.Create(0,0);
   V.Name:='a';
@@ -812,8 +828,6 @@ end;
 Procedure TTestStatementWriter.TestVarDeclarationInit;
 Var
   V : TJSVarDeclaration;
-  L : TJSLiteral;
-
 begin
   V:=TJSVarDeclaration.Create(0,0);
   V.Name:='a';
@@ -864,8 +878,6 @@ Procedure TTestStatementWriter.TestVarDeclarationStatement;
 Var
   S : TJSVariableStatement;
   V : TJSVarDeclaration;
-  L : TJSPrimaryExpressionIdent;
-
 begin
   S:=TJSVariableStatement.Create(0,0);
   V:=TJSVarDeclaration.Create(0,0);
@@ -1126,12 +1138,10 @@ end;
 
 Procedure TTestStatementWriter.TestForStatementFull;
 
-
 Var
   S : TJSForStatement;
   UPP : TJSUnaryPostPlusPlusExpression;
   CL : TJSRelationalExpressionLT;
-  L : TJSLiteral;
   sa : TJSSimpleAssignStatement;
 
 begin
@@ -1148,7 +1158,35 @@ begin
   S.Incr:=UPP;
   S.Cond:=CL;
   S.Body:=TJSEmptyBlockStatement.Create(0,0);
-  AssertWrite('for i:=0 to 9','for (i = 0; (i < 10); i++) {'+sLineBreak+'}',S);
+  AssertWrite('for i:=0 to 9','for (i = 0; i < 10; i++) {'+sLineBreak+'}',S);
+end;
+
+procedure TTestStatementWriter.TestForStatementFull1;
+
+Var
+  S : TJSForStatement;
+  UPP : TJSUnaryPostPlusPlusExpression;
+  CL : TJSRelationalExpressionLT;
+  sa : TJSSimpleAssignStatement;
+
+begin
+  SA:=TJSSimpleAssignStatement.Create(0,0);
+  SA.LHS:=CreateIdent('i');
+  SA.Expr:=CreateLiteral(0);
+  UPP:=TJSUnaryPostPlusPlusExpression.Create(0,0);
+  UPP.A:=CreateIdent('i');
+  CL:=TJSRelationalExpressionLT.Create(0,0);
+  CL.A:=CreateIdent('i');
+  CL.B:=CreateLiteral(10);
+  S:=TJSForStatement.Create(0,0);
+  S.Init:=SA;
+  S.Incr:=UPP;
+  S.Cond:=CL;
+  S.Body:=CreateStatementListOneElement;
+  AssertWrite('for i:=0 to 9',
+     'for (i = 0; i < 10; i++) {'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestForStatementCompact;
@@ -1156,7 +1194,6 @@ Var
   S : TJSForStatement;
   UPP : TJSUnaryPostPlusPlusExpression;
   CL : TJSRelationalExpressionLT;
-  L : TJSLiteral;
   sa : TJSSimpleAssignStatement;
 
 begin
@@ -1174,7 +1211,7 @@ begin
   S.Cond:=CL;
   S.Body:=TJSEmptyBlockStatement.Create(0,0);
   Writer.Options:=[woCompact,woUseUTF8];
-  AssertWrite('for i:=0 to 9','for (i=0; (i<10); i++) {}',S);
+  AssertWrite('for i:=0 to 9','for (i=0; i<10; i++) {}',S);
 end;
 
 Procedure TTestStatementWriter.TestForInStatement;
@@ -1296,7 +1333,7 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   C.Expr:=CreateIdent('d');
-  AssertWrite('switch ','switch (a) {case c: {}case d: {}}',S);
+  AssertWrite('switch ','switch (a) {case c: {} case d: {}}',S);
 end;
 
 Procedure TTestStatementWriter.TestSwitchStatementTwoElementsDefault;
@@ -1335,7 +1372,7 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   S.TheDefault:=C;
-  AssertWrite('switch ','switch (a) {case c: {}case d: {}default: {}}',S);
+  AssertWrite('switch ','switch (a) {case c: {} case d: {} default: {}}',S);
 end;
 
 Procedure TTestStatementWriter.TestSwitchStatementTwoElementsOneEmpty;
@@ -1353,7 +1390,16 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   S.TheDefault:=C;
-  AssertWrite('switch ','switch (a) {'+sLineBreak+'case c:'+sLineBreak+'case d:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'default:'+sLineBreak+'{'+sLineBreak+'}'+sLineBreak+'}',S);
+  AssertWrite('switch ',
+     'switch (a) {'+sLineBreak
+    +'case c:'+sLineBreak
+    +'case d:'+sLineBreak
+    +'{'+sLineBreak
+    +'}'+sLineBreak
+    +'default:'+sLineBreak
+    +'{'+sLineBreak
+    +'}'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestSwitchStatementTwoElementsOneEmptyCompact;
@@ -1372,7 +1418,7 @@ begin
   C:=S.Cases.AddCase;
   C.Body:=TJSEmptyBlockStatement.Create(0,0);;
   S.TheDefault:=C;
-  AssertWrite('switch ','switch (a) {case c: case d: {}default: {}}',S);
+  AssertWrite('switch ','switch (a) {case c: case d: {} default: {}}',S);
 end;
 
 Procedure TTestStatementWriter.TestIfThen;
@@ -1397,7 +1443,10 @@ begin
   S.Cond:=CreateIdent('a');
   S.btrue:=TJSEmptyBlockStatement.Create(0,0);
   S.bfalse:=TJSEmptyBlockStatement.Create(0,0);
-  AssertWrite('if then','if (a) {'+sLineBreak+'} else {'+sLineBreak+'}',S);
+  AssertWrite('if then',
+     'if (a) {'+sLineBreak
+    +'} else {'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListEmpty;
@@ -1407,7 +1456,7 @@ Var
 begin
 //  Writer.Options:=[woCompact,woUseUTF8];
   S:=TJSStatementList.Create(0,0);
-  AssertWrite('Statement list','{'+sLineBreak+'}'+sLineBreak,S);
+  AssertWrite('Statement list','{'+sLineBreak+'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListEmptyCompact;
@@ -1423,12 +1472,14 @@ end;
 Procedure TTestStatementWriter.TestStatementListOneStatement;
 Var
   S : TJSStatementList;
-
 begin
 //  Writer.Options:=[woCompact,woUseUTF8];
   S:=TJSStatementList.Create(0,0);
   S.A:=CreateAssignment(nil);
-  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'}'+sLineBreak,S);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListOneStatementCompact;
@@ -1452,7 +1503,11 @@ begin
   S:=TJSStatementList.Create(0,0);
   S.A:=CreateAssignment(nil);
   S.B:=CreateAssignment(nil);
-  AssertWrite('Statement list','{'+sLineBreak+'a = b;'+sLineBreak+'a = b;'+sLineBreak+'}'+sLineBreak,S);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'a = b;'+sLineBreak
+    +'}',S);
 end;
 
 Procedure TTestStatementWriter.TestStatementListTwoStatementsCompact;
@@ -1467,6 +1522,21 @@ begin
   AssertWrite('Statement list','{a=b; a=b}',S);
 end;
 
+procedure TTestStatementWriter.TestStatementListFor;
+Var
+  S : TJSStatementList;
+begin
+  // Writer.Options:=[woCompact,woUseUTF8];
+  S:=TJSStatementList.Create(0,0);
+  S.A:=TJSForStatement.Create(0,0);
+  TJSForStatement(S.A).Body:=TJSEmptyBlockStatement.Create(0,0);
+  AssertWrite('Statement list',
+     '{'+sLineBreak
+    +'for (; ; ) {'+sLineBreak
+    +'};'+sLineBreak
+    +'}',S);
+end;
+
 Procedure TTestStatementWriter.TestEmptyFunctionDef;
 
 Var
@@ -1476,7 +1546,9 @@ begin
   FD:=TJSFunctionDeclarationStatement.Create(0,0);
   FD.AFunction:=TJSFuncDef.Create;
   FD.AFunction.Name:='a';
-  AssertWrite('Empty function','function a() {'+sLineBreak+'}'+sLineBreak,FD);
+  AssertWrite('Empty function',
+     'function a() {'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestEmptyFunctionDefCompact;
@@ -1505,7 +1577,9 @@ begin
   FD.AFunction.Params.Add('c');
   FD.AFunction.Params.Add('d');
 
-  AssertWrite('Empty function, 3 params','function a(b, c, d) {'+sLineBreak+'}'+sLineBreak,FD);
+  AssertWrite('Empty function, 3 params',
+     'function a(b, c, d) {'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestFunctionDefParamsCompact;
@@ -1540,7 +1614,10 @@ begin
   R:=TJSReturnStatement.Create(0,0);
   R.Expr:=CreateLiteral(0);
   FD.AFunction.Body.A:=R;
-  AssertWrite('1 statement, ','function a() {'+sLineBreak+'  return 0;'+sLineBreak+'}'+sLineBreak,FD);
+  AssertWrite('1 statement, ',
+     'function a() {'+sLineBreak
+    +'  return 0;'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestFunctionDefBody1Compact;
@@ -1589,7 +1666,11 @@ begin
   L.A:=A;
   L.B:=R;
   FD.AFunction.Body.A:=L;
-  AssertWrite('Function, 2 statements','function a(b) {'+sLineBreak+'  b = (b * 10);'+sLineBreak+'  return b;'+sLineBreak+'}'+sLineBreak,FD);
+  AssertWrite('Function, 2 statements',
+     'function a(b) {'+sLineBreak
+    +'  b = b * 10;'+sLineBreak
+    +'  return b;'+sLineBreak
+    +'}',FD);
 end;
 
 Procedure TTestStatementWriter.TestFunctionDefBody2Compact;
@@ -1620,7 +1701,7 @@ begin
   L.A:=A;
   L.B:=R;
   FD.AFunction.Body.A:=L;
-  AssertWrite('Function, 2 statements, compact','function a(b) {b=(b*10); return b}',FD);
+  AssertWrite('Function, 2 statements, compact','function a(b) {b=b*10; return b}',FD);
 end;
 
 Procedure TTestStatementWriter.TestTryCatch;
@@ -1645,7 +1726,12 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BCatch:=A;
-  AssertWrite('Try catch','try {'+sLineBreak+'  b = (b * 10)'+sLineBreak+'}'+sLineBreak+'catch (e) {'+sLineBreak+'  b = 1'+sLineBreak+'}'+sLineBreak,T);
+  AssertWrite('Try catch',
+     'try {'+sLineBreak
+    +'  b = b * 10'+sLineBreak
+    +'} catch (e) {'+sLineBreak
+    +'  b = 1'+sLineBreak
+    +'}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryCatchCompact;
@@ -1670,7 +1756,7 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BCatch:=A;
-  AssertWrite('Try catch compact','try {b=(b*10)} catch (e) {b=1}',T);
+  AssertWrite('Try catch compact','try {b=b*10} catch (e) {b=1}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryFinally;
@@ -1695,7 +1781,12 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally ','try {'+sLineBreak+'  b = (b * 10)'+sLineBreak+'}'+sLineBreak+'finally {'+sLineBreak+'  b = 1'+sLineBreak+'}'+sLineBreak,T);
+  AssertWrite('Try finally ',
+    'try {'+sLineBreak
+   +'  b = b * 10'+sLineBreak
+   +'} finally {'+sLineBreak
+   +'  b = 1'+sLineBreak
+   +'}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryFinallyCompact;
@@ -1721,7 +1812,7 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally compact','try {b=(b*10)} finally {b=1}',T);
+  AssertWrite('Try finally compact','try {b=b*10} finally {b=1}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryCatchFinally;
@@ -1749,7 +1840,13 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally ','try {'+sLineBreak+'  b = (b * 10)'+sLineBreak+'}'+sLineBreak+'catch (e) {'+sLineBreak+'  b = 10'+sLineBreak+'}'+sLineBreak+'finally {'+sLineBreak+'  b = 1'+sLineBreak+'}'+sLineBreak,T);
+  AssertWrite('Try finally ',
+     'try {'+sLineBreak
+    +'  b = b * 10'+sLineBreak
+    +'} catch (e) {'+sLineBreak
+    +'  b = 10'+sLineBreak
+    +'} finally {'+sLineBreak
+    +'  b = 1'+sLineBreak+'}',T);
 end;
 
 Procedure TTestStatementWriter.TestTryCatchFinallyCompact;
@@ -1778,7 +1875,7 @@ begin
   A.LHS:=CreateIdent('b');
   A.Expr:=CreateLiteral(1);
   T.BFinally:=A;
-  AssertWrite('Try finally ','try {b=(b*10)} catch (e) {b=10} finally {b=1}',T);
+  AssertWrite('Try finally ','try {b=b*10} catch (e) {b=10} finally {b=1}',T);
 end;
 
 Procedure TTestStatementWriter.TestWith;
@@ -1799,7 +1896,7 @@ begin
   M.B:=CreateLiteral(10);
   A.Expr:=M;
   T.B:=A;
-  AssertWrite('With statement ','with (e)'+slineBreak+'  b = (b * 10)',T);
+  AssertWrite('With statement ','with (e)'+slineBreak+'  b = b * 10',T);
 end;
 
 Procedure TTestStatementWriter.TestWithCompact;
@@ -1820,7 +1917,7 @@ begin
   M.B:=CreateLiteral(10);
   A.Expr:=M;
   T.B:=A;
-  AssertWrite('With statement ','with (e) b=(b*10)',T);
+  AssertWrite('With statement ','with (e) b=b*10',T);
 end;
 
 Procedure TTestStatementWriter.TestSourceElements;
@@ -1847,7 +1944,7 @@ begin
   M.B:=CreateLiteral(2);
   A.Expr:=M;
   T.Statements.AddNode.Node:=A;
-  AssertWrite('Statement lists ','b = (b * 10);'+sLineBreak+'c = (c * 2);'+sLineBreak,T);
+  AssertWrite('Statement lists ','b = b * 10;'+sLineBreak+'c = c * 2;'+sLineBreak,T);
 end;
 
 Procedure TTestStatementWriter.TestSourceElementsCompact;
@@ -1874,7 +1971,7 @@ begin
   M.B:=CreateLiteral(2);
   A.Expr:=M;
   T.Statements.AddNode.Node:=A;
-  AssertWrite('Statement lists compact','b=(b*10); c=(c*2);',T);
+  AssertWrite('Statement lists compact','b=b*10; c=c*2;',T);
 end;
 
 { ---------------------------------------------------------------------
@@ -1939,7 +2036,7 @@ Var
 begin
   L:=TJSLiteral.Create(0,0,'');
   L.Value.AsString:='ab"cd';
-  AssertWrite('ab"cd','"ab\"cd"',L);
+  AssertWrite('ab"cd','''ab"cd''',L);
 end;
 
 Procedure TTestLiteralWriter.TestStringBackslash;
@@ -2035,7 +2132,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=1;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','['+sLineBreak+'1'+sLineBreak+']',L);
+  AssertWrite('Empty array ','[1]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayOneElementCompact;
@@ -2064,7 +2161,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=1;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','['+sLineBreak+'  1'+sLineBreak+']',L);
+  AssertWrite('Empty array ','[1]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayTwoElements;
@@ -2081,7 +2178,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=2;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','['+sLineBreak+'1,'+sLineBreak+'2'+sLineBreak+']',L);
+  AssertWrite('Empty array ','[1, 2]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayTwoElementsCompact;
@@ -2098,7 +2195,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=2;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','[1, 2]',L);
+  AssertWrite('Empty array ','[1,2]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayTwoElementsCompact2;
@@ -2115,7 +2212,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=2;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','[1, 2]',L);
+  AssertWrite('Empty array ','[1,2]',L);
 end;
 
 Procedure TTestLiteralWriter.TestArrayThreeElementsCompact;
@@ -2135,7 +2232,7 @@ begin
   I:=TJSLiteral.Create(0,0);
   I.Value.AsNumber:=3;
   L.Elements.AddElement.Expr:=I;
-  AssertWrite('Empty array ','[1, 2, 3]',L);
+  AssertWrite('Empty array ','[1,2,3]',L);
 end;
 
 Procedure TTestLiteralWriter.TestObjectEmpty;
@@ -2380,7 +2477,7 @@ Var
   S : UnicodeString;
 begin
   S:=FTextWriter.AsUnicodeString;
-  AssertEquals(Msg,Result,S);
+  AssertEquals(Msg,String(Result),String(S));
 end;
 
 Procedure TTestJSWriter.AssertWrite(Const Msg, Result: String;
@@ -2400,7 +2497,7 @@ end;
 Function TTestJSWriter.CreateIdent(Const AName: String): TJSPrimaryExpressionIdent;
 begin
   Result:=TJSPrimaryExpressionIdent.Create(0,0);
-  Result.Name:=AName;
+  Result.Name:=TJSString(AName);
 end;
 
 Function TTestJSWriter.CreateLiteral(Const AValue: TJSString): TJSLiteral;
@@ -2438,7 +2535,6 @@ end;
 
 
 Initialization
-
   RegisterTests([TTestTestJSWriter,TTestLiteralWriter,TTestExpressionWriter,TTestStatementWriter]);
 end.
 
diff --git a/packages/fcl-js/tests/testjs.lpi b/packages/fcl-js/tests/testjs.lpi
index 8f5b6bda2b..74764e0bb0 100644
--- a/packages/fcl-js/tests/testjs.lpi
+++ b/packages/fcl-js/tests/testjs.lpi
@@ -1,32 +1,21 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
+      <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
-      <ActiveWindowIndexAtStart Value="0"/>
+      <UseAppBundle Value="False"/>
     </General>
-    <VersionInfo>
-      <Language Value=""/>
-      <CharSet Value=""/>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestStatementWriter"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -34,260 +23,84 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="16">
+    <Units Count="13">
       <Unit0>
         <Filename Value="testjs.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjs"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="48" Y="3"/>
-        <UsageCount Value="201"/>
       </Unit0>
       <Unit1>
         <Filename Value="tcscanner.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcscanner"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="17" Y="22"/>
-        <UsageCount Value="201"/>
       </Unit1>
       <Unit2>
         <Filename Value="../src/jsbase.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jsbase"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="1" Y="12"/>
-        <UsageCount Value="200"/>
       </Unit2>
       <Unit3>
         <Filename Value="../src/jsparser.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jsparser"/>
-        <EditorIndex Value="3"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="67"/>
-        <CursorPos X="14" Y="85"/>
-        <UsageCount Value="201"/>
-        <Loaded Value="True"/>
       </Unit3>
       <Unit4>
         <Filename Value="../src/jsscanner.pp"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="JSScanner"/>
-        <EditorIndex Value="6"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="342"/>
-        <CursorPos X="76" Y="345"/>
-        <UsageCount Value="201"/>
-        <Loaded Value="True"/>
       </Unit4>
       <Unit5>
         <Filename Value="../src/jstree.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jstree"/>
-        <EditorIndex Value="5"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="739"/>
-        <CursorPos X="3" Y="757"/>
-        <UsageCount Value="200"/>
-        <Loaded Value="True"/>
       </Unit5>
       <Unit6>
         <Filename Value="tcparser.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcparser"/>
-        <EditorIndex Value="4"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1878"/>
-        <CursorPos X="3" Y="1883"/>
-        <UsageCount Value="201"/>
-        <Loaded Value="True"/>
       </Unit6>
       <Unit7>
         <Filename Value="../src/jswriter.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jswriter"/>
-        <EditorIndex Value="0"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="8"/>
-        <CursorPos X="28" Y="15"/>
-        <UsageCount Value="202"/>
-        <Loaded Value="True"/>
       </Unit7>
       <Unit8>
         <Filename Value="tctextwriter.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tctextwriter"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="4"/>
-        <CursorPos X="15" Y="22"/>
-        <UsageCount Value="201"/>
       </Unit8>
       <Unit9>
-        <Filename Value="../../../../../projects/lazarus/components/fpcunit/console/consoletestrunner.pas"/>
-        <UnitName Value="consoletestrunner"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="157"/>
-        <CursorPos X="1" Y="175"/>
-        <UsageCount Value="4"/>
+        <Filename Value="tcwriter.pp"/>
+        <IsPartOfProject Value="True"/>
       </Unit9>
       <Unit10>
-        <Filename Value="tcwriter.pp"/>
+        <Filename Value="../src/jstoken.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcwriter"/>
-        <IsVisibleTab Value="True"/>
-        <EditorIndex Value="2"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="668"/>
-        <CursorPos X="45" Y="698"/>
-        <UsageCount Value="220"/>
-        <Loaded Value="True"/>
       </Unit10>
       <Unit11>
-        <Filename Value="../../../../released/packages/fcl-json/src/fpjson.pp"/>
-        <UnitName Value="fpjson"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="558"/>
-        <CursorPos X="21" Y="580"/>
-        <UsageCount Value="61"/>
+        <Filename Value="tcsrcmap.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TCSrcMap"/>
       </Unit11>
       <Unit12>
-        <Filename Value="../src/jstoken.pp"/>
+        <Filename Value="../src/jssrcmap.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jstoken"/>
-        <EditorIndex Value="1"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="1"/>
-        <CursorPos X="18" Y="8"/>
-        <UsageCount Value="200"/>
-        <Loaded Value="True"/>
+        <UnitName Value="JSSrcMap"/>
       </Unit12>
-      <Unit13>
-        <Filename Value="../../../../released/packages/fcl-fpcunit/src/testregistry.pp"/>
-        <UnitName Value="testregistry"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="106"/>
-        <CursorPos X="22" Y="108"/>
-        <UsageCount Value="13"/>
-      </Unit13>
-      <Unit14>
-        <Filename Value="../../../rtl/tests/punit.pp"/>
-        <UnitName Value="punit"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="405"/>
-        <CursorPos X="41" Y="415"/>
-        <UsageCount Value="18"/>
-      </Unit14>
-      <Unit15>
-        <Filename Value="../../../../released/rtl/inc/mathh.inc"/>
-        <WindowIndex Value="1"/>
-        <TopLine Value="60"/>
-        <CursorPos X="14" Y="78"/>
-        <UsageCount Value="13"/>
-      </Unit15>
     </Units>
-    <JumpHistory Count="6" HistoryIndex="5">
-      <Position1>
-        <Filename Value="tcparser.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position1>
-      <Position2>
-        <Filename Value="tcparser.pp"/>
-        <Caret Line="1732" Column="55" TopLine="1713"/>
-      </Position2>
-      <Position3>
-        <Filename Value="tcparser.pp"/>
-        <Caret Line="1883" Column="3" TopLine="1878"/>
-      </Position3>
-      <Position4>
-        <Filename Value="tcwriter.pp"/>
-        <Caret Line="66" Column="43" TopLine="51"/>
-      </Position4>
-      <Position5>
-        <Filename Value="tcwriter.pp"/>
-        <Caret Line="76" Column="43" TopLine="48"/>
-      </Position5>
-      <Position6>
-        <Filename Value="tcwriter.pp"/>
-        <Caret Line="251" Column="31" TopLine="232"/>
-      </Position6>
-    </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="/home/michael/source/fcl-js/;..;../src"/>
+      <OtherUnitFiles Value="../src"/>
     </SearchPaths>
     <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
       <Optimizations>
         <OptimizationLevel Value="0"/>
       </Optimizations>
     </CodeGeneration>
-    <Linking>
-      <Debugging>
-        <UseHeaptrc Value="True"/>
-      </Debugging>
-    </Linking>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
-    <BreakPoints Count="7">
-      <Item1>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsGlobal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../jsscanner.pp"/>
-        <Line Value="717"/>
-      </Item1>
-      <Item2>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="tcparser.pp"/>
-        <Line Value="2086"/>
-      </Item2>
-      <Item3>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="tcparser.pp"/>
-        <Line Value="2566"/>
-      </Item3>
-      <Item4>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../src/jsparser.pp"/>
-        <Line Value="845"/>
-      </Item4>
-      <Item5>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../src/jsparser.pp"/>
-        <Line Value="754"/>
-      </Item5>
-      <Item6>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="../src/jsparser.pp"/>
-        <Line Value="1287"/>
-      </Item6>
-      <Item7>
-        <Kind Value="bpkSource"/>
-        <WatchScope Value="wpsLocal"/>
-        <WatchKind Value="wpkWrite"/>
-        <Source Value="tcparser.pp"/>
-        <Line Value="2253"/>
-      </Item7>
-    </BreakPoints>
     <Exceptions Count="3">
       <Item1>
         <Name Value="EAbort"/>
@@ -300,5 +113,4 @@
       </Item3>
     </Exceptions>
   </Debugging>
-  <EditorMacros Count="0"/>
 </CONFIG>
diff --git a/packages/fcl-js/tests/testjs.lpr b/packages/fcl-js/tests/testjs.lpr
index 9ad8bab29a..574e4a3ff8 100644
--- a/packages/fcl-js/tests/testjs.lpr
+++ b/packages/fcl-js/tests/testjs.lpr
@@ -3,8 +3,11 @@ program testjs;
 {$mode objfpc}{$H+}
 
 uses
-  cwstring,Classes, consoletestrunner, tcscanner, jsparser, jsscanner, jstree, jsbase,
-  tcparser, jswriter, tctextwriter, tcwriter, jstoken;
+  {$IFDEF Unix}
+  cwstring,
+  {$ENDIF}
+  Classes, consoletestrunner, tcscanner, jsparser, jsscanner, jstree, jsbase,
+  tcparser, jswriter, tcwriter, jstoken, JSSrcMap, TCSrcMap;
 
 var
   Application: TTestRunner;
diff --git a/packages/fcl-json/fpmake.pp b/packages/fcl-json/fpmake.pp
index 7676506179..2e298a7e03 100644
--- a/packages/fcl-json/fpmake.pp
+++ b/packages/fcl-json/fpmake.pp
@@ -31,31 +31,42 @@ begin
     P.SourcePath.Add('src');
 
     T:=P.Targets.AddUnit('fpjson.pp');
-      T.ResourceStrings:=true;
+    T.ResourceStrings:=true;
+
     T:=P.Targets.AddUnit('jsonconf.pp');
-      T.ResourceStrings:=true;
-      with T.Dependencies do
-        begin
-          AddUnit('fpjson');
-          AddUnit('jsonparser');
-        end;
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+     end;
+        
     T:=P.Targets.AddUnit('jsonparser.pp');
-      T.ResourceStrings:=true;
-      with T.Dependencies do
-        begin
-          AddUnit('fpjson');
-          AddUnit('jsonscanner');
-        end;
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonscanner');
+      end;
+        
     T:=P.Targets.AddUnit('jsonscanner.pp');
-      T.ResourceStrings:=true;
+    T.ResourceStrings:=true;
+    
     T:=P.Targets.AddUnit('fpjsonrtti.pp');
-      T.ResourceStrings:=true;
-      with T.Dependencies do
-        begin
-          AddUnit('fpjson');
-          AddUnit('jsonparser');
-        end;
-      T.ResourceStrings:=true;
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+      end;
+      
+    T:=P.Targets.AddUnit('fpjsontopas.pp');
+    T.ResourceStrings:=true;
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson');
+      AddUnit('jsonparser');
+      end;
 
     P.ExamplePath.Add('examples');
     T:=P.Targets.AddExampleProgram('confdemo.pp');
diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp
index c823a21181..88f4dc8c71 100644
--- a/packages/fcl-json/src/fpjson.pp
+++ b/packages/fcl-json/src/fpjson.pp
@@ -283,6 +283,8 @@ Type
     function GetAsJSON: TJSONStringType; override;
     function GetAsString: TJSONStringType; override;
     procedure SetAsString(const AValue: TJSONStringType); override;
+  Public
+    Class var StrictEscaping : Boolean;
   public
     Constructor Create(const AValue : TJSONStringType); reintroduce;
     Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
@@ -535,6 +537,12 @@ Type
     Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
     Function Find(Const AName : String) : TJSONData; overload;
     Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
+    function Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
+    function Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
     Function Get(Const AName : String) : Variant;
     Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
     Function Get(Const AName : String; ADefault : Integer) : Integer;
@@ -588,7 +596,7 @@ Type
 Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
 Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
 
-Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
+Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
 Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
 Function JSONTypeName(JSONType : TJSONType) : String;
 
@@ -599,10 +607,10 @@ Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
 Function CreateJSON(Data : Int64) : TJSONInt64Number;
 Function CreateJSON(Data : QWord) : TJSONQWordNumber;
 Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
-Function CreateJSON(Data : TJSONStringType) : TJSONString;
-Function CreateJSON(Data : TJSONUnicodeStringType) : TJSONString;
-Function CreateJSONArray(Data : Array of const) : TJSONArray;
-Function CreateJSONObject(Data : Array of const) : TJSONObject;
+Function CreateJSON(const Data : TJSONStringType) : TJSONString;
+Function CreateJSON(const Data : TJSONUnicodeStringType) : TJSONString;
+Function CreateJSONArray(const Data : Array of const) : TJSONArray;
+Function CreateJSONObject(const Data : Array of const) : TJSONObject;
 
 // These functions rely on a callback. If the callback is not set, they will raise an error.
 // When the jsonparser unit is included in the project, the callback is automatically set.
@@ -623,7 +631,6 @@ Resourcestring
   SErrCannotConvertFromObject = 'Cannot convert data from object value';
   SErrCannotConvertToObject = 'Cannot convert data to object value';
   SErrInvalidFloat = 'Invalid float value : %s';
-  SErrInvalidInteger = 'Invalid float value : %s';
   SErrCannotSetNotIsNull = 'IsNull cannot be set to False';
   SErrCannotAddArrayTwice = 'Adding an array object to an array twice is not allowed';
   SErrCannotAddObjectTwice = 'Adding an object to an array twice is not allowed';
@@ -663,7 +670,7 @@ begin
   Result:=DefaultJSONInstanceTypes[AType]
 end;
 
-function StringToJSONString(const S: TJSONStringType): TJSONStringType;
+function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
 
 Var
   I,J,L : Integer;
@@ -684,7 +691,10 @@ begin
       Result:=Result+Copy(S,J,I-J);
       Case C of
         '\' : Result:=Result+'\\';
-        '/' : Result:=Result+'\/';
+        '/' : if Strict then
+                Result:=Result+'\/'
+              else
+                Result:=Result+'/';
         '"' : Result:=Result+'\"';
         #8  : Result:=Result+'\b';
         #9  : Result:=Result+'\t';
@@ -783,31 +793,30 @@ begin
   Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
 end;
 
-function CreateJSON(Data: TJSONStringType): TJSONString;
+function CreateJSON(const Data: TJSONStringType): TJSONString;
 begin
   Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
 end;
 
-function CreateJSON(Data: TJSONUnicodeStringType): TJSONString;
+function CreateJSON(const Data: TJSONUnicodeStringType): TJSONString;
 begin
   Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
 end;
 
-function CreateJSONArray(Data: array of const): TJSONArray;
+function CreateJSONArray(const Data: array of const): TJSONArray;
 begin
   Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
 end;
 
-function CreateJSONObject(Data: array of const): TJSONObject;
+function CreateJSONObject(const Data: array of const): TJSONObject;
 begin
-  Result:=TJSONObjectCLass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
+  Result:=TJSONObjectClass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
 end;
 
 Var
   JPH : TJSONParserHandler;
 
-function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean
-  ): TJSONData;
+function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
 
 Var
   SS : TStringStream;
@@ -1074,7 +1083,7 @@ procedure TJSONData.DumpJSON(S: TStream);
   end;
 
 Var
-  I,C : Integer;
+  I: Integer;
   O : TJSONObject;
 
 begin
@@ -1088,7 +1097,7 @@ begin
         if (I>0) then
           W(',');
         W('"');
-        W(StringToJSONString(O.Names[i]));
+        W(StringToJSONString(O.Names[i],False));
         W('":');
         O.Items[I].DumpJSON(S);
         end;
@@ -1305,7 +1314,7 @@ end;
 
 function TJSONString.GetAsJSON: TJSONStringType;
 begin
-  Result:='"'+StringToJSONString(FValue)+'"';
+  Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
 end;
 
 function TJSONString.GetAsString: TJSONStringType;
@@ -2049,13 +2058,20 @@ function TJSONArray.GetAsJSON: TJSONStringType;
 Var
   I : Integer;
   Sep : String;
+  D : TJSONData;
+  V : TJSONStringType;
 
 begin
   Sep:=TJSONData.FElementSep;
   Result:='[';
   For I:=0 to Count-1 do
     begin
-    Result:=Result+Items[i].AsJSON;
+    D:=Items[i];
+    if D<>Nil then
+      V:=D.AsJSON
+    else
+      V:='null';
+    Result:=Result+V;
     If (I<Count-1) then
       Result:=Result+Sep;
     end;
@@ -2093,7 +2109,10 @@ begin
     begin
     if MultiLine then
       Result:=Result+Ind;
-    Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
+    if Items[i]=Nil then
+      Result:=Result+'null'
+    else
+      Result:=Result+Items[i].DoFormatJSON(Options,CurrentIndent+Indent,Indent);
     If (I<Count-1) then
       if MultiLine then
         Result:=Result+','
@@ -2671,6 +2690,8 @@ function TJSONObject.GetAsJSON: TJSONStringType;
 Var
   I : Integer;
   Sep : String;
+  V : TJSONStringType;
+  D : TJSONData;
 
 begin
   Sep:=TJSONData.FElementSep;
@@ -2679,7 +2700,12 @@ begin
     begin
     If (Result<>'') then
       Result:=Result+Sep;
-    Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+Items[I].AsJSON;
+    D:=Items[i];
+    if Assigned(D) then
+      V:=Items[I].AsJSON
+    else
+      V:='null';
+    Result:=Result+FElementStart+StringToJSONString(Names[i])+FElementEnd+V;
     end;
   If (Result<>'') then
     Result:=FObjStartSep+Result+FObjEndSep
@@ -2807,6 +2833,9 @@ Var
   S : TJSONStringType;
   MultiLine,UseQuotes, SkipWhiteSpace : Boolean;
   NSep,Sep,Ind : String;
+  V : TJSONStringType;
+  D : TJSONData;
+
 begin
   Result:='';
   UseQuotes:=Not (foDoNotQuoteMembers in options);
@@ -2833,7 +2862,12 @@ begin
     S:=StringToJSONString(Names[i]);
     If UseQuotes then
       S:='"'+S+'"';
-    Result:=Result+S+NSep+Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
+    D:=Items[i];
+    if D=Nil then
+      V:='null'
+    else
+      v:=Items[I].DoFormatJSON(Options,CurrentIndent,Indent);
+    Result:=Result+S+NSep+V;
     end;
   If (Result<>'') then
     begin
@@ -3127,6 +3161,87 @@ begin
     Result:=Nil;
 end;
 
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONData): boolean;
+begin
+  AValue := Find(key);
+  result := assigned(AValue);
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONObject): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  if assigned(v) then
+  begin
+    result := v.JSONType = jtObject;
+    if result then
+      AValue := TJSONObject(v);
+  end
+  else
+    result := false;
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONArray): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  if assigned(v) then
+  begin
+    result := v.JSONType = jtArray;
+    if result then
+      AValue := TJSONArray(v);
+  end
+  else
+    result := false;
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONString): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  if assigned(v) then
+  begin
+    result := v.JSONType = jtString;
+    if result then
+      AValue := TJSONString(v);
+  end
+  else
+    result := false;
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONBoolean): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  if assigned(v) then
+  begin
+    result := v.JSONType = jtBoolean;
+    if result then
+      AValue := TJSONBoolean(v);
+  end
+  else
+    result := false;
+end;
+
+function TJSONObject.Find(const key: TJSONStringType; out AValue: TJSONNumber): boolean;
+var
+  v: TJSONData;
+begin
+  v := Find(key);
+  if assigned(v) then
+  begin
+    result := v.JSONType = jtNumber;
+    if result then
+      AValue := TJSONNumber(v);
+  end
+  else
+    result := false;
+end;
+
 initialization
   // Need to force initialization;
   TJSONData.DetermineElementSeparators;
diff --git a/packages/fcl-json/src/fpjsonrtti.pp b/packages/fcl-json/src/fpjsonrtti.pp
index e5381e0760..633c0ae39b 100644
--- a/packages/fcl-json/src/fpjsonrtti.pp
+++ b/packages/fcl-json/src/fpjsonrtti.pp
@@ -28,7 +28,10 @@ Type
                        jsoDateTimeAsString,       // Format a TDateTime value as a string
                        jsoUseFormatString,        // Use FormatString when creating JSON strings.
                        jsoCheckEmptyDateTime,     // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
-                       jsoLegacyDateTime);         // Set this to enable old date/time formatting. Current behaviour is to save date/time as a ISO 9601 value.
+                       jsoLegacyDateTime,         // Set this to enable old date/time formatting. Current behaviour is to save date/time as a ISO 9601 value.
+                       jsoLowerPropertyNames,     // Set this to force lowercase names when streaming to JSON.
+                       jsoStreamTList             // Set this to assume that TList contains a list of TObjects. Use with care!
+                       );  
   TJSONStreamOptions = Set of TJSONStreamOption;
 
   TJSONFiler = Class(TComponent)
@@ -70,6 +73,8 @@ Type
     function StreamCollection(Const ACollection: TCollection): TJSONArray;
     // Stream an objectlist - always returns an array
     function StreamObjectList(Const AnObjectList: TObjectList): TJSONArray;
+    // Stream a List - always returns an array
+    function StreamTList(Const AList: TList): TJSONArray;
     // Stream a TStrings instance as an array
     function StreamTStringsArray(Const AStrings: TStrings): TJSONArray;
     // Stream a TStrings instance as an object
@@ -519,7 +524,7 @@ begin
     try
       For I:=0 to PIL.Count-1 do
         begin
-        J:=JSON.IndexOfName(Pil.Items[i]^.Name,FCaseInsensitive);
+        J:=JSON.IndexOfName(Pil.Items[i]^.Name,(jdoCaseInsensitive in Options));
         If (J<>-1) then
           RestoreProperty(AObject,PIL.Items[i],JSON.Items[J]);
         end;
@@ -741,6 +746,8 @@ begin
       Result.Add('Items',StreamCollection(TCollection(AObject)))
     else If AObject is TObjectList then
       Result.Add('Objects',StreamObjectList(TObjectList(AObject)))
+    else if (jsoStreamTlist in Options) and (AObject is TList) then
+      Result := TJSONObject(StreamTList(TList(AObject)))
     else
       begin
       PIL:=TPropInfoList.Create(AObject,tkProperties);
@@ -748,9 +755,13 @@ begin
         For I:=0 to PIL.Count-1 do
           begin
           PD:=StreamProperty(AObject,PIL.Items[i]);
-          If (PD<>Nil) then
+            If (PD<>Nil) then begin
+              if jsoLowerPropertyNames in Options then
+                Result.Add(LowerCase(PIL.Items[I]^.Name),PD)
+              else
             Result.Add(PIL.Items[I]^.Name,PD);
           end;
+          end;
       finally
         FReeAndNil(Pil);
       end;
@@ -896,6 +907,24 @@ begin
   end;
 end;
 
+function TJSONStreamer.StreamTList(const AList: TList): TJSONArray;
+var
+  I : Integer;
+  o : TJSONObject;
+begin
+  Result:=TJSONArray.Create;
+  try
+    for I:=0 to AList.Count-1 do begin
+      o := ObjectToJSON(TObject(AList.Items[i]));
+      if Assigned(o) then
+        Result.Add(o);
+    end;
+  except
+    FreeAndNil(Result);
+    Raise;
+  end;
+end;
+
 Function TJSONStreamer.StreamTStringsArray(Const AStrings : TStrings) : TJSONArray;
 
 Var
diff --git a/packages/fcl-json/src/fpjsontopas.pp b/packages/fcl-json/src/fpjsontopas.pp
new file mode 100644
index 0000000000..6396c1dbf9
--- /dev/null
+++ b/packages/fcl-json/src/fpjsontopas.pp
@@ -0,0 +1,1279 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by Michael Van Canneyt
+
+    Converter unit to convert JSON object to object pascal classes.
+
+    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 fpjsontopas;
+
+// TODO : Array of Array LoadFromJSON/SaveToJSON
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpjson, jsonparser;
+
+Type
+  EJSONToPascal = Class(EJSON);
+
+  { TPropertyMapItem }
+  TPropertyMapItem = Class(TCollectionItem)
+  private
+    FGenerated: Boolean;
+    FJSONType: TJSONType;
+    FParentTypeName: String;
+    FPath: String;
+    FPropertyName: String;
+    FSkipType: Boolean;
+    FTypeName: String;
+  Public
+    Procedure Assign(Source: TPersistent); override;
+    Property Generated : Boolean Read FGenerated;
+  Published
+    Property Path : String Read FPath Write FPath;
+    Property TypeName : String Read FTypeName Write FTypeName;
+    Property ParentTypeName : String Read FParentTypeName Write FParentTypeName;
+    Property PropertyName : String Read FPropertyName Write FPropertyName;
+    Property JSONType : TJSONType Read FJSONType write FJSONType;
+    // Set this to true if no class/array should be generated
+    Property SkipType : Boolean Read FSkipType Write FSkipType;
+  end;
+
+  TPropertyMap = Class(TCollection)
+  private
+    function GetM(Aindex : Integer): TPropertyMapItem;
+    procedure SetM(Aindex : Integer; AValue: TPropertyMapItem);
+  Public
+    Function AddPath(Const APath,ATypeName : String) : TPropertyMapItem;
+    Function IndexOfPath(Const APath : String) : Integer;
+    Function FindPath(Const APath : String) : TPropertyMapItem;
+    Property Map[Aindex : Integer] : TPropertyMapItem Read GetM Write SetM; Default;
+  end;
+
+  { TJSONToPascal }
+  TJSONToPascalOption = (jpoUseSetter,jpoGenerateLoad,jpoUnknownLoadPropsError,jpoDelphiJSON, jpoLoadCaseInsensitive,jpoGenerateSave);
+  TJSONToPascalOptions = set of TJSONToPascalOption;
+
+  TJSONToPascal = Class(TComponent)
+  private
+    FExtraUnitNames: String;
+    FFieldPrefix: String;
+    FIndent : String;
+    FActive : Boolean;
+    FCode : TStrings;
+    FDefaultParentName : String;
+    FDestUnitName : String;
+    FIndentSize : Integer;
+    FJSON : TJSONStringType;
+    FJSONData: TJSONData;
+    FJSONStream: TStream;
+    FObjectConstructorArguments: String;
+    FOptions: TJSONToPascalOptions;
+    FPropertyMap: TPropertyMap;
+    FPropertyTypeSuffix: String;
+    FinType : Boolean; //  State
+    procedure GenerateSaveFunctionForm(M: TPropertyMapItem);
+    function GetObjectConstructorArguments: String;
+    function JSONDataName: String;
+    procedure MaybeEmitType;
+    procedure SetActive(AValue: Boolean);
+    procedure SetCode(AValue: TStrings);
+    procedure SetJSON(AValue: TJSONStringType);
+    procedure SetPropertyMap(AValue: TPropertyMap);
+  Protected
+    Procedure AddSemiColonToLastLine;
+    Procedure Indent;
+    Procedure Undent;
+    Procedure AddLn(Const Line : String);
+    Procedure AddLn(Const Fmt : String; Const Args : Array of const);
+    Procedure AddIndented(Const Line : String);
+    Procedure AddIndented(Const Fmt : String; Const Args : Array of const);
+    Function CreatePropertyMap : TPropertyMap; virtual;
+    Function GetJSONData(Out FreeResult : Boolean) : TJSONData; virtual;
+    function IsDateTimeValue(const AValue: String): Boolean; virtual;
+    Function GetDefaultParentName : String;
+    function GetPropertyTypeName(const APath, AName: String; AValue: TJSONData): String; virtual;
+    function PathToTypeName(const APath: String): String; virtual;
+    function AddToPath(const APath, AName: String): String;
+    class function CleanPropertyName(const AName: String): string;
+    function GetPropertyName(const APath, AName: String): String;
+
+    // Called for each type
+    function  GenerateAssign(IM: TPropertyMapItem; AVarName, AJSONName: String ): String;
+    function  GenerateAssignDelphi(IM: TPropertyMapItem; AVarName, AJSONName: String; AddSemiColon : Boolean ): String;
+    procedure GenerateCreateArray(M: TPropertyMapItem);
+    procedure GenerateSaveArray(M: TPropertyMapItem);
+    procedure GenerateCreateObjectfpJSON(M: TPropertyMapItem);
+    procedure GenerateLoadJSONDelphi(M: TPropertyMapItem; J: TJSONObject);
+    procedure GenerateLoadJSONfpJSON(M: TPropertyMapItem; J: TJSONObject);
+    procedure GenerateSaveJSONDelphi(M: TPropertyMapItem; J: TJSONObject);
+    procedure GenerateSaveJSONfpJSON(M: TPropertyMapItem; J: TJSONObject);
+    Function  GenerateArrayDeclaration(M: TPropertyMapItem; J: TJSONArray) : Boolean; virtual;
+    procedure GenerateObjectDeclaration(M: TPropertyMapItem;  J: TJSONObject); virtual;
+    procedure GenerateArrayImplementation(M : TPropertyMapItem; J: TJSONArray); virtual;
+    procedure GenerateObjectImplementation(M : TPropertyMapItem; J: TJSONObject); virtual;
+    // Top level routines
+    Function  GetExtraUnitNames : String; virtual;
+    Procedure ClearGeneratedTypes;virtual;
+    Procedure GenerateInterfaceHeader;virtual;
+    procedure GenerateDeclaration(const APath : String; J: TJSONData);  virtual;
+    Procedure GenerateImplementationHeader;virtual;
+    Procedure GenerateImplementation(const APath: String; J: TJSONData); virtual;
+    Procedure GenerateImplementationEnd;virtual;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Execute;
+    // JSON Data to generate code from.
+    Property JSONData : TJSONData Read FJSONData Write FJSONData;
+    // JSON Data (in stream form) to generate code from. JSONData takes prioroty over this property.
+    Property JSONStream : TStream Read FJSONStream Write FJSONStream;
+  Published
+    // Setting this to true will call execute. Can be used to generate code in the IDE.
+    Property Active : Boolean Read FActive Write SetActive;
+    // Options to use.
+    Property Options : TJSONToPascalOptions Read FOptions Write FOptions;
+    // The JSON to use. JSONData/JSONStream take priority over this property.
+    Property JSON : TJSONStringType Read FJSON Write SetJSON;
+    // This string
+    Property Code : TStrings Read FCode Write SetCode;
+    // Type information for generated types. After Execute, this will contain generated/detected types for all properties.
+    Property PropertyMap : TPropertyMap Read FPropertyMap Write SetPropertyMap;
+    // Generated unit name.
+    Property DestUnitName : String Read FDestUnitName Write FDestUnitName;
+    // Default Parent class name when declaring objects. Can be overridden per property.
+    Property DefaultParentName: String Read FDefaultParentName Write FDefaultParentName;
+    // Indent size
+    Property IndentSize : Integer Read FIndentSize Write FIndentSize default 2;
+    // These units (comma separated list) will be added to the interface uses clause.
+    Property ExtraUnitNames : String Read FExtraUnitNames Write FExtraUnitNames;
+    // This will be suffixed to an object/array type name when the propert map is constructed.
+    Property PropertyTypeSuffix : String Read FPropertyTypeSuffix Write FPropertyTypeSuffix;
+    // First letter for field name.
+    Property FieldPrefix : String Read FFieldPrefix Write FFieldPrefix;
+    // What are the arguments to a constructor ? This property is inserted literally in the code between ().
+    Property ObjectConstructorArguments : String Read FObjectConstructorArguments Write FObjectConstructorArguments;
+  end;
+
+
+
+implementation
+
+{$IFDEF VER2_6_4}
+Const
+  StructuredJSONTypes  = [jtArray,jtObject];
+{$ENDIF}
+
+{ TPropertyMap }
+
+function TPropertyMap.GetM(Aindex : Integer): TPropertyMapItem;
+begin
+  Result:=Items[AIndex] as TPropertyMapItem;
+end;
+
+procedure TPropertyMap.SetM(Aindex : Integer; AValue: TPropertyMapItem);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TPropertyMap.AddPath(const APath, ATypeName: String): TPropertyMapItem;
+begin
+  Result:=Add as TPropertyMapItem;
+  Result.Path:=APath;
+  Result.TypeName:=ATypeName;
+end;
+
+function TPropertyMap.IndexOfPath(const APath: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (GetM(Result).Path<>APath) do
+    Dec(Result);
+end;
+
+function TPropertyMap.FindPath(const APath: String): TPropertyMapItem;
+
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfPath(APath);
+  If I=-1 then
+    Result:=Nil
+  else
+    Result:=GetM(I);
+end;
+
+{ TJSONToPascal }
+
+class function TJSONToPascal.CleanPropertyName(const AName: String): string;
+
+Const
+   KW=';absolute;and;array;asm;begin;case;const;constructor;destructor;div;do;'+
+       'downto;else;end;file;for;function;goto;if;implementation;in;inherited;'+
+       'inline;interface;label;mod;nil;not;object;of;on;operator;or;packed;'+
+       'procedure;program;record;reintroduce;repeat;self;set;shl;shr;string;then;'+
+       'to;type;unit;until;uses;var;while;with;xor;dispose;exit;false;new;true;'+
+       'as;class;dispinterface;except;exports;finalization;finally;initialization;'+
+       'inline;is;library;on;out;packed;property;raise;resourcestring;threadvar;try;'+
+       'private;published;length;setlength;';
+Var
+  I : Integer;
+
+begin
+  Result:=Aname;
+  For I:=Length(Result) downto 1 do
+    If Not ((Upcase(Result[i]) in ['_','A'..'Z'])
+             or ((I>1) and (Result[i] in (['0'..'9'])))) then
+     Delete(Result,i,1);
+  if Pos(';'+lowercase(Result)+';',KW)<>0 then
+   Result:='_'+Result
+end;
+
+procedure TJSONToPascal.SetActive(AValue: Boolean);
+begin
+  if (FActive=AValue) then Exit;
+  if AValue then
+    Execute;
+end;
+
+procedure TJSONToPascal.SetCode(AValue: TStrings);
+begin
+  if FCode=AValue then Exit;
+  FCode.Assign(AValue);
+end;
+
+procedure TJSONToPascal.SetJSON(AValue: TJSONStringType);
+begin
+  if FJSON=AValue then Exit;
+  FJSON:=AValue;
+end;
+
+procedure TJSONToPascal.SetPropertyMap(AValue: TPropertyMap);
+begin
+  if FPropertyMap=AValue then Exit;
+  FPropertyMap.Assign(AValue);
+end;
+
+procedure TJSONToPascal.AddSemiColonToLastLine;
+
+Var
+  I : Integer;
+
+begin
+  I:=FCode.Count-1;
+  FCode[I]:=FCode[I]+';'
+end;
+
+procedure TJSONToPascal.Indent;
+begin
+  FIndent:=Findent+StringOfChar(' ',FIndentSize);
+end;
+
+procedure TJSONToPascal.Undent;
+
+Var
+  L : Integer;
+
+begin
+  L:=Length(FIndent);
+  Dec(L,FIndentSize);
+  if L<0 then L:=0;
+  FIndent:=Copy(FIndent,1,L);
+end;
+
+procedure TJSONToPascal.AddLn(const Line: String);
+begin
+  FCode.Add(FIndent+Line);
+end;
+
+procedure TJSONToPascal.AddLn(const Fmt: String; const Args: array of const);
+begin
+  AddLn(Format(Fmt,Args));
+end;
+
+procedure TJSONToPascal.AddIndented(const Line: String);
+begin
+  Indent;
+  AddLn(Line);
+  Undent;
+end;
+
+procedure TJSONToPascal.AddIndented(const Fmt: String;
+  const Args: array of const);
+begin
+  Indent;
+  AddLn(Fmt,Args);
+  Undent;
+end;
+
+constructor TJSONToPascal.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FCode:=TStringList.Create;
+  FPropertyMap:=CreatePropertyMap;
+  FIndentSize:=2;
+  FFieldPrefix:='F';
+end;
+
+destructor TJSONToPascal.Destroy;
+begin
+  FreeAndNil(FCode);
+  FreeAndNil(FPropertyMap);
+  inherited Destroy;
+end;
+
+function TJSONToPascal.CreatePropertyMap: TPropertyMap;
+
+begin
+  Result:=TPropertyMap.Create(TPropertyMapItem);
+end;
+
+function TJSONToPascal.GetJSONData(out FreeResult: Boolean): TJSONData;
+
+Var
+  D : TJSONData;
+
+begin
+  FreeResult:=not Assigned(FJSONData);
+  if Not FreeResult then
+    Exit(FJSONData);
+  Result:=Nil;
+  If Assigned(JSONStream) then
+    D:=GetJSON(JSONStream)
+  else if (JSON<>'') then
+    D:=GetJSON(JSON)
+  else
+    Raise EJSONToPascal.Create('Need one of JSONObject, JSONStream or JSON to be set');
+  If Not (D.JSONType in [jtObject,jtArray]) then
+    begin
+    FreeAndNil(D);
+    Raise EJSONToPascal.Create('Provided JSONStream or JSON is not a JSON Object or array');
+    end;
+  Result:=D;
+end;
+
+function TJSONToPascal.GetExtraUnitNames: String;
+begin
+  Result:=FExtraUnitNames;
+end;
+
+procedure TJSONToPascal.ClearGeneratedTypes;
+
+Var
+  I : integer;
+
+begin
+  For i:=FPropertyMap.Count-1 downto 0 do
+    if FPropertyMap[i].Generated then
+      FPropertyMap.Delete(I);
+end;
+
+procedure TJSONToPascal.GenerateInterfaceHeader;
+
+Var
+  S: string;
+begin
+  AddLn('unit %s;',[DestUnitName]);
+  Addln('');
+  Addln('interface');
+  Addln('');
+  S:=Trim(GetExtraUnitNames);
+  if (S<>'') and (S[1]<>',') then
+    S:=', '+S;
+  if jpoDelphiJSON in Options then
+    S:='JSON'+S
+  else
+    S:='fpJSON'+S;
+  S:='SysUtils, Classes, '+S;
+  Addln('uses %s;',[s]);
+  Addln('');
+end;
+
+
+function TJSONToPascal.PathToTypeName(const APath: String): String;
+
+begin
+  Result:=StringReplace(Apath,'.','',[rfReplaceAll]);
+  Result:=StringReplace(Result,'[0]','Item',[rfReplaceAll]);
+  Result:=StringReplace(Result,'[]','Item',[rfReplaceAll]);
+  if Result='' then
+    Result:='TMyObject'
+  else
+    Result:='T'+Result+PropertyTypeSuffix;
+end;
+
+function TJSONToPascal.IsDateTimeValue(const AValue: String): Boolean;
+
+Var
+  D : TDateTime;
+
+begin
+  Result:=TryStrToDate(AValue,D);
+  if Not Result then
+    Result:=TryStrToTime(AValue,D);
+  if Not Result then
+    Result:=TryStrToDateTime(AValue,D);
+end;
+
+function TJSONToPascal.GetDefaultParentName: String;
+begin
+  Result:=FDefaultParentName;
+  if Result='' then
+    Result:='TObject';
+end;
+
+Resourcestring
+  SErrCannotDetermineType = 'Cannot determine type for %s : Not in type map';
+  SErrCannotDeterminePropertyType = 'Cannot determine property type for %s';
+  SErrCannotGenerateArrayDeclaration = 'Cannot generate array declaration from empty array at "%s"';
+
+function TJSONToPascal.GetPropertyTypeName(const APath, AName: String; AValue: TJSONData): String;
+
+Var
+  M : TPropertyMapItem;
+  IP : String;
+
+begin
+  Case AValue.JSONType of
+    jtBoolean : Result:='Boolean';
+    jtNull : Result:='Boolean';
+    jtNumber :
+      Case TJSONNumber(AValue).NumberType of
+        ntFloat : Result:='Double';
+        ntInt64 : Result:='Int64';
+        ntInteger : Result:='Integer';
+      end;
+    jtString :
+      if not IsDateTimeValue(AValue.AsString) then
+        Result:='String'
+      else
+        Result:='TDateTime';
+    jtArray:
+      begin
+      IP:=AddToPath(APath,AName);
+      M:=FPropertyMap.FindPath(IP);
+      If (M=Nil) then
+        raise EJSONToPascal.CreateFmt(SErrCannotDetermineType, [IP]);
+      if M.TypeName='' then
+        M.TypeName:='Array of '+GetPropertyTypeName(AddToPath(APath,AName)+'[0]','Item',TJSONArray(AValue)[0]);
+      Result:=M.TypeName;
+      end;
+    jtObject :
+      begin
+      M:=FPropertyMap.FindPath(AddToPath(APath,AName));
+      If (M=Nil) then // Can happen in case of [ [ {} ] ]
+        M:=FPropertyMap.AddPath(AddToPath(APath,AName),'');
+//        Raise EJSONToPascal.CreateFmt('Cannot determine type for %s.%s : Not in type map',[APath,AName]);
+      if M.TypeName='' then
+        M.TypeName:=PathToTypeName(AddToPath(APath,AName));
+      if M.ParentTypeName='' then
+         M.ParentTypeName:=GetDefaultParentName;
+      Result:=M.TypeName;
+      end;
+  end;
+end;
+
+function TJSONToPascal.GetPropertyName(const APath, AName: String): String;
+
+begin
+  Result:=CleanPropertyName(AName);
+end;
+
+function TJSONToPascal.JSONDataName: String;
+
+begin
+  if jpoDelphiJSON in options then
+    Result:='TJSONValue'
+  else
+    Result:='TJSONData';
+end;
+
+function TJSONToPascal.GenerateArrayDeclaration(M: TPropertyMapItem;
+  J: TJSONArray): Boolean;
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+  B : Boolean;
+
+begin
+  Result:=False;
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('%s = Array of %s;',[M.TypeName,IM.TypeName]);
+  B:=([jpoGenerateLoad,jpoGenerateSave] * options)<>[];
+  if B then
+    begin
+    Undent;
+    AddLn('');
+    end;
+  if jpoGenerateLoad in options then
+    AddLn('Function Create%s(AJSON : %s) : %s;',[M.TypeName,JSONDataName,M.TypeName]);
+  if jpoGenerateSave in options then
+    begin
+    AddLn('Procedure Save%sToJSON(AnArray : %s; AJSONArray : TJSONArray); overload;',[M.TypeName,M.TypeName]);
+    AddLn('Function Save%sToJSON(AnArray : %s) : TJSONArray; overload;',[M.TypeName,M.TypeName]);
+    end;
+  AddLn('');
+  if B then
+    begin
+    Indent;
+    FinType:=False;
+    Result:=True;
+    end;
+end;
+
+procedure TJSONToPascal.GenerateObjectDeclaration(M : TPropertyMapItem; J: TJSONObject);
+
+Var
+  E : TJSONEnum;
+  IM :  TPropertyMapItem;
+  IP, FRN,FWN : String;
+  HaveObj : Boolean;
+
+begin
+  HaveObj:=False;
+  Addln('');
+  AddLn('{ -----------------------------------------------------------------------');
+  Addln('  '+M.TypeName);
+  AddLn('  -----------------------------------------------------------------------}');
+  Addln('');
+  AddLn('%s = class(%s)',[M.TypeName,M.ParentTypeName]);
+  Addln('Private');
+  Indent;
+  For E in J do
+    begin
+    IM:=FPropertyMap.FindPath(AddToPath(M.Path,E.Key));
+    If IM=Nil then
+      begin
+      IM:=FPropertyMap.Add as TPropertyMapItem;
+      IM.Path:=AddToPath(M.Path,E.Key);
+      IM.FGenerated:=True;
+      end;
+    if IM.TypeName='' then
+      IM.TypeName:=GetPropertyTypeName(M.Path,E.Key,E.Value);
+    if IM.PropertyName='' then
+      IM.PropertyName:=GetPropertyName(M.Path,E.Key);
+    IM.JSONType:=E.Value.JSONtype;
+    AddLn('F%s : %s;',[IM.PropertyName,IM.TypeName]);
+    HaveObj:=HaveObj or (IM.JSONType=jtObject);
+    end;
+  Undent;
+  if jpoUseSetter in Options then
+    begin
+    Addln('Protected');
+    Indent;
+    For E in J do
+      begin
+      IM:=FPropertyMap.FindPath(AddToPath(M.Path,E.Key));
+      If IM=Nil then
+        raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [AddToPath(M.Path, E.Key)]);
+      FRN:=FieldPrefix+IM.PropertyName;
+      AddLn('Procedure Set%s(AValue : %s); virtual;',[IM.PropertyName,IM.TypeName]);
+      end;
+    Undent;
+    end;
+  Addln('Public');
+  Indent;
+  if HaveObj then
+    AddLn('Destructor Destroy; override;');
+  if jpoGenerateLoad in options then
+    begin
+    AddLn('Constructor CreateFromJSON(AJSON : %s); virtual;',[JSONDataName]);
+    AddLn('Procedure LoadFromJSON(AJSON : %s); virtual;',[JSONDataName]);
+    end;
+  if jpoGenerateSave in options then
+    begin
+    AddLn('Function SaveToJSON : TJSONObject; overload;');
+    AddLn('Procedure SaveToJSON(AJSON : TJSONObject); overload; virtual;');
+    end;
+
+  For E in J do
+    begin
+    IP:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(IP);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [IP]);
+    FRN:=FieldPrefix+IM.PropertyName;
+    if jpoUseSetter in Options then
+      FWN:='Set'+IM.PropertyName
+    else
+      FWN:=FRN;
+    AddLn('Property %s : %s Read %s Write %s;',[IM.PropertyName,IM.TypeName,FRN, FWN]);
+    end;
+  Undent;
+  AddLn('end;');
+end;
+
+function TJSONToPascal.AddToPath(const APath, AName: String): String;
+
+begin
+  Result:=APath;
+  if (AName<>'') then
+    begin
+    if (Result<>'') and (AName[1]<>'[') then
+      Result:=Result+'.';
+    Result:=Result+AName;
+    end;
+end;
+
+procedure TJSONToPascal.MaybeEmitType;
+
+begin
+  if FinType then exit;
+  Undent;
+  AddLn('Type');
+  Indent;
+  FinType:=True;
+end;
+
+procedure TJSONToPascal.GenerateDeclaration(const APath: String;J: TJSONData);
+
+Var
+  M :  TPropertyMapItem;
+  O : TJSONEnum;
+  IP : String;
+
+begin
+  AddLn('');
+  MaybeEmitType;
+  M:=FPropertyMap.FindPath(APath);
+  If M=Nil then
+    begin
+    M:=FPropertyMap.Add as TPropertyMapItem;
+    M.Path:=APath;
+    M.FGenerated:=True;
+    end
+  else if M.SkipType then
+    exit;
+  if (M.TypeName='') then
+    if J.JSONType in StructuredJSONtypes then
+      M.TypeName:=PathToTypeName(APath)
+    else
+      M.TypeName:=GetPropertyTypeName(APath,'',J);
+  M.JSONType:=J.JSONType;
+  if J is TJSONArray then
+    begin
+    M.ParentTypeName:='';
+    if J.Count=0 then
+      raise EJSONToPascal.CreateFmt(SErrCannotGenerateArrayDeclaration, [APath]);
+    IP:=AddToPath(M.Path,'[0]');
+    GenerateDeclaration(IP,J.Items[0]);
+    MaybeEmitType;
+    GenerateArrayDeclaration(M,TJSONarray(J));
+    end
+  else if J is TJSONObject then
+    begin
+    For O in TJSONOBject(J) do
+      begin
+      IP:=AddToPath(APath,O.Key);
+      GenerateDeclaration(IP,O.Value);
+      end;
+    M.ParentTypeName:=GetDefaultParentName;
+    MaybeEmitType;
+    GenerateObjectDeclaration(M,TJSONObject(J));
+    end;
+end;
+
+procedure TJSONToPascal.GenerateImplementationHeader;
+begin
+  Addln('');
+  Addln('implementation');
+  Addln('');
+end;
+
+procedure TJSONToPascal.GenerateArrayImplementation(M : TPropertyMapItem; J: TJSONArray);
+
+Var
+  IM : TPropertyMapItem;
+  P : String;
+
+begin
+  P:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(P);
+  if J.Items[0] is TJSONObject then
+    GenerateObjectImplementation(IM,J.Items[0] as TJSONObject)
+  else if J.Items[0] is TJSONArray then
+    GenerateArrayImplementation(IM,J.Items[0] as TJSONArray);
+  if jpoGenerateLoad in Options then
+    GenerateCreateArray(M);
+  if jpoGenerateSave in Options then
+    GenerateSaveArray(M)
+  // Do nothing yet
+end;
+
+procedure TJSONToPascal.GenerateCreateArray(M : TPropertyMapItem);
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+
+begin
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('');
+  AddLn('Function Create%s(AJSON : %s) : %s;',[M.TypeName,JSONDataName,M.TypeName]);
+  AddLn('');
+  AddLn('var');
+  AddIndented('I : integer;');
+  if (jpoDelphiJSON in Options) then
+    AddIndented('A : TJSONArray;');
+  AddLn('');
+  AddLn('begin');
+  Indent;
+  if not (jpoDelphiJSON in Options) then
+    begin
+    AddLn('SetLength(Result,AJSON.Count);');
+    AddLn('For I:=0 to AJSON.Count-1 do');
+    AddIndented(GenerateAssign(IM,'Result[i]','AJSON.Items[i]'));
+    end
+  else
+    begin
+    AddLn('A:=AJSON as TJSONArray;');
+    AddLn('SetLength(Result,A.Count);');
+    AddLn('For I:=0 to A.Count-1 do');
+    AddIndented(GenerateAssignDelphi(IM,'Result[i]','A.Items[i]',True));
+    end;
+  Undent;
+  Addln('End;');
+  AddLn('');
+end;
+
+procedure TJSONToPascal.GenerateSaveArray(M : TPropertyMapItem);
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+
+begin
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('');
+  AddLn('Function Save%sToJSON(AnArray : %s) : TJSONArray;',[M.TypeName,M.TypeName]);
+  AddLn('begin');
+  Indent;
+  Addln('Result:=TJSONArray.Create;');
+  Addln('Try');
+  AddIndented('Save%sToJSON(AnArray,Result);',[M.TypeName]);
+  Addln('Except');
+  Indent;
+  Addln('FreeAndNil(Result);');
+  Addln('Raise;');
+  Undent;
+  Addln('end;');
+  Undent;
+  Addln('end;');
+  AddLn('');
+  AddLn('');
+  AddLn('Procedure Save%sToJSON(AnArray : %s; AJSONArray : TJSONArray);',[M.TypeName,M.TypeName]);
+  AddLn('');
+  AddLn('var');
+  AddIndented('I : integer;');
+  AddLn('');
+  AddLn('begin');
+  Indent;
+  AddLn('For I:=0 to Length(AnArray)-1 do');
+  Case IM.JSONType of
+    jtObject : AddIndented('AJSONArray.Add(AnArray[i].SaveToJSON);');
+    jtArray :  AddIndented('AJSONArray.Add(Save%sToJSON(AnArray[i]));',[IM.TypeName]);
+  else
+    AddIndented('AJSONArray.Add(AnArray[i]);');
+  end;
+  Undent;
+  Addln('end;');
+  AddLn('');
+end;
+
+function TJSONToPascal.GetObjectConstructorArguments: String;
+
+begin
+  Result:=ObjectConstructorArguments
+end;
+
+procedure TJSONToPascal.GenerateCreateObjectfpJSON(M : TPropertyMapItem);
+
+Var
+  IP : String;
+  IM : TPropertyMapItem;
+
+begin
+  IP:=AddToPath(M.Path,'[0]');
+  IM:=FPropertyMap.FindPath(IP);
+  AddLn('');
+  Indent;
+  AddLn('Function CreateObject%s(AnObject : TJSONData) : %s;',[M.TypeName,M.TypeName]);
+  AddLn('');
+  AddLn('begin');
+  Indent;
+  AddLn('Result:='+M.TypeName+'.Create('+GetObjectConstructorArguments+');');
+  AddLn('Result.LoadFromJSON(AnObject);');
+  Undent;
+  Addln('End;');
+  Undent;
+  AddLn('');
+end;
+
+procedure TJSONToPascal.GenerateLoadJSONDelphi(M: TPropertyMapItem;
+  J: TJSONObject);
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  P,K : String;
+  SElse : String;
+
+begin
+  AddLn('Procedure %s.LoadFromJSON(AJSON : TJSONValue);',[M.TypeName]);
+  Addln('');
+  Addln('var');
+  AddIndented('P : TJSONPair;');
+  AddIndented('O : TJSONObject;');
+  AddIndented('PN : String;');
+  Addln('');
+  Addln('begin');
+  Indent;
+  if (jpoUnknownLoadPropsError in options) then
+    begin
+    Addln('if not (AJSON is TJSONObject) then');
+    AddIndented('Raise EJSONException.CreateFmt(''"%s" : Cannot load from : "%s"'',[ClassName,AJSON.ClassName]);');
+    end
+  else
+    Addln('if not (AJSON is TJSONObject) then exit;');
+  Addln('O:=AJSON as TJSONObject;');
+  Addln('for P in O do');
+  Indent;
+  Addln('begin');
+  if jpoLoadCaseInsensitive in Options then
+    Addln('PN:=LowerCase(P.JSONString.Value);')
+  else
+    Addln('PN:=P.JSONString.Value;');
+  SElse:='';
+  For E in J do
+    begin
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    K:=E.Key;
+    If jpoLoadCaseInsensitive in Options then
+      K:=LowerCase(K);
+    Addln(SElse+'If (PN=''%s'') then',[K]);
+    IM.JSONType:=E.Value.JSONType;
+    AddIndented(GenerateAssignDelphi(IM,IM.PropertyName,'P.JSONValue',False));
+    if SElse='' then
+      SElse:='else '
+    end;
+  if (jpoUnknownLoadPropsError in options) then
+    begin
+    Addln('else');
+    AddIndented('Raise EJSONException.CreateFmt(''"%s" : Unknown property : "%s"'',[ClassName,PN]);');
+    end
+  else
+    AddSemiColonToLastLine;
+  Addln('end;'); // For loop
+  Undent;
+  Undent;
+  Addln('end;');
+end;
+
+function TJSONToPascal.GenerateAssign(IM: TPropertyMapItem; AVarName, AJSONName: String): String;
+
+Var
+  T : String;
+  C : Boolean;
+
+begin
+  T:='';
+  Case LowerCase(IM.TypeName) of
+    'boolean' : T:='AsBoolean';
+    'string'  : T:='AsString';
+    'double'  : T:='AsFloat';
+    'integer' : T:='AsInteger';
+    'int64'   : T:='AsInt64';
+    'qword'   : T:='AsQWord';
+  else
+    if IM.JSONType=jtArray then
+      Result:=Format('%s:=Create%s(%s);',[AVarName,IM.TypeName,AJSONName])
+    else if IM.JSONType=jtObject then
+      Result:=Format('%s:=%s.CreateFromJSON(%s);',[AVarName,IM.TypeName,AJSONName])
+    else
+      Result:=Format('Raise EJSON.CreateFmt(''"%%s": Cannot handle property of type "%%s"''),[ClassName,''%s'']);',[IM.TypeName]);
+  end;
+  if T<>'' then
+    Result:=Format('%s:=%s.%s;',[AVarName,AJSONName,T]);
+end;
+
+function TJSONToPascal.GenerateAssignDelphi(IM: TPropertyMapItem; AVarName,
+  AJSONName: String; AddSemiColon: Boolean): String;
+
+Var
+  T : String;
+
+begin
+  T:='';
+  Case LowerCase(IM.TypeName) of
+    'boolean' : T:='Boolean';
+    'string'  : T:='String';
+    'double'  : T:='Double';
+    'integer' : T:='Integer';
+    'int64'   : T:='Int64';
+    'qword'   : T:='Int64';
+  else
+    if IM.JSONType=jtArray then
+      Result:=Format('%s:=Create%s(%s)',[AVarName,IM.TypeName,AJSONName])
+    else if IM.JSONType=jtObject then
+      Result:=Format('%s:=%s.CreateFromJSON(%s)',[AVarName,IM.TypeName,AJSONName])
+    else
+      Result:=Format('Raise EJSON.CreateFmt(''"%%s": Cannot handle property of type "%%s"''),[ClassName,''%s'']);',[IM.TypeName]);
+  end;
+  if T<>'' then
+    Result:=Format('%s:=%s.GetValue<%s>',[AVarName,AJSONName,T]);
+  If AddSemicolon then
+    Result:=Result+';'
+end;
+
+procedure TJSONToPascal.GenerateLoadJSONfpJSON(M : TPropertyMapItem; J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  P : String;
+
+begin
+  AddLn('Procedure %s.LoadFromJSON(AJSON : TJSONData);',[M.TypeName]);
+  Addln('');
+  Addln('var');
+  AddIndented('E : TJSONEnum;');
+  Addln('');
+  Addln('begin');
+  Indent;
+  Addln('for E in AJSON do');
+  Indent;
+  Addln('begin');
+  if jpoLoadCaseInsensitive in Options then
+    Addln('case lowercase(E.Key) of')
+  else
+    Addln('case E.Key of');
+  For E in J do
+    begin
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    if jpoLoadCaseInsensitive in Options then
+      Addln('''%s'':',[LowerCase(E.Key)])
+    else
+      Addln('''%s'':',[E.Key]);
+    IM.JSONType:=E.Value.JSONType;
+    AddIndented(GenerateAssign(IM,IM.PropertyName,'E.Value'));
+    end;
+  if (jpoUnknownLoadPropsError in options) then
+    begin
+    Addln('else');
+    AddIndented('Raise EJSON.CreateFmt(''"%s" : Unknown property : "%s"'',[ClassName,E.Key]);');
+    end;
+  Addln('end;'); // Case
+  Addln('end;'); // For loop
+  Undent;
+  Undent;
+  Addln('end;');
+end;
+
+procedure TJSONToPascal.GenerateSaveFunctionForm(M: TPropertyMapItem);
+
+begin
+  AddLn('Function  %s.SaveToJSON : TJSONObject;',[M.TypeName]);
+  AddLn('begin');
+  Indent;
+  AddLn('Result:=TJSONObject.Create;');
+  AddLn('Try');
+  AddIndented('SaveToJSON(Result);');
+  AddLn('except');
+  Indent;
+    Addln('FreeAndNil(Result);');
+    AddLn('Raise;');
+  Undent;
+  AddLn('end;');
+  Undent;
+  AddLn('end;');
+  AddLn('');
+end;
+
+procedure TJSONToPascal.GenerateSaveJSONDelphi(M: TPropertyMapItem;  J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  T,P : String;
+  B,C : Boolean; // B : Indent called. C : Need to create value
+
+begin
+  GenerateSaveFunctionForm(M);
+  AddLn('');
+  AddLn('Procedure %s.SaveToJSON(AJSON : TJSONObject);',[M.TypeName]);
+  Addln('');
+  Addln('begin');
+  Indent;
+  For E in J do
+    begin
+    B:=False;
+    C:=True;
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    Case LowerCase(IM.TypeName) of
+      'boolean' : T:='Boolean';
+      'string'  : T:='String';
+      'double'  : T:='Number';
+      'integer' : T:='Number';
+      'int64'   : T:='Number';
+      'qword'   : T:='Number';
+    else
+      C:=False;
+      if IM.JSONType=jtArray then
+        T:=Format('Save%sToJSON(%s)',[IM.TypeName,IM.PropertyName])
+      else if IM.JSONType=jtObject then
+        begin
+        Addln('If Assigned(%s) then',[IM.PropertyName]);
+        T:=Format('%s.SaveToJSON',[IM.PropertyName]);
+        B:=True; // Indent called
+        Indent;
+        end;
+    end;
+    if C then
+      T:='TJSON'+T+'.Create('+IM.PropertyName+')';
+    if (T<>'') then
+      AddLn('AJSON.AddPair(''%s'',%s);',[E.Key,T]);
+    if B then
+      Undent;
+    end;
+  Undent;
+  Addln('end;');
+end;
+
+procedure TJSONToPascal.GenerateSaveJSONfpJSON(M: TPropertyMapItem; J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  T,P : String;
+  B : Boolean;
+
+begin
+  GenerateSaveFunctionForm(M);
+  AddLn('');
+  AddLn('Procedure %s.SaveToJSON(AJSON : TJSONObject);',[M.TypeName]);
+  Addln('');
+  Addln('begin');
+  Indent;
+  For E in J do
+    begin
+    B:=False;
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM=Nil then
+      raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+    Case LowerCase(IM.TypeName) of
+      'boolean' : T:=IM.PropertyName;
+      'string'  : T:=IM.PropertyName;
+      'double'  : T:=IM.PropertyName;
+      'integer' : T:=IM.PropertyName;
+      'int64'   : T:=IM.PropertyName;
+      'qword'   : T:=IM.PropertyName;
+    else
+      if IM.JSONType=jtArray then
+        t:=Format('Save%sToJSON(%s)',[IM.TypeName,IM.PropertyName])
+      else if IM.JSONType=jtObject then
+        begin
+        Addln('If Assigned(%s) then',[IM.PropertyName]);
+        T:=Format('%s.SaveToJSON',[IM.PropertyName]);
+        B:=True; // Indent called
+        Indent;
+        end;
+    end;
+    if (T<>'') then
+      AddLn('AJSON.Add(''%s'',%s);',[E.Key,T]);
+    if B then
+      Undent;
+    end;
+  Undent;
+  Addln('end;');
+end;
+
+procedure TJSONToPascal.GenerateObjectImplementation(M : TPropertyMapItem; J: TJSONObject);
+
+Var
+  IM :  TPropertyMapItem;
+  E : TJSONEnum;
+  P,FRN : String;
+  HaveObj : Boolean;
+
+begin
+  HaveObj:=False;
+  For E in J do
+    begin
+    P:=AddToPath(M.Path,E.Key);
+    IM:=FPropertyMap.FindPath(P);
+    If IM<>Nil then
+      HaveObj:=HaveObj or (IM.JSONType=jtObject);
+    end;
+  Addln('');
+  AddLn('{ -----------------------------------------------------------------------');
+  Addln('  '+M.TypeName);
+  AddLn('  -----------------------------------------------------------------------}');
+  Addln('');
+  if HaveObj then
+    begin
+    AddLn('Destructor %s.Destroy;',[M.TypeName]);
+    Addln('');
+    Addln('begin');
+    Indent;
+    For E in J do
+      begin
+      P:=AddToPath(M.Path,E.Key);
+      IM:=FPropertyMap.FindPath(P);
+      If (IM<>Nil) and (IM.JSONType=jtObject) then
+        AddLn('FreeAndNil('+FieldPrefix+IM.PropertyName+');');
+      end;
+    Addln('inherited;');
+    Undent;
+    Addln('end;');
+    Addln('');
+    end;
+  Addln('');
+  if jpoUseSetter in Options then
+    For E in J do
+      begin
+      P:=AddToPath(M.Path,E.Key);
+      IM:=FPropertyMap.FindPath(P);
+      If IM=Nil then
+        raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]);
+      FRN:=FieldPrefix+IM.PropertyName;
+      AddLn('Procedure %s.Set%s(AValue : %s);',[M.TypeName,IM.PropertyName,IM.TypeName]);
+      Addln('');
+      Addln('begin');
+      Indent;
+      AddLn('if ('+FieldPrefix+IM.PropertyName+'=AValue) then exit;');
+      If IM.JSONType=jtObject then
+        AddLn('FreeAndNil('+FieldPrefix+IM.PropertyName+');');
+      AddLn(FieldPrefix+IM.PropertyName+':=AValue;');
+      Undent;
+      Addln('end;');
+      Addln('');
+      end;
+  if jpoGenerateLoad in Options then
+    begin
+    AddLn('Constructor %s.CreateFromJSON(AJSON : %s);',[M.TypeName,JSONDataName]);
+    Addln('');
+    Addln('begin');
+    Indent;
+    AddLn('Create(%s);',[GetObjectConstructorArguments]);
+    AddLn('LoadFromJSON(AJSON);');
+    Undent;
+    Addln('end;');
+    Addln('');
+    if jpoDelphiJSON in options then
+      GenerateLoadJSONDelphi(M,J)
+    else
+      GenerateLoadJSONfpJSON(M,J);
+    end;
+  if jpoGenerateSave in Options then
+    if jpoDelphiJSON in options then
+      GenerateSaveJSONDelphi(M,J)
+    else
+      GenerateSaveJSONfpJSON(M,J);
+end;
+
+procedure TJSONToPascal.GenerateImplementation(const APath: String; J: TJSONData);
+
+Var
+  M ,IM :  TPropertyMapItem;
+  O : TJSONEnum;
+  P : String;
+
+begin
+  Addln('');
+  M:=FPropertyMap.FindPath(APath);
+  if M.SkipType then
+    exit;
+  if J is TJSONArray then
+    GenerateArrayImplementation(M,TJSONarray(J))
+  else if J is TJSONObject then
+    begin
+    For O in TJSONOBject(J) do
+      begin
+      P:=AddToPath(APath,O.Key);
+      IM:=FPropertyMap.FindPath(P);
+      If (O.Value.JSONType in StructuredJSONTypes) then
+        GenerateImplementation(P,O.Value);
+      end;
+    GenerateObjectImplementation(M,TJSONObject(J));
+    end;
+  Addln('');
+end;
+
+procedure TJSONToPascal.GenerateImplementationEnd;
+begin
+  Addln('end.');
+end;
+
+procedure TJSONToPascal.Execute;
+
+Var
+  J : TJSONData;
+  DoFree : Boolean;
+
+begin
+  J:=Nil;
+  DoFree:=False;
+  Factive:=True;
+  try
+    ClearGeneratedTypes;
+    J:=GetJSONData(DoFree);
+    GenerateInterfaceHeader;
+    FInType:=False;
+    GenerateDeclaration('',J);
+    Undent;
+    GenerateImplementationHeader;
+    GenerateImplementation('',J);
+    GenerateImplementationEnd;
+  finally
+    if DoFree then
+      FreeAndNil(J);
+    Factive:=False;
+  end;
+end;
+
+{ TPropertyMapItem }
+
+procedure TPropertyMapItem.Assign(Source: TPersistent);
+
+Var
+  M : TPropertyMapItem;
+
+begin
+  if Source is TPropertyMapItem then
+    begin
+    M:=Source as TPropertyMapItem;
+    FPath:=M.Path;
+    FTypeName:=M.TypeName;
+    FParentTypeName:=M.ParentTypeName;
+    FGenerated:=M.Generated;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+end.
+
diff --git a/packages/fcl-json/src/jsonconf.pp b/packages/fcl-json/src/jsonconf.pp
index 39e2785d1a..a9684c444f 100644
--- a/packages/fcl-json/src/jsonconf.pp
+++ b/packages/fcl-json/src/jsonconf.pp
@@ -68,6 +68,8 @@ type
   protected
     FJSON: TJSONObject;
     FModified: Boolean;
+    Procedure LoadFromFile(Const AFileName : String);
+    Procedure LoadFromStream(S : TStream); virtual;
     procedure Loaded; override;
     function FindPath(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
     function FindObject(Const APath: UnicodeString; AllowCreate : Boolean) : TJSONObject;
@@ -635,6 +637,7 @@ begin
         Node.Delete(L);
       end;
     end;
+  FModified:=True;  
 end;
 
 procedure TJSONConfig.DeleteValue(const APath: UnicodeString);
@@ -673,11 +676,6 @@ end;
 
 procedure TJSONConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean);
 
-Var
-  P : TJSONParser;
-  J : TJSONData;
-  F : TFileStream;
-  
 begin
   if (not ForceReload) and (FFilename = AFilename) then
     exit;
@@ -685,32 +683,11 @@ begin
 
   if csLoading in ComponentState then
     exit;
-
   Flush;
   If Not FileExists(AFileName) then
     Clear
   else
-    begin
-    F:=TFileStream.Create(AFileName,fmopenRead);
-    try
-      P:=TJSONParser.Create(F,FJSONOptions);
-      try
-        J:=P.Parse;
-        If (J is TJSONObject) then
-          begin
-          FreeAndNil(FJSON);
-          FJSON:=J as TJSONObject;
-          FKey:=FJSON;
-          end
-        else
-          Raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile,[AFileName]);
-      finally
-        P.Free;
-      end;
-    finally
-      F.Free;
-    end;
-    end;
+    LoadFromFile(AFileName);
 end;
 
 procedure TJSONConfig.SetFilename(const AFilename: String);
@@ -741,6 +718,46 @@ begin
     Result:=P;
 end;
 
+procedure TJSONConfig.LoadFromFile(const AFileName: String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(AFileName,fmopenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TJSONConfig.LoadFromStream(S: TStream);
+
+Var
+  P : TJSONParser;
+  J : TJSONData;
+
+begin
+  P:=TJSONParser.Create(S,FJSONOptions);
+  try
+    J:=P.Parse;
+    If (J is TJSONObject) then
+      begin
+      FreeAndNil(FJSON);
+      FJSON:=J as TJSONObject;
+      FKey:=FJSON;
+      end
+    else
+      begin
+      FreeAndNil(J);
+      Raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile,[FileName]);
+      end;
+  finally
+    P.Free;
+  end;
+end;
+
 
 procedure TJSONConfig.CloseKey;
 begin
diff --git a/packages/fcl-json/src/jsonparser.pp b/packages/fcl-json/src/jsonparser.pp
index 5d9df0cf98..320b0eb579 100644
--- a/packages/fcl-json/src/jsonparser.pp
+++ b/packages/fcl-json/src/jsonparser.pp
@@ -29,7 +29,7 @@ Type
   Private
     FScanner : TJSONScanner;
     function GetO(AIndex: TJSONOption): Boolean;
-    function GetOptions: TJSONOptions;
+    function GetOptions: TJSONOptions; inline;
     function ParseNumber: TJSONNumber;
     procedure SetO(AIndex: TJSONOption; AValue: Boolean);
     procedure SetOptions(AValue: TJSONOptions);
@@ -38,7 +38,7 @@ Type
     function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
     function GetNextToken: TJSONToken;
     function CurrentTokenString: String;
-    function CurrentToken: TJSONToken;
+    function CurrentToken: TJSONToken; inline;
     function ParseArray: TJSONArray;
     function ParseObject: TJSONObject;
     Property Scanner : TJSONScanner read FScanner;
@@ -65,7 +65,6 @@ Resourcestring
   SErrUnexpectedEOF   = 'Unexpected EOF encountered.';
   SErrUnexpectedToken = 'Unexpected token (%s) encountered.';
   SErrExpectedColon   = 'Expected colon (:), got token "%s".';
-  SErrUnexpectedComma = 'Invalid comma encountered.';
   SErrEmptyElement = 'Empty element encountered.';
   SErrExpectedElementName    = 'Expected element name, got token "%s"';
   SExpectedCommaorBraceClose = 'Expected , or ], got token "%s".';
@@ -148,6 +147,7 @@ begin
       tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
       tkNumber : Result:=ParseNumber;
       tkComma : DoError(SErrUnexpectedToken);
+      tkIdentifier : DoError(SErrUnexpectedToken);
     end;
   except
     FreeAndNil(Result);
diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp
index 43da6e41f4..746bd14af0 100644
--- a/packages/fcl-json/src/jsonscanner.pp
+++ b/packages/fcl-json/src/jsonscanner.pp
@@ -62,7 +62,6 @@ Type
 
   TJSONScanner = class
   private
-    FAllowComments: Boolean;
     FSource : TStringList;
     FCurRow: Integer;
     FCurToken: TJSONToken;
@@ -70,13 +69,13 @@ Type
     FCurLine: string;
     TokenStr: PChar;
     FOptions : TJSONOptions;
-    function GetCurColumn: Integer;
+    function GetCurColumn: Integer; inline;
     function GetO(AIndex: TJSONOption): Boolean;
     procedure SetO(AIndex: TJSONOption; AValue: Boolean);
   protected
     procedure Error(const Msg: string);overload;
     procedure Error(const Msg: string; Const Args: array of Const);overload;
-    function DoFetchToken: TJSONToken;
+    function DoFetchToken: TJSONToken; inline;
   public
     constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
     constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated  'use options form instead';
@@ -206,10 +205,10 @@ function TJSONScanner.DoFetchToken: TJSONToken;
   end;
 
 var
-  TokenStart, CurPos: PChar;
+  TokenStart: PChar;
   it : TJSONToken;
   I : Integer;
-  OldLength, SectionLength, Index: Integer;
+  OldLength, SectionLength,  tstart,tcol: Integer;
   C : char;
   S : String;
   IsStar,EOC: Boolean;
@@ -434,6 +433,8 @@ begin
       end;
     'a'..'z','A'..'Z','_':
       begin
+        tstart:=CurRow;
+        Tcol:=CurColumn;
         TokenStart := TokenStr;
         repeat
           Inc(TokenStr);
@@ -449,7 +450,7 @@ begin
             exit;
             end;
         if (joStrict in Options) then
-          Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
+          Error(SErrInvalidCharacter, [tStart,tcol,TokenStart[0]])
         else
           Result:=tkIdentifier;
       end;
diff --git a/packages/fcl-json/tests/jsonconftest.pp b/packages/fcl-json/tests/jsonconftest.pp
index 3abc42727d..c93dc7d94b 100644
--- a/packages/fcl-json/tests/jsonconftest.pp
+++ b/packages/fcl-json/tests/jsonconftest.pp
@@ -179,7 +179,9 @@ begin
   C:=CreateConf('test.json');
   try
     C.SetValue('a',1);
+    C.Flush;
     C.DeleteValue('a');
+    AssertEquals('Modified set',True,C.Modified);
     AssertEquals('Delete value',0,C.GetValue('a',0));
     C.SetValue('b/a',1);
     C.SetValue('b/c',2);
@@ -187,7 +189,9 @@ begin
     AssertEquals('Delete value in subkey',0,C.GetValue('a',0));
     AssertEquals('Delete value only clears deleted value',2,C.GetValue('b/c',0));
     C.SetValue('b/a',1);
+    C.Flush;
     C.DeletePath('b');
+    AssertEquals('Modified set',True,C.Modified);
     AssertEquals('Delete path',0,C.GetValue('b/a',0));
     AssertEquals('Delete path deletes all values',0,C.GetValue('b/c',0));
     C.Clear;
diff --git a/packages/fcl-json/tests/tcjsontocode.pp b/packages/fcl-json/tests/tcjsontocode.pp
new file mode 100644
index 0000000000..4fce71088b
--- /dev/null
+++ b/packages/fcl-json/tests/tcjsontocode.pp
@@ -0,0 +1,2422 @@
+unit tcjsontocode;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, fpjsontopas;
+
+type
+
+  { TTestGenCode }
+
+  TTestGenCode= class(TTestCase)
+  private
+    FPos : Integer;
+    FGen: TJSONToPascal;
+    procedure AssertDelphiLoadArray(AElementType, AJSONtype: String);
+    procedure AssertDelphiPropertyAssignmentLoop;
+    procedure AssertDestructorImplementation(AClassName: String; ObjectFields: array of string);
+    procedure AssertLine(Msg: String; AExpected: String);
+    procedure GenCode(AJSON: String);
+    class function GetDataName(IsDelphi: Boolean): string;
+    function NextLine: String;
+    function Pos(const What, Where: String): Integer;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure AssertArrayCreator(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False);
+    procedure AssertArraySaver(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False);
+    procedure AssertArrayCreatorImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False);
+    procedure AssertArraySaverImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False);
+    procedure AssertLoadArray(AElementType, AJSONtype: String; IsDelphi : Boolean = False);
+    procedure AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False);
+    procedure AssertPropertyAssignmentLoop;
+    procedure AssertType;
+    procedure AssertClassComment(const Msg, AName: String);
+    procedure AssertLoadConstructorDeclaration(AType: String);
+    procedure AssertLoaderDeclaration(AType: String);
+    procedure AssertSaverDeclaration;
+    procedure AssertLoaderImplementationEnd(IsDelphi : Boolean = False);
+    procedure AssertLoadConstructorImplementationStart(Const ATypeName, ADataName: String);
+    procedure AssertLoaderImplementationStart(Const ATypeName, ADataName: String; IsDelphi : Boolean = False);
+    procedure AssertSaverImplementationStart(Const ATypeName: String; IsDelphi : Boolean = False);
+    procedure AssertArrayLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False);
+    procedure AssertObjectLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False);
+    Procedure AssertUnitHeader;
+    Procedure AssertBegin;
+    Procedure AssertEnd(Const Msg : String = '');
+    Procedure AssertUnitEnd;
+    Procedure AssertImplementation;
+    procedure AssertProperty(const AName, AType: String; Setter : Boolean = False);
+    procedure AssertSetter(const AName, AType: String);
+    Procedure AssertClassHeader(Const AName : String; AParentName : String);
+    Procedure AssertSetterImplementation(Const AClassType,AName,AType : String; IsObject : Boolean = False);
+    Procedure AssertVisibility(Const AVisibility : String);
+    Procedure AssertDestructor;
+    Procedure AssertField(Const AName,AType : String; Prefix : String = '');
+    Procedure AssertArrayType(Const AName,AItemType : String);
+    Procedure AssertPropertyMap(Const APath,ATypeName,APropertyName,AParentTypeName : String);
+    Property Gen : TJSONToPascal Read FGen;
+  published
+    procedure TestEmpty;
+    Procedure TestSimple;
+    Procedure TestClassName;
+    Procedure TestParentClassName;
+    Procedure TestIntegerProperty;
+    Procedure Test2IntegersProperty;
+    Procedure TestBooleanProperty;
+    Procedure TestStringProperty;
+    Procedure TestFloatProperty;
+    Procedure TestInt64Property;
+    Procedure TestPropertySetter;
+    Procedure TestObjectProperty;
+    Procedure TestObjectPropertySetter;
+    Procedure TestObjectPropertySuffix;
+    Procedure TestObjectPropertySkip;
+    Procedure TestObjectPropertyRecurse;
+    Procedure TestObjectPropertyRecurseSuffix;
+    Procedure TestObjectPropertyRecurseSkip;
+    Procedure TestObjectPropertyRecurseSkipB;
+    Procedure TestStringArrayProperty;
+    Procedure TestIntegerArrayProperty;
+    Procedure TestBooleanArrayProperty;
+    Procedure TestFloatArrayProperty;
+    Procedure TestInt64ArrayProperty;
+    Procedure TestStringArrayPropertySuffix;
+    Procedure TestObjectArrayProperty;
+    procedure TestObjectArrayPropertySuffix;
+    procedure TestArrayArrayProperty;
+    procedure TestObjectArrayArrayProperty;
+    Procedure TestLoadIntegerProperty;
+    Procedure TestLoad2IntegersProperty;
+    Procedure TestLoadIntegerWithErrorProperty;
+    Procedure TestLoadIntegerCaseInsensitiveProperty;
+    Procedure TestLoadStringProperty;
+    Procedure TestLoadBooleanProperty;
+    Procedure TestLoadInt64Property;
+    Procedure TestLoadFloatProperty;
+    Procedure TestLoadObjectProperty;
+    Procedure TestLoadStringArrayProperty;
+    Procedure TestLoadBooleanArrayProperty;
+    Procedure TestLoadIntegerArrayProperty;
+    Procedure TestLoadInt64ArrayProperty;
+    Procedure TestLoadFloatArrayProperty;
+    Procedure TestLoadObjectArrayProperty;
+    Procedure TestLoadDelphiIntegerProperty;
+    Procedure TestLoadDelphi2IntegersProperty;
+    Procedure TestLoadDelphiIntegerWithErrorProperty;
+    Procedure TestLoadDelphiIntegerCaseInsensitiveProperty;
+    Procedure TestLoadDelphiStringProperty;
+    Procedure TestLoadDelphiBooleanProperty;
+    Procedure TestLoadDelphiInt64Property;
+    Procedure TestLoadDelphiFloatProperty;
+    procedure TestLoadDelphiObjectProperty;
+    Procedure TestLoadDelphiStringArrayProperty;
+    Procedure TestLoadDelphiBooleanArrayProperty;
+    Procedure TestLoadDelphiIntegerArrayProperty;
+    Procedure TestLoadDelphiInt64ArrayProperty;
+    Procedure TestLoadDelphiFloatArrayProperty;
+    procedure TestLoadDelphiObjectArrayProperty;
+    Procedure TestSaveIntegerProperty;
+    Procedure TestSave2IntegersProperty;
+    Procedure TestSaveStringProperty;
+    Procedure TestSaveBooleanProperty;
+    Procedure TestSaveInt64Property;
+    Procedure TestSaveFloatProperty;
+    Procedure TestSaveObjectProperty;
+    Procedure TestSaveStringArrayProperty;
+    Procedure TestSaveBooleanArrayProperty;
+    Procedure TestSaveIntegerArrayProperty;
+    Procedure TestSaveInt64ArrayProperty;
+    Procedure TestSaveFloatArrayProperty;
+    Procedure TestSaveObjectArrayProperty;
+    Procedure TestSaveDelphiIntegerProperty;
+    Procedure TestSaveDelphi2IntegersProperty;
+    Procedure TestSaveDelphiStringProperty;
+    Procedure TestSaveDelphiBooleanProperty;
+    Procedure TestSaveDelphiInt64Property;
+    Procedure TestSaveDelphiFloatProperty;
+    Procedure TestSaveDelphiObjectProperty;
+    Procedure TestSaveDelphiStringArrayProperty;
+    Procedure TestSaveDelphiBooleanArrayProperty;
+    Procedure TestSaveDelphiIntegerArrayProperty;
+    Procedure TestSaveDelphiInt64ArrayProperty;
+    Procedure TestSaveDelphiFloatArrayProperty;
+    Procedure TestSaveDelphiObjectArrayProperty;
+  end;
+
+Var
+  TestUnitDir : String;
+
+implementation
+
+procedure TTestGenCode.SetUp;
+begin
+  FGen:=TJSONToPascal.Create(Nil);
+end;
+
+procedure TTestGenCode.TearDown;
+begin
+  FreeAndNil(FGen)
+end;
+
+function TTestGenCode.NextLine: String;
+
+begin
+  Result:='';
+  While (Result='') do
+    begin
+    Inc(FPos);
+    AssertTrue('In scope',FPos<FGen.Code.Count);
+    Result:=Trim(FGen.Code[FPos]);
+    end;
+end;
+
+procedure TTestGenCode.AssertUnitHeader;
+
+Var
+  S: String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Have unit',Pos('unit ',S)=1);
+  S:=NextLine;
+  AssertTrue('Have interface',Pos('interface',S)=1);
+  S:=NextLine;
+  AssertTrue('Have uses',Pos('uses ',S)=1);
+  S:=NextLine;
+  AssertTrue('Type line',Pos('Type',S)=1);
+end;
+
+procedure TTestGenCode.AssertBegin;
+begin
+  AssertTrue('Have begin',pos('begin',nextline)>0);
+end;
+
+procedure TTestGenCode.AssertEnd(const Msg: String);
+begin
+  AssertTrue('Have end:'+Msg,pos('end;',nextline)>0);
+end;
+
+procedure TTestGenCode.AssertUnitEnd;
+begin
+  AssertTrue('Have end.',pos('end.',nextline)>0);
+end;
+
+procedure TTestGenCode.AssertImplementation;
+begin
+  AssertTrue('Have implementation',CompareText(NextLine,'implementation')=0);
+end;
+
+function TTestGenCode.Pos(const What, Where: String): Integer;
+
+begin
+  Result:=system.Pos(lowercase(what),lowercase(where));
+end;
+
+procedure TTestGenCode.AssertClassComment(const Msg,AName: String);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue(Msg+' ('+AName+'): Class header comment start',Pos('{ --',S)>0);
+  S:=NextLine;
+  AssertTrue(Msg+' ('+AName+'): Class header comment class nam',Pos(AName,S)>0);
+  S:=NextLine;
+  AssertTrue(Msg+' ('+AName+'): Class header comment end',Pos('}',S)>0);
+end;
+
+procedure TTestGenCode.AssertClassHeader(const AName: String; AParentName: String);
+
+Var
+  P : Integer;
+  S : String;
+
+begin
+  AssertClassComment('Class declarationheader for '+AName,AName);
+  S:=NextLine;
+  P:=Pos(AName+' = class(',S);
+  AssertTrue('class type ',P>0);
+  P:=Pos(AParentName+')',S);
+  AssertTrue('Class parent type ',P>0);
+  AssertVisibility('private');
+end;
+
+procedure TTestGenCode.AssertSetterImplementation(const AClassType, AName,
+  AType: String; IsObject: Boolean);
+
+Var
+  S,PS : String;
+  P : Integer;
+
+begin
+  S:=NextLine;
+  PS:='Procedure '+AClassType+'.Set'+Aname+'(AValue';
+  AssertTrue('Have declaration start',Pos(PS,S)>0);
+  Delete(S,1,Length(PS));
+  P:=Pos(':',S);
+  AssertTrue('Have colon' ,p>0);
+  Delete(S,1,P);
+  AssertTrue('Have type',Pos(AType,S)>0);
+  AssertTrue('Have );',Pos(');',S)>0);
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+  AssertBegin;
+  AssertTrue('Have change check',Pos('if ('+Gen.FieldPrefix+AName+'=AValue) then exit;',NextLine)>0);
+  if IsObject then
+    AssertTrue('Have free of previous value',Pos('FreeAndNil('+Gen.FieldPrefix+AName+');',NextLine)>0);
+  AssertTrue('Have Assignment',Pos(Gen.FieldPrefix+AName+':=AValue;',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertVisibility(const AVisibility: String);
+
+begin
+  AssertTrue('Have visibility section '+AVisibility,Pos(AVisibility,NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertDestructor;
+begin
+  AssertTrue('Have destructor declaration',Pos('Destructor Destroy; override;',NextLine)>0);
+end;
+
+
+procedure TTestGenCode.AssertDestructorImplementation(AClassName: String;
+  ObjectFields: array of string);
+
+Var
+  F : String;
+
+begin
+  AssertTrue('Have destructor implementation',Pos(Format('Destructor %s.Destroy;',[AClassName]),NextLine)>0);
+  AssertBegin;
+  For F in ObjectFields do
+    AssertTrue('Have destructor for F'+F,Pos('FreeAndNil(F'+F+');',NextLine)>0);
+  AssertTrue('Have inherited call'+F,Pos('Inherited;',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertField(const AName, AType: String; Prefix : String = '');
+
+Var
+  F,S : String;
+  P : Integer;
+
+begin
+  F:=Prefix;
+  if F='' then
+    F:='F';
+  S:=NextLine;
+  AssertTrue('Field Name',Pos(F+AName,S)=1);
+  P:=Pos(':',S);
+  AssertTrue('Colon after field name',P>Length(F+AName));
+  AssertTrue('Field type after colon',Pos(AType,S)>P);
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+end;
+
+procedure TTestGenCode.AssertSetter(const AName, AType: String);
+
+Var
+  N,S,PD : String;
+  P,p2 : Integer;
+
+begin
+  S:=NextLine;
+  N:='Setter declaration for '+AName+' : ';
+  PD:='Procedure Set'+AName;
+  AssertTrue(N+'Setter name',Pos(PD,S)=1);
+  P:=Pos('(',S);
+  AssertTrue(N+'( after parameter name',P>Length(PD));
+  P:=Pos(':',S);
+  AssertTrue(N+'Colon after parameter name',P>Length(PD));
+  Delete(S,1,P);
+  P2:=Pos(AType,S);
+  AssertTrue(N+'Field type after colon '+AType+' : '+S,P2>0);
+  P:=Pos(');',S);
+  AssertTrue(N+'); type after parameter type',P>P2);
+  P2:=Pos('virtual',S);
+  AssertTrue(N+'virtual after ); ',P2>P);
+  AssertTrue(N+'Terminated on semicolon',S[Length(S)]=';');
+end;
+
+procedure TTestGenCode.AssertArrayType(const AName, AItemType: String);
+
+Var
+  P,p2 : Integer;
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Type Name',Pos(AName,S)=1);
+  P:=Pos('=',S);
+  AssertTrue('Equal token after type Name',P>Pos(AName,S));
+  P2:=Pos('Array of',S);
+  AssertTrue('Array of after Equal token after type Name',P2>P);
+  P:=Pos(AItemType,S);
+  AssertTrue('Item type name after array of',P>P2);
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+end;
+
+procedure TTestGenCode.AssertPropertyMap(const APath, ATypeName, APropertyName,
+  AParentTypeName: String);
+
+Var
+  M : TPropertyMapItem;
+
+begin
+  M:=Gen.PropertyMap.FindPath(APath);
+  AssertNotNull('Have property map "'+APath+'"',M);
+  AssertEquals('Have type name ',ATypeName,M.TypeName);
+  AssertEquals('Have property name ',APropertyName,M.PropertyName);
+  AssertEquals('Have parent type name ',AParentTypeName,M.ParentTypeName);
+end;
+
+procedure TTestGenCode.AssertProperty(const AName, AType: String; Setter : Boolean = False);
+
+Var
+  S : String;
+  P,P2 : Integer;
+
+begin
+  S:=NextLine;
+  AssertTrue('Property Name',Pos('Property '+AName,S)=1);
+  P:=Pos(':',S);
+  AssertTrue('Colon after property name',P>Length('Property '+AName));
+  P2:=Pos(AType,S);
+  AssertTrue('Field type after colon',P2>P);
+  P:=pos(' read ',S);
+  AssertTrue('Read specifier after type ',P>P2);
+  P2:=Pos('F'+AName,S);
+  AssertTrue('Field name for read specifier',P2>P);
+  P:=pos(' write ',S);
+  AssertTrue('Write specifier after type ',P>P2);
+  if Setter Then
+    P2:=Pos('write Set'+AName,S)
+  else
+    P2:=Pos('write F'+AName,S);
+  AssertTrue('Field name for write specifier',P2>P);
+
+  AssertTrue('Terminated on semicolon',S[Length(S)]=';');
+end;
+
+
+procedure TTestGenCode.GenCode(AJSON : String);
+
+Var
+  F : Text;
+
+begin
+  Gen.JSON:=AJSON;
+  Gen.DestUnitName:='u'+TestName;
+  Gen.Execute;
+  if (TestUnitDir<>'') then
+    begin
+    Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.pp');
+    Rewrite(F);
+    Writeln(F,'// ',Self.TestName);
+    Writeln(F,Gen.Code.Text);
+    Close(F);
+    Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.json');
+    Rewrite(F);
+    Writeln(F,AJSON);
+    Close(F);
+    end
+  else
+    begin
+    Writeln('// ',Self.TestName);
+    Writeln('(* JSON: '+AJSON+' *)');
+    Writeln(Gen.Code.Text);
+    end;
+
+  FPos:=-1;
+end;
+
+procedure TTestGenCode.TestEmpty;
+begin
+  AssertNotNull('Have generator',Gen);
+  AssertNotNull('Generator property map exists',Gen.PropertyMap);
+  AssertNotNull('Generator property code exists',Gen.Code);
+  AssertNull('Generator JSON empty',Gen.JSONData);
+  AssertNull('Generator JSON stream empty',Gen.JSONStream);
+  AssertEquals('Generator JSON empty','',Gen.JSON);
+  AssertEquals('Generator property map empty',0,Gen.PropertyMap.Count);
+end;
+
+procedure TTestGenCode.TestSimple;
+begin
+  GenCode('{}');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+end;
+
+procedure TTestGenCode.TestClassName;
+begin
+  Gen.PropertyMap.AddPath('','TSomeObject');
+  GenCode('{}');
+  AssertUnitHeader;
+  AssertClassHeader('TSomeObject','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertPropertyMap('','TSomeObject','','TObject');
+end;
+
+procedure TTestGenCode.TestParentClassName;
+begin
+  Gen.PropertyMap.AddPath('','TSomeObject');
+  Gen.DefaultParentName:='TMyObject';
+  GenCode('{}');
+  AssertUnitHeader;
+  AssertClassHeader('TSomeObject','TMyObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertPropertyMap('','TSomeObject','','TMyObject');
+end;
+
+procedure TTestGenCode.TestIntegerProperty;
+begin
+  GenCode('{ "a" : 1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertProperty('a','integer');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.Test2IntegersProperty;
+begin
+  GenCode('{ "a" : 1, "b" : 2 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertProperty('a','integer');
+  AssertProperty('b','integer');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestBooleanProperty;
+begin
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','boolean');
+  AssertVisibility('public');
+  AssertProperty('a','boolean');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestStringProperty;
+begin
+  GenCode('{ "a" : "abce" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertProperty('a','string');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestFloatProperty;
+begin
+  GenCode('{ "a" : 1.1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','double');
+  AssertVisibility('public');
+  AssertProperty('a','double');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestInt64Property;
+begin
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','int64');
+  AssertVisibility('public');
+  AssertProperty('a','int64');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestPropertySetter;
+begin
+  Gen.Options:=[jpoUseSetter];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','int64');
+  AssertVisibility('protected');
+  AssertSetter('A','int64');
+  AssertVisibility('public');
+  AssertProperty('a','int64',True);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSetterImplementation('TMyObject','a','int64');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestObjectProperty;
+begin
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TA','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Comment for class TA','Ta');
+  AssertClassComment('Comment for class TMyObject','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertySetter;
+begin
+  Gen.Options:=[jpoUseSetter];
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TA','TObject');
+  AssertVisibility('protected');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('protected');
+  AssertSetter('a','Ta');
+  AssertVisibility('Public');
+  AssertDestructor;
+  AssertProperty('a','Ta',True);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Comment for class TA','Ta');
+  AssertClassComment('Comment for class TMyObject','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertSetterImplementation('TMyObject','a','Ta',True);
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertySuffix;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TAType','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertySkip;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  Gen.PropertyMap.AddPath('a','me').SkipType:=true;
+  GenCode('{ "a" : {} }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','me');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','me');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','me','a','');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurse;
+begin
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TAB','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TA','TObject');
+  AssertField('b','TaB');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('b','TaB');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+  AssertPropertyMap('a.b','Tab','b','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurseSuffix;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TABType','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertClassHeader('TAType','TObject');
+  AssertField('b','TaBType');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('b','TaBType');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','TObject');
+  AssertPropertyMap('a.b','TabType','b','TObject');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurseSkip;
+begin
+  Gen.PropertyMap.AddPath('a','me').SkipType:=true;
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','me');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','me');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','me','a','');
+end;
+
+procedure TTestGenCode.TestObjectPropertyRecurseSkipB;
+begin
+  Gen.PropertyMap.AddPath('a.b','me').SkipType:=true;
+  GenCode('{ "a" : { "b" : {} } }');
+  AssertUnitHeader;
+  AssertClassHeader('TA','TObject');
+  AssertField('b','me');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('b','me');
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+  AssertPropertyMap('a.b','me','b','');
+end;
+
+procedure TTestGenCode.TestStringArrayProperty;
+begin
+  GenCode('{ "a" : [ "" ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','string');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','String','','');
+end;
+
+procedure TTestGenCode.TestIntegerArrayProperty;
+begin
+  GenCode('{ "a" : [ 1 ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','integer');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Integer','','');
+end;
+
+procedure TTestGenCode.TestBooleanArrayProperty;
+begin
+  GenCode('{ "a" : [ true ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','Boolean');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Boolean','','');
+end;
+
+procedure TTestGenCode.TestFloatArrayProperty;
+begin
+  GenCode('{ "a" : [ 1.2 ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','Double');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Double','','');
+end;
+
+procedure TTestGenCode.TestInt64ArrayProperty;
+begin
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertUnitHeader;
+  AssertArrayType('Ta','Int64');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','Int64','','');
+end;
+
+procedure TTestGenCode.TestStringArrayPropertySuffix;
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : [ "" ] }');
+  AssertUnitHeader;
+  AssertArrayType('TaType','string');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','');
+  AssertPropertyMap('a[0]','String','','');
+end;
+
+procedure TTestGenCode.TestObjectArrayProperty;
+begin
+  GenCode('{ "a" : [ {} ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','TaItem','','TObject');
+end;
+
+procedure TTestGenCode.TestObjectArrayPropertySuffix;
+
+begin
+  Gen.PropertyTypeSuffix:='Type';
+  GenCode('{ "a" : [ {} ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItemType','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertArrayType('TaType','TaItemType');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','TaType');
+  AssertVisibility('public');
+  AssertProperty('a','TaType');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','TaType','a','');
+  AssertPropertyMap('a[0]','TaItemType','','TObject');
+end;
+
+procedure TTestGenCode.TestArrayArrayProperty;
+begin
+  GenCode('{ "a" : [ [ "" ] ] }');
+  AssertUnitHeader;
+  AssertArrayType('TaItem','String');
+  AssertArrayType('Ta','TaItem');
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertProperty('a','Ta');
+  AssertEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','TaItem','','');
+  AssertPropertyMap('a[0][0]','String','','');
+end;
+
+procedure TTestGenCode.TestObjectArrayArrayProperty;
+begin
+  GenCode('{ "a" : [ [ {} ] ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItemItem','TObject');
+  AssertVisibility('public');
+  AssertEnd;
+  AssertArrayType('TaItem','TaItemItem');
+  AssertArrayType('Ta','TaItem');
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+  AssertPropertyMap('a[0]','TaItem','','');
+  AssertPropertyMap('a[0][0]','TaItemItem','','TObject');
+end;
+
+procedure TTestGenCode.AssertLoadConstructorDeclaration(AType: String);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Load Constructor declaration in '+S,Pos('Constructor CreateFromJSON(AJSON : '+AType+'); virtual;',S)>0);
+end;
+
+procedure TTestGenCode.AssertLoaderDeclaration(AType : String);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('LoadFromJSON declaration in '+S,Pos('Procedure LoadFromJSON(AJSON : '+AType+'); virtual;',S)>0);
+end;
+
+procedure TTestGenCode.AssertSaverDeclaration;
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('SaveToJSON function declaration in '+S,Pos('Function SaveToJSON : TJSONObject;',S)>0);
+  S:=NextLine;
+  AssertTrue('SaveToJSON procedure declaration in '+S,Pos('Procedure SaveToJSON(AJSON : TJSONObject)',S)>0);
+end;
+
+procedure TTestGenCode.AssertLoaderImplementationEnd(IsDelphi : Boolean = False);
+
+begin
+  if Not IsDelphi then
+    AssertEnd('Case');// Case
+  AssertEnd('for');// For
+  AssertEnd('procedure');// Routine
+end;
+
+procedure TTestGenCode.AssertArrayLoaderImplementationStart(const ATypeName,
+  ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False);
+
+Var
+  S : String;
+begin
+  S:=NextLine;
+  AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0);
+  if isDelphi then
+    AssertDelphiPropertyAssignmentLoop
+  else
+    AssertPropertyAssignmentLoop;
+end;
+
+procedure TTestGenCode.AssertPropertyAssignmentLoop;
+
+begin
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have P enum',Pos('E : TJSONEnum;',NextLine)>0);
+  AssertBegin;
+  AssertTrue('Have E for enum',Pos('For E in AJSON do',NextLine)>0);
+  AssertBegin;
+  if (jpoLoadCaseInsensitive in Gen.Options) then
+    AssertTrue('Have E for enum',Pos('case LowerCase(E.key) of',NextLine)>0)
+  else
+    AssertTrue('Have E for enum',Pos('case E.key of',NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertDelphiPropertyAssignmentLoop;
+
+Var
+  S : String;
+
+begin
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have pair',Pos('P : TJSONPair;',NextLine)>0);
+  AssertTrue('Have obj',Pos('O : TJSONObject;',NextLine)>0);
+  AssertTrue('Have Propertyname var',Pos('PN : String;',NextLine)>0);
+  AssertBegin;
+  S:=NextLine;
+  AssertTrue('Have JSONObject check in '+S,Pos('not (AJSON is TJSONObject)',S)>0);
+  if jpoUnknownLoadPropsError in gen.Options then
+    AssertTrue('Have raise statement',Pos('Raise EJSONException',NextLine)>0);
+  AssertTrue('Have typecast',Pos('O:=AJSON as TJSONObject',NextLine)>0);
+  AssertTrue('Have P for enum',Pos('For P in O do',NextLine)>0);
+  AssertBegin;
+  if jpoLoadCaseInsensitive in Gen.Options then
+    AssertTrue('Have case insensitive propertyname assign',Pos('PN:=LowerCase(P.JSONString.Value)',NextLine)>0)
+  else
+    AssertTrue('Have propertyname assign',Pos('PN:=P.JSONString.Value',NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertObjectLoaderImplementationStart(const ATypeName,
+  ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False);
+Var
+  S : String;
+begin
+  S:=NextLine;
+  AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0);
+  if isDelphi then
+    AssertDelphiPropertyAssignmentLoop
+  else
+    AssertPropertyAssignmentLoop;
+end;
+
+procedure TTestGenCode.AssertSaverImplementationStart(const ATypeName: String;
+  IsDelphi: Boolean);
+
+Var
+  S,N : String;
+
+begin
+  N:='SaveToJSONFunction '+ATypeName+' : ';
+  S:=NextLine;
+  AssertTrue(N+'header',Pos('Function  '+ATypeName+'.SaveToJSON : TJSONObject;',S)>0);
+  AssertBegin;
+  AssertTrue(N+'Create',Pos('Result:=TJSONObject.Create',NextLine)>0);
+  AssertTrue(N+'Try',Pos('Try',NextLine)>0);
+  AssertTrue(N+'Save',Pos('SaveToJSON(Result);',NextLine)>0);
+  AssertTrue(N+'except',Pos('except',NextLine)>0);
+  AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0);
+  AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  AssertTrue(N+'proc header',Pos('Procedure '+ATypeName+'.SaveToJSON(AJSON : TJSONObject);',NextLine)>0);
+  AssertBegin;
+end;
+
+
+procedure TTestGenCode.AssertLoaderImplementationStart(const ATypeName,
+  ADataName: String; IsDelphi : Boolean = False);
+
+begin
+  AssertTrue(Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',NextLine)>0);
+  if isDelphi then
+    AssertDelphiPropertyAssignmentLoop
+  else
+    AssertPropertyAssignmentLoop;
+end;
+
+procedure TTestGenCode.AssertLoadConstructorImplementationStart(const ATypeName,
+  ADataName: String);
+
+begin
+  AssertTrue('Have constructor call',Pos('Constructor '+ATypeName+'.CreateFromJSON(AJSON : '+ADataName+');',NextLine)>0);
+  AssertBegin;
+  AssertTrue('Call create constructor',Pos('create();',NextLine)>0);
+  AssertTrue('Call LoadFromJSON',Pos('LoadFromJSON(AJSON);',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.TestLoadIntegerProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestLoad2IntegersProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
+  AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadIntegerWithErrorProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoUnknownLoadPropsError];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0);
+  AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0);
+  AssertTrue('Have case else',Pos('else',NextLine)>0);
+  AssertTrue('Have raise statement', Pos('Raise EJSON.CreateFmt',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadIntegerCaseInsensitiveProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoLoadCaseInsensitive];
+  GenCode('{ "A" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('A','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('A','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData',False);
+  AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('A:=E.Value.AsInteger;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('A','Integer','A','');
+end;
+
+procedure TTestGenCode.TestLoadStringProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" string property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" string property set', Pos('a:=E.Value.AsString;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestLoadBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','boolean');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" boolean property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" boolean property set', Pos('a:=E.Value.AsBoolean;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestLoadInt64Property;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" Int64 property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" Int64 property set', Pos('a:=E.Value.AsInt64;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestLoadFloatProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : 1.1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Double');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','Double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertLoaderImplementationStart('TMyObject','TJSONData');
+  AssertTrue('Have "a" Double property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" Double property set', Pos('a:=E.Value.AsFloat;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestLoadObjectProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertLoadConstructorImplementationStart('Ta','TJSONData');
+  AssertLoaderImplementationStart('Ta','TJSONData');
+  AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
+  AssertTrue('Have "a" object property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(E.Value);',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.AssertArrayCreator(const ArrayTypeName,
+  AElementType: String; IsDelphi: Boolean);
+
+Var
+  S : String;
+
+begin
+  S:=NextLine;
+  AssertTrue('Have array creator in '+S,Pos('Function Create'+ArrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName,S)>0);
+end;
+
+procedure TTestGenCode.AssertArraySaver(const ArrayTypeName,
+  AElementType: String; IsDelphi: Boolean);
+
+Var
+  E,S : String;
+
+begin
+  S:=NextLine;
+  E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);';
+  AssertTrue('Have proc array saver in '+S,Pos(E,S)>0);
+  S:=NextLine;
+  E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;';
+  AssertTrue('Have func array saver in '+S,Pos(E,S)>0);
+end;
+
+procedure TTestGenCode.AssertArrayCreatorImplementation(const ArrayTypeName,
+  AElementType: String; AObjectName: String; IsDelphi: Boolean);
+
+Var
+  S,E,AN : String;
+
+begin
+  S:=NextLine;
+  E:='Function Create'+ARrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName;
+  AssertTrue('Have array creator header '+S+'Expected : '+E ,Pos(E,S)>0);
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0);
+  if IsDelphi then
+    begin
+    AssertTrue('Have Array var',Pos('A : TJSONArray;',NextLine)>0);
+    AN:='A'
+    end
+  else
+    AN:='AJSON';
+  AssertBegin;
+  if IsDelphi then
+    AssertTrue('Have Array assignnment',Pos('A:=AJSON as TJSONArray;',NextLine)>0);
+  AssertTrue('Have array setlength ',Pos('SetLength(Result,'+AN+'.Count);',NextLine)>0);
+  AssertTrue('Have loop ',Pos('for i:=0 to '+AN+'.Count-1 do',NextLine)>0);
+  if AObjectName='' then
+    begin
+    if IsDelphi then
+      AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].GetValue<'+AElementType+'>;',NextLine)>0)
+    else
+      AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].'+AElementType+';',NextLine)>0)
+    end
+  else
+    AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AObjectName+'.CreateFromJSON('+AN+'.Items[i]);',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertLine(Msg : String; AExpected : String);
+
+Var
+  N,DMsg : String;
+
+begin
+  N:=NextLine;
+  DMsg:=Msg+', Expected: "'+AExpected+'", Actual: "'+N+'"';
+  AssertTrue(Dmsg,Pos(AExpected,N)>0);
+end;
+
+procedure TTestGenCode.AssertArraySaverImplementation(const ArrayTypeName,
+  AElementType: String; AObjectName: String; IsDelphi: Boolean);
+Var
+  N,S,E,AN : String;
+
+begin
+  N:=ArrayTypeName+'Saver : ';
+  S:=NextLine;
+  E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;';
+  AssertTrue(N+'header',Pos(E,S)>0);
+  AssertBegin;
+  AssertTrue(N+'Create',Pos('Result:=TJSONArray.Create',NextLine)>0);
+  AssertTrue(N+'Try',Pos('Try',NextLine)>0);
+  S:=NextLine;
+  E:='Save'+ArrayTypeName+'ToJSON(AnArray,Result);';
+  AssertTrue(N+'Save',Pos(E,S)>0);
+  AssertTrue(N+'except',Pos('except',NextLine)>0);
+  AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0);
+  AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  AssertTrue(N+'end;',Pos('End;',NextLine)>0);
+  S:=NextLine;
+  E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);';
+  AssertTrue('Have array saver header '+S+'Expected : '+E ,Pos(E,S)>0);
+  AssertTrue('Have var',Pos('var',NextLine)>0);
+  AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0);
+  AssertBegin;
+  AssertTrue('Have loop ',Pos('for i:=0 to Length(AnArray)-1 do',NextLine)>0);
+  if AObjectName='' then
+    AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add(AnArray[i]);')
+{  else if AObjectName='' then
+    AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add('+AN+'[i]);')}
+  else
+     AssertTrue('Have element assignment : '+AElementType,Pos('AJSONArray.Add(AnArray[i].SaveToJSON);',NextLine)>0);
+  AssertEnd;
+end;
+
+procedure TTestGenCode.AssertType;
+
+begin
+  AssertTrue('Have Type keyword',Pos('Type',NextLine)>0);
+end;
+
+procedure TTestGenCode.AssertDelphiLoadArray(AElementType, AJSONtype : String);
+
+begin
+  AssertUnitHeader;
+  AssertArrayType('Ta',AElementType);
+  AssertArrayCreator('Ta',AElementType,true);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertArrayCreatorImplementation('Ta',AJSONType,'',True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertArrayLoaderImplementationStart('TMyObject','TJSONValue','a','Ta',AJSONType);
+  AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.Value);',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+class function TTestGenCode.GetDataName(IsDelphi: Boolean): string;
+
+begin
+  if IsDelphi then
+    Result:='TJSONValue'
+  else
+    Result:='TJSONData';
+end;
+
+procedure TTestGenCode.AssertLoadArray(AElementType, AJSONtype: String;
+  IsDelphi: Boolean = False);
+
+Var
+  DN : String;
+
+begin
+  AssertUnitHeader;
+  DN:=GetDataName(IsDelphi);
+  AssertArrayType('Ta',AElementType);
+  AssertArrayCreator('Ta',AElementType,IsDelphi);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration(DN);
+  AssertLoaderDeclaration(DN);
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertArrayCreatorImplementation('Ta',AJSONType,'',IsDelphi);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject',DN);
+  AssertArrayLoaderImplementationStart('TMyObject',DN,'a','Ta',AJSONType,isDelphi);
+  if IsDelphi then
+    begin
+    AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0);
+    AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
+    end
+  else
+    begin
+    AssertTrue('Have "a" array property case',Pos('''a'':',NextLine)>0);
+    AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
+    end;
+  AssertLoaderImplementationEnd(IsDelphi);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False);
+
+Var
+  DN : String;
+
+begin
+  AssertUnitHeader;
+  DN:=GetDataName(IsDelphi);
+  AssertArrayType('Ta',AElementType);
+  AssertArraySaver('Ta',AElementType,IsDelphi);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertArraySaverImplementation('Ta',AJSONType,'',IsDelphi);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  if IsDelphi then
+    AssertTrue('Array save statement', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0)
+  else
+    AssertTrue('Array save statement', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
+  AssertEnd('Saver');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestLoadStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertLoadArray('string','AsString');
+end;
+
+procedure TTestGenCode.TestLoadBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ true ] }');
+  AssertLoadArray('boolean','AsBoolean');
+end;
+
+procedure TTestGenCode.TestLoadIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ 123 ] }');
+  AssertLoadArray('Integer','AsInteger');
+end;
+
+procedure TTestGenCode.TestLoadInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertLoadArray('Int64','AsInt64');
+end;
+
+procedure TTestGenCode.TestLoadFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" : [ 12.34 ] }');
+  AssertLoadArray('Double','AsFloat');
+end;
+
+procedure TTestGenCode.TestLoadObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad];
+  GenCode('{ "a" :  [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArrayCreator('Ta','TaItem');
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONData');
+  AssertLoaderDeclaration('TJSONData');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertLoadConstructorImplementationStart('TAItem','TJSONData');
+  AssertLoaderImplementationStart('TaItem','TJSONData');
+  AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0);
+  AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertArrayCreatorImplementation('Ta','','TaItem');
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONData');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta','');
+  AssertTrue('Have "a" stringarray property case',Pos('''a'':',NextLine)>0);
+  AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0);
+  AssertLoaderImplementationEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+
+procedure TTestGenCode.TestLoadDelphiIntegerProperty;
+
+Var
+  S : String;
+
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphi2IntegersProperty;
+
+Var
+  S : String;
+
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
+  AssertTrue('Have no semicolon', Pos(';',S)=0);
+  AssertTrue('Have else  "b" integer property case ',Pos('Else If (PN=''b'') then',NextLine)>0);
+  AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiIntegerWithErrorProperty;
+
+Var
+  S : String;
+
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoUnknownLoadPropsError];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<Integer>',S)>0);
+  AssertTrue('Have no semicolon for a', Pos(';',S)=0);
+  AssertTrue('Have "b" integer property case ',Pos('If (PN=''b'') then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue<Integer>',S)>0);
+  AssertTrue('Have no semicolon for b', Pos(';',S)=0);
+  AssertTrue('Have case else',Pos('else',NextLine)>0);
+  AssertTrue('Have raise statement', Pos('Raise EJSONException.CreateFmt',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiIntegerCaseInsensitiveProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoLoadCaseInsensitive];
+  GenCode('{ "A" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('A','integer');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('A','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "A" integer property set', Pos('A:=P.JSONValue.GetValue<Integer>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('A','Integer','A','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiStringProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue<String>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','boolean');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Boolean>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiInt64Property;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Int64>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiFloatProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : 1.1 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Double');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','Double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertLoaderImplementationStart('TMyObject','TJSONValue',True);
+  AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue<Double>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiObjectProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertLoadConstructorImplementationStart('Ta','TJSONValue');
+  AssertLoaderImplementationStart('Ta','TJSONValue',True);
+  AssertTrue('Have "b" string property case',Pos('If (PN=''b'') then',NextLine)>0);
+  AssertTrue('Have "b" string property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
+  AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(P.JSONValue);',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestLoadDelphiObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON];
+  GenCode('{ "a" : [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArrayCreator('Ta','TaItem',True);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertLoadConstructorDeclaration('TJSONValue');
+  AssertLoaderDeclaration('TJSONValue');
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertLoadConstructorImplementationStart('TAItem','TJSONValue');
+  AssertLoaderImplementationStart('TaItem','TJSONValue',True);
+  AssertTrue('Have "b" object property case',Pos('If (PN=''b'') then',NextLine)>0);
+  AssertTrue('Have "b" object property set', Pos('b:=P.JSONValue.GetValue<String>;',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertArrayCreatorImplementation('Ta','','TaItem',True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertLoadConstructorImplementationStart('TMyObject','TJSONValue');
+  AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True);
+  AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0);
+  AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0);
+  AssertLoaderImplementationEnd(True);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestSaveIntegerProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestSave2IntegersProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('Have "b" integer property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestSaveStringProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestSaveBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Boolean');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" boolean property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestSaveInt64Property;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" int64 property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestSaveFloatProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : 1.2 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','double');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+
+end;
+
+procedure TTestGenCode.TestSaveObjectProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertSaverImplementationStart('Ta');
+  AssertTrue('Have "b" property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
+  AssertEnd;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
+  AssertTrue('Have "a" object property save', Pos('AJSON.Add(''a'',a.SaveToJSON);',NextLine)>0);
+  AssertEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestSaveStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertSaveArray('string','');
+end;
+
+procedure TTestGenCode.TestSaveBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ true ] }');
+  AssertSaveArray('boolean','');
+end;
+
+procedure TTestGenCode.TestSaveIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ 123 ] }');
+  AssertSaveArray('Integer','');
+end;
+
+procedure TTestGenCode.TestSaveInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertSaveArray('Int64','');
+end;
+
+procedure TTestGenCode.TestSaveFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" : [ 1.23] }');
+  AssertSaveArray('Double','');
+end;
+
+procedure TTestGenCode.TestSaveObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave];
+  GenCode('{ "a" :  [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArraySaver('Ta','TaItem');
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertSaverImplementationStart('TaItem');
+  AssertTrue('Have "b" string property save', Pos('AJSON.Add(''b'',b);',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertArraySaverImplementation('Ta','','TaItem');
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" array property save', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0);
+  AssertEnd('Loader TMyObject');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiIntegerProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1234 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphi2IntegersProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1234, "b" : 5678 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','integer');
+  AssertField('b','integer');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','integer',False);
+  AssertProperty('b','integer',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
+  AssertTrue('Have "b" integer property save', Pos('AJSON.AddPair(''b'',TJSONNumber.Create(b));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Integer','a','');
+  AssertPropertyMap('b','Integer','b','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiStringProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : "1234" }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','string');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','string',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" string property save', Pos('AJSON.AddPair(''a'',TJSONString.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','String','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiBooleanProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : true }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Boolean');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Boolean',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" Boolean property save', Pos('AJSON.AddPair(''a'',TJSONBoolean.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Boolean','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiInt64Property;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1234567890123 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Int64');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','Int64',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" int64 property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Int64','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiFloatProperty;
+Var
+  S : String;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : 1.2 }');
+  AssertUnitHeader;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','double');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','double',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  S:=NextLine;
+  AssertTrue('Have "a" float property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',S)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Double','a','');
+end;
+
+procedure TTestGenCode.TestSaveDelphiObjectProperty;
+Var
+  S : String;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : { "b" : "abc" } }');
+  AssertUnitHeader;
+  AssertClassHeader('Ta','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertDestructor;
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','Ta');
+  AssertSaverImplementationStart('Ta');
+  AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
+  AssertEnd;
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertDestructorImplementation('TMyObject',['a']);
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0);
+  S:=NextLine;
+  AssertTrue('Have "a" object property save', Pos('AJSON.AddPair(''a'',a.SaveToJSON);',S)>0);
+  AssertEnd;
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','TObject');
+end;
+
+procedure TTestGenCode.TestSaveDelphiStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertSaveArray('string','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ true ] }');
+  AssertSaveArray('boolean','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ 123 ] }');
+  AssertSaveArray('Integer','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertSaveArray('Int64','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" : [ 1.23] }');
+  AssertSaveArray('Double','',True);
+end;
+
+procedure TTestGenCode.TestSaveDelphiObjectArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateSave,jpoDelphiJSON];
+  GenCode('{ "a" :  [ { "b" : "abc" } ] }');
+  AssertUnitHeader;
+  AssertClassHeader('TaItem','TObject');
+  AssertField('b','String');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('b','String',False);
+  AssertEnd;
+  AssertArrayType('Ta','TaItem');
+  AssertArraySaver('Ta','TaItem',True);
+  AssertType;
+  AssertClassHeader('TMyObject','TObject');
+  AssertField('a','Ta');
+  AssertVisibility('public');
+  AssertSaverDeclaration;
+  AssertProperty('a','ta',False);
+  AssertEnd;
+  AssertImplementation;
+  AssertClassComment('Object Implementation','TaItem');
+  AssertSaverImplementationStart('TaItem',True);
+  AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0);
+  AssertTrue('end',Pos('end;',NextLine)>0);
+  AssertArraySaverImplementation('Ta','','TaItem',True);
+  AssertClassComment('Object Implementation','TMyObject');
+  AssertSaverImplementationStart('TMyObject');
+  AssertTrue('Have "a" array property save', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0);
+  AssertEnd('Loader TMyObject');
+  AssertUnitEnd;
+  AssertPropertyMap('','TMyObject','','TObject');
+  AssertPropertyMap('a','Ta','a','');
+end;
+
+procedure TTestGenCode.TestLoadDelphiStringArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ "abc" ] }');
+  AssertLoadArray('string','String',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiBooleanArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ true ] }');
+  AssertLoadArray('boolean','Boolean',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiIntegerArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ 12 ] }');
+  AssertLoadArray('integer','Integer',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiInt64ArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ 1234567890123 ] }');
+  AssertLoadArray('int64','Int64',True);
+end;
+
+procedure TTestGenCode.TestLoadDelphiFloatArrayProperty;
+begin
+  Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON];
+  GenCode('{ "a" : [ 1.1 ] }');
+  AssertLoadArray('double','Double',True);
+end;
+
+
+initialization
+
+  RegisterTest(TTestGenCode);
+end.
+
diff --git a/packages/fcl-json/tests/testcomps.pp b/packages/fcl-json/tests/testcomps.pp
index d4dbea26d8..7398cb9014 100644
--- a/packages/fcl-json/tests/testcomps.pp
+++ b/packages/fcl-json/tests/testcomps.pp
@@ -191,7 +191,7 @@ Type
   Public
     Constructor Create(AOwner : TComponent);  override;
   Published
-    Property ExtendedProp : Comp Read F Write F;
+    Property CompProp : Comp Read F Write F;
   end;
 
   // Currency property
diff --git a/packages/fcl-json/tests/testjson.lpi b/packages/fcl-json/tests/testjson.lpi
index bc2e75ada9..6740053db4 100644
--- a/packages/fcl-json/tests/testjson.lpi
+++ b/packages/fcl-json/tests/testjson.lpi
@@ -25,7 +25,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestJSONDeStreamer.TestDateTimeFormat"/>
+        <CommandLineParams Value="--suite=TTestParser.TestObjectError"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
diff --git a/packages/fcl-json/tests/testjson2code.lpi b/packages/fcl-json/tests/testjson2code.lpi
new file mode 100644
index 0000000000..7fc43f1e68
--- /dev/null
+++ b/packages/fcl-json/tests/testjson2code.lpi
@@ -0,0 +1,70 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testjson2code"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="--suite=TestLoadObjectProperty"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="testjson2code.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tcjsontocode.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../src/fpjsontopas.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/fcl-json/tests/testjson2code.lpr b/packages/fcl-json/tests/testjson2code.lpr
new file mode 100644
index 0000000000..6dbf20d104
--- /dev/null
+++ b/packages/fcl-json/tests/testjson2code.lpr
@@ -0,0 +1,52 @@
+program testjson2code;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tcjsontocode, fpjsontopas;
+
+type
+
+  { TLazTestRunner }
+
+  { TMyTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+    function GetShortOpts: string; override;
+    procedure AppendLongOpts; override;
+    procedure DoRun; override;
+  end;
+
+var
+  Application: TMyTestRunner;
+
+{ TMyTestRunner }
+
+function TMyTestRunner.GetShortOpts: string;
+begin
+  Result:=inherited GetShortOpts;
+  Result:=Result+'t:';
+end;
+
+procedure TMyTestRunner.AppendLongOpts;
+begin
+  inherited AppendLongOpts;
+  LongOpts.Add('testunitdir:');
+end;
+
+procedure TMyTestRunner.DoRun;
+begin
+  TestUnitDir:=GetOptionValue('t','testunitdir');
+  inherited DoRun;
+end;
+
+begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.
\ No newline at end of file
diff --git a/packages/fcl-json/tests/testjsondata.pp b/packages/fcl-json/tests/testjsondata.pp
index e79a527cf9..58f84b04ba 100644
--- a/packages/fcl-json/tests/testjsondata.pp
+++ b/packages/fcl-json/tests/testjsondata.pp
@@ -19,7 +19,7 @@ unit testjsondata;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, fpjson;
+  Classes, SysUtils, fpcunit, testregistry, fpjson;
 
 type
    TMyNull     = Class(TJSONNull);
@@ -36,7 +36,7 @@ type
 
   TTestJSONString = Class(TTestCase)
   Private
-    Procedure TestTo(Const Src,Dest : String);
+    Procedure TestTo(Const Src,Dest : String; Strict : Boolean = False);
     Procedure TestFrom(Const Src,Dest : String);
   Published
     Procedure TestJSONStringToString;
@@ -147,6 +147,7 @@ type
   published
     procedure TestString;
     procedure TestControlString;
+    procedure TestSolidus;
     procedure TestInteger;
     procedure TestNegativeInteger;
     procedure TestFloat;
@@ -204,6 +205,7 @@ type
     Procedure TestClone;
     Procedure TestMyClone;
     Procedure TestFormat;
+    Procedure TestFormatNil;
   end;
   
   { TTestObject }
@@ -252,7 +254,9 @@ type
     procedure TestExtract;
     Procedure TestNonExistingAccessError;
     Procedure TestFormat;
+    Procedure TestFormatNil;
     Procedure TestFind;
+    Procedure TestIfFind;
   end;
 
   { TTestJSONPath }
@@ -1002,7 +1006,6 @@ end;
 
 procedure TTestJSONPath.TestDeepRecursive;
 Var
-  O : TJSONObject;
   A : TJSONArray;
   D : TJSONData;
 begin
@@ -1500,7 +1503,6 @@ Var
   T : String;
 
 begin
-
   J:=TJSONString.Create('');
   try
     For I:=0 to 31 do
@@ -1522,6 +1524,23 @@ begin
   end;
 end;
 
+procedure TTestString.TestSolidus;
+Var
+  J : TJSONString;
+
+begin
+  J:=TJSONString.Create('');
+  try
+    J.AsString:='http://www.json.org/';
+    TJSONString.StrictEscaping:=True;
+    TestJSON(J,'"http:\/\/www.json.org\/"');
+    TJSONString.StrictEscaping:=False;
+    TestJSON(J,'"http://www.json.org/"');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 procedure TTestString.TestInteger;
 
 Const
@@ -1566,7 +1585,7 @@ begin
     TestAsBoolean(J,True,False);
     TestAsInteger(J,-1,False);
     TestAsInt64(J,-1,False);
-    TestAsQWord(J,-1,True);
+    TestAsQWord(J,QWord(-1),True);
     TestAsString(J,S);
     TestAsFloat(J,-1.0,False);
   finally
@@ -1611,7 +1630,7 @@ begin
     TestAsBoolean(J,True,False);
     TestAsInteger(J,-1,True);
     TestAsInt64(J,-1,True);
-    TestAsQWord(J,-1,True);
+    TestAsQWord(J,QWord(-1),True);
     TestAsString(J,S);
     TestAsFloat(J,-1.0,True);
   finally
@@ -2563,7 +2582,6 @@ procedure TTestArray.TestAddString;
 Var
   J : TJSONArray;
   S : String;
-  F : TJSONFloat;
   
 begin
   S:='A string';
@@ -2585,8 +2603,6 @@ procedure TTestArray.TestAddNull;
 
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
   J:=TJSonArray.Create;
@@ -2720,7 +2736,6 @@ procedure TTestArray.TestInsertString;
 Var
   J : TJSONArray;
   S : String;
-  F : TJSONFloat;
 
 begin
   S:='A string';
@@ -2742,8 +2757,6 @@ end;
 procedure TTestArray.TestInsertNull;
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
   J:=TJSonArray.Create;
@@ -2825,11 +2838,8 @@ end;
 procedure TTestArray.TestMove;
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
-  S:='A string';
   J:=TJSonArray.Create;
   try
     J.Add('First string');
@@ -2849,11 +2859,8 @@ end;
 procedure TTestArray.TestExchange;
 Var
   J : TJSONArray;
-  S : String;
-  F : TJSONFloat;
 
 begin
-  S:='A string';
   J:=TJSonArray.Create;
   try
     J.Add('First string');
@@ -2987,7 +2994,7 @@ end;
 
 procedure TTestArray.TestMyClone;
 Var
-  J,J2 : TMyArray;
+  J : TMyArray;
   D : TJSONData;
 
 begin
@@ -3010,7 +3017,6 @@ end;
 procedure TTestArray.TestFormat;
 Var
   J : TJSONArray;
-  I : TJSONData;
 
 begin
   J:=TJSonArray.Create;
@@ -3033,6 +3039,23 @@ begin
   end;
 end;
 
+procedure TTestArray.TestFormatNil;
+
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(1);
+    J.Add(TJSONObject(Nil));
+    TestJSON(J,'[1, null]');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineArray],1));
+  finally
+    J.Free;
+  end;
+end;
+
 { TTestObject }
 
 procedure TTestObject.TestCreate;
@@ -3199,7 +3222,6 @@ Const
 Var
   J : TJSONObject;
   S : String;
-  F : TJSONFloat;
 
 begin
   S:='A string';
@@ -3224,8 +3246,6 @@ Const
 
 Var
   J : TJSONObject;
-  S : String;
-  F : TJSONFloat;
 
 begin
   J:=TJSonObject.Create;
@@ -3482,6 +3502,23 @@ begin
   end;
 end;
 
+procedure TTestObject.TestFormatNil;
+
+Var
+  J : TJSONObject;
+
+begin
+  J:=TJSONObject.Create;
+  try
+    J.Add('a',1);
+    J.Add('b',TJSONObject(Nil));
+    TestJSON(J,'{ "a" : 1, "b" : null }');
+    AssertEquals('FormatJSON, single line',J.AsJSON,J.FormatJSON([foSingleLineObject],1));
+  finally
+    J.Free;
+  end;
+end;
+
 procedure TTestObject.TestFind;
 
 Const
@@ -3517,6 +3554,28 @@ begin
   end;
 end;
 
+Procedure TTestObject.TestIfFind;
+Var
+  J: TJSONObject;
+  B: TJSONBoolean;
+  S: TJSONString;
+  N: TJSONNumber;
+  D: TJSONData;
+begin
+  J:=TJSONObject.Create(['s', 'astring', 'b', true, 'n', 1]);
+  try
+    TestJSONType(J,jtObject);
+    TestIsNull(J,False);
+    TestItemCount(J,3);
+    AssertEquals('boolean found', true, j.Find('b', B));
+    AssertEquals('string found', true, j.Find('s', S));
+    AssertEquals('number found', true, j.Find('n', N));
+    AssertEquals('data found', true, j.Find('s', D));
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 
 procedure TTestObject.TestCreateString;
 
@@ -4007,14 +4066,14 @@ end;
 
 { TTestJSONString }
 
-procedure TTestJSONString.TestTo(const Src, Dest: String);
+procedure TTestJSONString.TestTo(const Src, Dest: String; Strict : Boolean = False);
 
 Var
   S : String;
 
 begin
   S:='StringToJSONString('''+Src+''')='''+Dest+'''';
-  AssertEquals(S,Dest,StringToJSONString(Src));
+  AssertEquals(S,Dest,StringToJSONString(Src,Strict));
 end;
 
 procedure TTestJSONString.TestFrom(const Src, Dest: String);
@@ -4073,7 +4132,8 @@ begin
   TestTo('AB','AB');
   TestTo('ABC','ABC');
   TestTo('\','\\');
-  TestTo('/','\/');
+  TestTo('/','/');
+  TestTo('/','\/',True);
   TestTo('"','\"');
   TestTo(#8,'\b');
   TestTo(#9,'\t');
@@ -4096,7 +4156,8 @@ begin
   TestTo('A'#12'BC','A\fBC');
   TestTo('A'#13'BC','A\rBC');
   TestTo('\\','\\\\');
-  TestTo('//','\/\/');
+  TestTo('//','//');
+  TestTo('//','\/\/',true);
   TestTo('""','\"\"');
   TestTo(#8#8,'\b\b');
   TestTo(#9#9,'\t\t');
diff --git a/packages/fcl-json/tests/testjsonparser.pp b/packages/fcl-json/tests/testjsonparser.pp
index 602cb1e515..46f461e1e1 100644
--- a/packages/fcl-json/tests/testjsonparser.pp
+++ b/packages/fcl-json/tests/testjsonparser.pp
@@ -19,9 +19,12 @@ unit testjsonparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry,fpjson,
+  Classes, SysUtils, fpcunit, testregistry,fpjson,
   jsonscanner,jsonParser,testjsondata;
 
+Const
+  DefaultOpts = [joUTF8,joStrict];
+
 type
 
   { TTestParser }
@@ -30,7 +33,7 @@ type
   private
     FOptions : TJSONOptions;
     procedure CallNoHandlerStream;
-    procedure DoTestError(S: String);
+    procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts);
     procedure DoTestFloat(F: TJSONFloat); overload;
     procedure DoTestFloat(F: TJSONFloat; S: String); overload;
     procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
@@ -53,6 +56,7 @@ type
     procedure TestString;
     procedure TestArray;
     procedure TestObject;
+    procedure TestObjectError;
     procedure TestTrailingComma;
     procedure TestTrailingCommaErrorArray;
     procedure TestTrailingCommaErrorObject;
@@ -326,6 +330,12 @@ begin
   DoTestObject('{ "a" : 1, "B" : { "c" : "d" } }',['a','B']);
 end;
 
+procedure TTestParser.TestObjectError;
+begin
+
+  DoTestError('{ "name" : value }',[joUTF8]);
+end;
+
 
 procedure TTestParser.DoTestObject(S: String; const ElNames: array of String;
   DoJSONTest: Boolean);
@@ -406,21 +416,21 @@ end;
 procedure TTestParser.TestErrors;
 
 begin
-{
+
   DoTestError('a');
   DoTestError('"b');
   DoTestError('1Tru');
-}
+
   DoTestError('b"');
   DoTestError('{"a" : }');
   DoTestError('{"a" : ""');
   DoTestError('{"a : ""');
-{
+
   DoTestError('[1,]');
   DoTestError('[,]');
   DoTestError('[,,]');
   DoTestError('[1,,]');
-}
+
 end;
 
 procedure TTestParser.TestClasses;
@@ -516,7 +526,7 @@ begin
   end;
 end;
 
-procedure TTestParser.DoTestError(S : String);
+procedure TTestParser.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
 
 Var
   P : TJSONParser;
@@ -527,7 +537,7 @@ Var
 begin
   ParseOK:=False;
   P:=TJSONParser.Create(S);
-  P.Strict:=True;
+  P.OPtions:=Options;
   J:=Nil;
   Try
     Try
diff --git a/packages/fcl-json/tests/testjsonrtti.pp b/packages/fcl-json/tests/testjsonrtti.pp
index e91745611e..db59b6b073 100644
--- a/packages/fcl-json/tests/testjsonrtti.pp
+++ b/packages/fcl-json/tests/testjsonrtti.pp
@@ -5,7 +5,7 @@ unit testjsonrtti;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, typinfo, fpjson,
+  Classes, SysUtils, fpcunit, testregistry, typinfo, fpjson,
   dateutils, testcomps, testjsondata, fpjsonrtti;
 
 type
@@ -106,8 +106,10 @@ type
     Procedure TestObjectToJSONString;
     Procedure TestStringsToJSONString;
     Procedure TestCollectionToJSONString;
+    procedure TestTListToJSONString;
     Procedure TestChildren;
     Procedure TestChildren2;
+    Procedure TestLowercase;
   end;
 
   { TTestJSONDeStreamer }
@@ -117,7 +119,6 @@ type
     FDS : TJSONDeStreamer;
     FJD : TJSONData;
     FToFree : TObject;
-    FCalled : Boolean;
     procedure DeStream(JSON: TJSONStringType; AObject: TObject);
     procedure DeStream(JSON: TJSONObject; AObject: TObject);
     procedure DoDateTimeFormat;
@@ -139,6 +140,8 @@ type
     procedure TestEmpty;
     procedure TestBoolean;
     procedure TestInteger;
+    procedure TestIntegerCaseInsensitive;
+    procedure TestIntegerCaseSensitive;
     procedure TestString;
     procedure TestFloat;
     procedure TestFloat2;
@@ -317,6 +320,31 @@ begin
   AssertEquals('Correct integer value',22,B.IntProp);
 end;
 
+procedure TTestJSONDeStreamer.TestIntegerCaseInsensitive;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  DS.Options:=DS.Options+[jdoCaseInsensitive];
+  B:=TIntegerComponent.Create(Nil);
+  DeStream('{ "intprop" : 22 }',B);
+  AssertEquals('Correct integer value',22,B.IntProp);
+end;
+
+procedure TTestJSONDeStreamer.TestIntegerCaseSensitive;
+
+Var
+  B : TIntegerComponent;
+
+begin
+  DS.Options:=DS.Options;
+  B:=TIntegerComponent.Create(Nil);
+  B.IntProp:=0;
+  DeStream('{ "intprop" : 22 }',B);
+  AssertEquals('Correct integer value not reas',0,B.IntProp);
+end;
+
 procedure TTestJSONDeStreamer.TestString;
 
 Var
@@ -367,12 +395,8 @@ Var
 
 begin
   B:=TCompComponent.Create(Nil);
-  DeStream('{ "ExtendedProp" : 5.67 }',B);
-{$ifdef CPUX86_64}
-  AssertEquals('Correct comp value',round(5.67),B.ExtendedProp);
-{$else}
-  AssertEquals('Correct extended value',5.67,B.ExtendedProp);
-{$endif}
+  DeStream('{ "CompProp" : 5.67 }',B);
+  AssertEquals('Correct comp value',round(5.67),B.CompProp);
 end;
 
 procedure TTestJSONDeStreamer.TestFloat5;
@@ -877,12 +901,7 @@ procedure TTestJSONStreamer.TestWriteFloat4;
 begin
   StreamObject(TCompComponent.Create(Nil));
   AssertPropCount(1);
-  // Extended is correct, propname is wrong
-  {$ifdef CPUX86_64}
-    AssertProp('ExtendedProp',TJSONFloat(5));
-  {$else}
-    AssertProp('ExtendedProp',4.56);
-  {$endif}
+  AssertProp('CompProp',5);
 end;
 
 procedure TTestJSONStreamer.TestWriteFloat5;
@@ -1021,7 +1040,6 @@ procedure TTestJSONStreamer.TestCollectionProp2;
 
 Var
   C : TCollectionComponent;
-  F : TJSONObject;
   A : TJSONArray;
 
 begin
@@ -1057,8 +1075,6 @@ end;
 
 procedure TTestJSONStreamer.TestStringsProp1;
 
-Var
-  A : TJSONArray;
 begin
   RJ.Options:=[jsoTstringsAsArray];
   StreamObject(TStringsCOmponent.Create(Nil));
@@ -1068,8 +1084,6 @@ end;
 
 procedure TTestJSONStreamer.TestStringsProp2;
 
-Var
-  A : TJSONArray;
 begin
   StreamObject(TStringsCOmponent.Create(Nil));
   AssertPropCount(1);
@@ -1267,7 +1281,6 @@ end;
 
 procedure TTestJSONStreamer.TestStringsStream4;
 Var
-  O : TJSONObject;
   S : TStringList;
 
 begin
@@ -1598,7 +1611,7 @@ begin
   AssertEquals('Variant type',VarTypeAsText(varSingle),VarTypeAsText(VarType(C.VariantProp)));
   StreamObject(FTofree);
   AssertPropCount(1);
-  AssertProp('VariantProp',3.14);
+  AssertProp('VariantProp',i);
 end;
 
 procedure TTestJSONStreamer.TestVariantdouble;
@@ -1769,6 +1782,38 @@ begin
   end;
 end;
 
+procedure TTestJSONStreamer.TestTListToJSONString ;
+
+
+Var
+  C : TList;
+  D : TJSONData;
+  P : Pointer;
+
+  Function Add : TTestItem;
+
+  begin
+    Result:=TTestItem.Create(Nil);
+    C.Add(Result);
+  end;
+
+begin
+  RJ.Options:=RJ.Options + [jsoStreamTList];
+  C:=TList.Create;
+  try
+    Add.StrProp:='one';
+    Add.StrProp:='two';
+    Add.StrProp:='three';
+    D:=RJ.StreamTList(C);
+    AssertEquals('StreamTlist','[{ "StrProp" : "one" }, { "StrProp" : "two" }, { "StrProp" : "three" }]',D.AsJSON);
+  finally
+    D.Free;
+    For P in C do
+      TObject(P).Free;
+    FreeAndNil(C);
+  end;
+end;
+
 procedure TTestJSONStreamer.TestCollectionToJSONString;
 
 Var
@@ -1829,6 +1874,14 @@ begin
   end;
 end;
 
+procedure TTestJSONStreamer.TestLowercase;
+begin
+  RJ.Options:=RJ.Options+[jsoLowerPropertyNames];
+  StreamObject(TBooleanComponent.Create(nil));
+  AssertPropCount(1);
+  AssertProp('booleanprop',False);
+end;
+
 initialization
 
   RegisterTests([TTestJSONStreamer,TTestJSONDeStreamer]);
diff --git a/packages/fcl-net/fpmake.pp b/packages/fcl-net/fpmake.pp
index e6890b509e..948bb10ef5 100644
--- a/packages/fcl-net/fpmake.pp
+++ b/packages/fcl-net/fpmake.pp
@@ -43,6 +43,8 @@ begin
     // IP and Sockets
     T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
     T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+AllAmigaLikeOSes+[OS2,EMX]);
+      if Defaults.CPU=powerpc then
+        T.OSes:=T.OSes-[amiga];
       with T.Dependencies do
         begin
           AddInclude('resolve.inc');
@@ -50,6 +52,8 @@ begin
         end;
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('ssockets.pp',AllUnixOSes+AllWindowsOSes+AllAmigaLikeOSes+[OS2,EMX]);
+      if Defaults.CPU=powerpc then
+        T.OSes:=T.OSes-[amiga];
       with T.Dependencies do
         begin
           AddUnit('resolve');
diff --git a/packages/fcl-net/src/netdb.pp b/packages/fcl-net/src/netdb.pp
index e770e5e05f..87fd6065c3 100644
--- a/packages/fcl-net/src/netdb.pp
+++ b/packages/fcl-net/src/netdb.pp
@@ -329,12 +329,16 @@ Var
   L : String;
   A : THostAddr;
   T : PHostListEntry;
+  B : Array of byte;
+  FS : Int64;
   
 begin
   Result:=Nil;
   Assign(F,FileName);
   {$push}{$I-}
   Reset(F);
+  SetLength(B,65355);
+  SetTextBuf(F,B[0],65355);
   {$pop};
   If (IOResult<>0) then
     Exit;
diff --git a/packages/fcl-passrc/examples/parsepp.pp b/packages/fcl-passrc/examples/parsepp.pp
new file mode 100644
index 0000000000..3a6e3fbf4c
--- /dev/null
+++ b/packages/fcl-passrc/examples/parsepp.pp
@@ -0,0 +1,92 @@
+{ ---------------------------------------------------------------------
+  This is a simple program to check whether fcl-passrc
+
+  ---------------------------------------------------------------------}
+
+program parsepp;
+
+{$mode objfpc}{$H+}
+ 
+uses SysUtils, Classes, PParser, PasTree;
+ 
+type
+  { We have to override abstract TPasTreeContainer methods.
+    See utils/fpdoc/dglobals.pp for an implementation of TFPDocEngine,
+    a "real" engine. }
+  TSimpleEngine = class(TPasTreeContainer)
+  public
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      override;
+    function FindElement(const AName: String): TPasElement; override;
+  end;
+ 
+function TSimpleEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+begin
+  Writeln(AName,' : ',AClass.ClassName,' at ',ASourceFilename,':',ASourceLinenumber);
+  Result := AClass.Create(AName, AParent);
+  Result.Visibility := AVisibility;
+  Result.SourceFilename := ASourceFilename;
+  Result.SourceLinenumber := ASourceLinenumber;
+end;
+ 
+function TSimpleEngine.FindElement(const AName: String): TPasElement;
+begin
+  { dummy implementation, see TFPDocEngine.FindElement for a real example }
+  Result := nil;
+end;
+ 
+Procedure Usage;
+
+begin
+  Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [-h|--help] options ');
+  Writeln('-h or --help shows this help');
+  Writeln('All other options are passed as-is to the parser');
+  Halt(0);
+end;
+ 
+var
+  M: TPasModule;
+  E: TPasTreeContainer;
+  I: Integer;
+  Decls: TFPList;
+  cmdline : String;
+  
+begin
+  cmdline:='';
+  if (ParamCount=0) or (Paramstr(1)='-h') or (Paramstr(1)='--help') then
+    Usage;
+  For I:=1 to ParamCount do
+    CmdLine:=CmdLine+' '+Paramstr(i);
+  E := TSimpleEngine.Create;
+  M := nil;
+  try
+    M := ParseSource(E, cmdline, 'linux', 'i386');
+ 
+    { Cool, we successfully parsed the module.
+      Now output some info about it. }
+    if M.InterfaceSection <> nil then
+    begin
+      Decls := M.InterfaceSection.Declarations;
+      for I := 0 to Decls.Count - 1 do
+        Writeln('Interface item ', I, ': ' +
+          (TObject(Decls[I]) as TPasElement).Name);
+    end else
+      Writeln('No interface section --- this is not a unit, this is a ', M.ClassName);
+ 
+    if M.ImplementationSection <> nil then // may be nil in case of a simple program
+    begin
+      Decls := M.ImplementationSection.Declarations;
+      for I := 0 to Decls.Count - 1 do
+        Writeln('Implementation item ', I, ': ' +
+          (TObject(Decls[I]) as TPasElement).Name);
+    end;
+ 
+  finally
+    FreeAndNil(M);
+    FreeAndNil(E)
+  end;
+end.
diff --git a/packages/fcl-passrc/examples/test_parser.pp b/packages/fcl-passrc/examples/test_parser.pp
index d0a518dc83..6ded90c066 100644
--- a/packages/fcl-passrc/examples/test_parser.pp
+++ b/packages/fcl-passrc/examples/test_parser.pp
@@ -544,9 +544,9 @@ begin
     begin
      lifl:=TPasImplForLoop(lsmt);
      //TODO variable
-     write(s1,'for ',lifl.VariableName,':= ',lifl.StartValue,' ');
+     write(s1,'for ',lifl.Variable.Name,':= ',lifl.StartExpr.GetDeclaration(True),' ');
      if lifl.Down then write('down');
-     writeln('to ',lifl.EndValue,' do');
+     writeln('to ',lifl.EndExpr.GetDeclaration(True),' do');
      GetTPasImplBlock(TPasImplBlock(lifl),lindent+1,0,false,false);
      DoSem:=false;
     end
@@ -1147,8 +1147,8 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
       Result:=true;
       writeln(';');
       write(s,'case ');
-      if prct.VariantName <>'' then write(prct.VariantName,'=');
-      write(TPasType(prct.VariantType).Name);
+      if prct.VariantEl.GetDeclaration(True) <>'' then write(prct.VariantEl.GetDeclaration(True),'=');
+      write(TPasType(prct.VariantEl).Name);
       writeln(' of');
       if assigned(prct.Variants)then
        if prct.Variants.Count >0 then
@@ -1235,8 +1235,8 @@ procedure GetTypes(pe:TPasElement; lindent:integer);
     if assigned(prct.Variants) then
      begin
       write(s1,'case ');
-      if prct.VariantName <>'' then write(prct.VariantName,'=');
-        write(TPasType(prct.VariantType).Name);
+      if prct.VariantEl.Name <>'' then write(prct.VariantEl.Name,'=');
+        write(TPasType(prct.VariantEl).Name);
       writeln(' of');
       if assigned(prct.Variants)then
        if prct.Variants.Count >0 then
diff --git a/packages/fcl-passrc/fpmake.pp b/packages/fcl-passrc/fpmake.pp
index 25a5df6fd2..72cc93759a 100644
--- a/packages/fcl-passrc/fpmake.pp
+++ b/packages/fcl-passrc/fpmake.pp
@@ -39,7 +39,13 @@ begin
           AddUnit('pastree');
           AddUnit('pscanner');
         end;
-    T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('pasresolver.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+          AddUnit('pscanner');
+          AddUnit('pparser');
+        end;
     T:=P.Targets.AddUnit('pastounittest.pp');
       with T.Dependencies do
         begin
@@ -62,6 +68,19 @@ begin
         begin
           AddUnit('pastree');
         end;
+    T:=P.Targets.AddUnit('pasresolveeval.pas');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+          AddUnit('pscanner');
+        end;
+    T.ResourceStrings := True;
+    T:=P.Targets.AddUnit('pasuseanalyzer.pas');
+      with T.Dependencies do
+        begin
+          AddUnit('pastree');
+          AddUnit('pasresolver');
+        end;
 
 {$ifndef ALLPACKAGES}
     Run;
diff --git a/packages/fcl-passrc/src/pasresolveeval.pas b/packages/fcl-passrc/src/pasresolveeval.pas
new file mode 100644
index 0000000000..87a68de0a3
--- /dev/null
+++ b/packages/fcl-passrc/src/pasresolveeval.pas
@@ -0,0 +1,2784 @@
+{
+    This file is part of the Free Component Library
+
+    Pascal source parser
+    Copyright (c) 2017 by Mattias Gaertner, mattias@freepascal.org
+
+    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.
+
+ **********************************************************************
+
+Abstract:
+  Evaluation of Pascal constants.
+
+Works:
+  - Emitting range check warnings
+  - Error on overflow
+  - bool: not, =, <>, and, or, xor, low(), high()
+  - int/uint
+    - unary +, -
+    - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
+  - string: +
+  - float:
+  - enum/set
+
+ToDo:
+  - enable eval via option, default off
+  - bool:
+    - low(), high(), pred(), succ(), ord()
+  - int
+    - typecast
+    - low(), high(), pred(), succ()
+  - string:
+    - =, <>, <, >, <=, >=
+    - string encoding
+    - s[]
+    - length(string)
+    - chr(), ord(), low(), high(), pred(), succ()
+    - #65
+    - #$DC00
+  - float
+    - typecast float
+    - /
+    - +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not
+  - enum
+    - low(), high(), pred(), succ(), ord(), typecast
+  - sets
+    - [a,b,c..d]
+    - +, -, *, =, <>, <=, >=, in, ><
+  - arrays
+    - length(), low(), high()
+}
+unit PasResolveEval;
+
+{$mode objfpc}{$H+}
+
+{$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
+{$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
+
+interface
+
+uses
+  Sysutils, Math, PasTree, PScanner;
+
+// message numbers
+const
+  nIdentifierNotFound = 3001;
+  nNotYetImplemented = 3002;
+  nIllegalQualifier = 3003;
+  nSyntaxErrorExpectedButFound = 3004;
+  nWrongNumberOfParametersForCallTo = 3005;
+  nIncompatibleTypeArgNo = 3006;
+  nIncompatibleTypeArgNoVarParamMustMatchExactly = 3007;
+  nVariableIdentifierExpected = 3008;
+  nDuplicateIdentifier = 3009;
+  nXExpectedButYFound = 3010;
+  nAncestorCycleDetected = 3011;
+  nCantUseForwardDeclarationAsAncestor = 3012;
+  nCantDetermineWhichOverloadedFunctionToCall = 3013;
+  nForwardTypeNotResolved = 3014;
+  nForwardProcNotResolved = 3015;
+  nInvalidXModifierY = 3016;
+  nAbstractMethodsMustNotHaveImplementation = 3017;
+  nCallingConventionMismatch = 3018;
+  nResultTypeMismatchExpectedButFound = 3019;
+  nFunctionHeaderMismatchForwardVarName = 3020;
+  nFunctionHidesIdentifier = 3021;
+  nNoMethodInAncestorToOverride = 3022;
+  nInheritedOnlyWorksInMethods = 3023;
+  nInheritedNeedsAncestor = 3024;
+  nNoPropertyFoundToOverride = 3025;
+  nExprTypeMustBeClassOrRecordTypeGot = 3026;
+  nPropertyNotWritable = 3027;
+  nIncompatibleTypesGotExpected = 3028;
+  nTypesAreNotRelated = 3029;
+  nAbstractMethodsCannotBeCalledDirectly = 3030;
+  nMissingParameterX = 3031;
+  nCannotAccessThisMemberFromAX = 3032;
+  nInOperatorExpectsSetElementButGot = 3033;
+  nWrongNumberOfParametersForTypeCast = 3034;
+  nIllegalTypeConversionTo = 3035;
+  nConstantExpressionExpected = 3036;
+  nLeftSideOfIsOperatorExpectsAClassButGot = 3037;
+  nNotReadable = 3038;
+  nClassPropertyAccessorMustBeStatic = 3039;
+  nClassPropertyAccessorMustNotBeStatic = 3040;
+  nOnlyOneDefaultPropertyIsAllowed = 3041;
+  nWrongNumberOfParametersForArray = 3042;
+  nCantAssignValuesToAnAddress = 3043;
+  nIllegalExpression = 3044;
+  nCantAccessPrivateMember = 3045;
+  nMustBeInsideALoop = 3046;
+  nExpectXArrayElementsButFoundY = 3047;
+  nCannotCreateADescendantOfTheSealedClass = 3048;
+  nAncestorIsNotExternal = 3049;
+  nVirtualMethodXHasLowerVisibility = 3050; // FPC 3250
+  nExternalClassInstanceCannotAccessStaticX = 3051;
+  nXModifierMismatchY = 3052;
+  nSymbolCannotBePublished = 3053;
+  nCannotTypecastAType = 3054;
+  nTypeIdentifierExpected = 3055;
+  nCannotNestAnonymousX = 3056;
+  nFoundCallCandidateX = 3057;
+  nSymbolXIsNotPortable = 3058;
+  nSymbolXIsExperimental = 3059;
+  nSymbolXIsNotImplemented = 3060;
+  nSymbolXBelongsToALibrary = 3061;
+  nSymbolXIsDeprecated = 3062;
+  nSymbolXIsDeprecatedY = 3063;
+  nRangeCheckError = 3064;
+  nHighRangeLimitLTLowRangeLimit = 3065;
+  nRangeCheckEvaluatingConstantsVMinMax = 3066;
+  nIllegalChar = 3067;
+  nOverflowInArithmeticOperation = 3068;
+  nDivByZero = 3069;
+
+// resourcestring patterns of messages
+resourcestring
+  sIdentifierNotFound = 'identifier not found "%s"';
+  sNotYetImplemented = 'not yet implemented: %s';
+  sIllegalQualifier = 'illegal qualifier "%s"';
+  sSyntaxErrorExpectedButFound = 'Syntax error, "%s" expected but "%s" found';
+  sWrongNumberOfParametersForCallTo = 'Wrong number of parameters specified for call to "%s"';
+  sIncompatibleTypeArgNo = 'Incompatible type arg no. %s: Got "%s", expected "%s"';
+  sIncompatibleTypeArgNoVarParamMustMatchExactly = 'Incompatible type arg no. %s: Got "%s", expected "%s". Var param must match exactly.';
+  sVariableIdentifierExpected = 'Variable identifier expected';
+  sDuplicateIdentifier = 'Duplicate identifier "%s" at %s';
+  sXExpectedButYFound = '%s expected, but %s found';
+  sAncestorCycleDetected = 'Ancestor cycle detected';
+  sCantUseForwardDeclarationAsAncestor = 'Can''t use forward declaration "%s" as ancestor';
+  sCantDetermineWhichOverloadedFunctionToCall = 'Can''t determine which overloaded function to call';
+  sForwardTypeNotResolved = 'Forward type not resolved "%s"';
+  sForwardProcNotResolved = 'Forward %s not resolved "%s"';
+  sInvalidXModifierY = 'Invalid %s modifier %s';
+  sAbstractMethodsMustNotHaveImplementation = 'Abstract method must not have an implementation.';
+  sCallingConventionMismatch = 'Calling convention mismatch';
+  sResultTypeMismatchExpectedButFound = 'Result type mismatch, expected %s, but found %s';
+  sFunctionHeaderMismatchForwardVarName = 'function header "%s" doesn''t match forward : var name changes %s => %s';
+  sFunctionHidesIdentifier = 'function hides identifier "%s" at "%s"';
+  sNoMethodInAncestorToOverride = 'There is no method in an ancestor class to be overridden "%s"';
+  sInheritedOnlyWorksInMethods = 'Inherited works only in methods';
+  sInheritedNeedsAncestor = 'inherited needs an ancestor';
+  sNoPropertyFoundToOverride = 'No property found to override';
+  sExprTypeMustBeClassOrRecordTypeGot = 'Expression type must be class or record type, got %s';
+  sPropertyNotWritable = 'No member is provided to access property';
+  sIncompatibleTypesGotExpected = 'Incompatible types: got "%s" expected "%s"';
+  sTypesAreNotRelated = 'Types are not related';
+  sAbstractMethodsCannotBeCalledDirectly = 'Abstract methods cannot be called directly';
+  sMissingParameterX = 'Missing parameter %s';
+  sCannotAccessThisMemberFromAX = 'Cannot access this member from a %s';
+  sInOperatorExpectsSetElementButGot = 'the in-operator expects a set element, but got %s';
+  sWrongNumberOfParametersForTypeCast = 'wrong number of parameters for type cast to %s';
+  sIllegalTypeConversionTo = 'Illegal type conversion: "%s" to "%s"';
+  sConstantExpressionExpected = 'Constant expression expected';
+  sLeftSideOfIsOperatorExpectsAClassButGot = 'left side of is-operator expects a class, but got %s';
+  sNotReadable = 'not readable';
+  sClassPropertyAccessorMustBeStatic = 'class property accessor must be static';
+  sClassPropertyAccessorMustNotBeStatic = 'class property accessor must not be static';
+  sOnlyOneDefaultPropertyIsAllowed = 'Only one default property is allowed';
+  sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
+  sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
+  sIllegalExpression = 'Illegal expression';
+  sCantAccessPrivateMember = 'Can''t access %s member %s';
+  sMustBeInsideALoop = '%s must be inside a loop';
+  sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
+  sCannotCreateADescendantOfTheSealedClass = 'Cannot create a descendant of the sealed class "%s"';
+  sAncestorIsNotExternal = 'Ancestor "%s" is not external';
+  sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
+  sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
+  sXModifierMismatchY = '%s modifier "%s" mismatch';
+  sSymbolCannotBePublished = 'Symbol cannot be published';
+  sCannotTypecastAType = 'Cannot type cast a type';
+  sTypeIdentifierExpected = 'Type identifier expected';
+  sCannotNestAnonymousX = 'Cannot nest anonymous %s';
+  sFoundCallCandidateX = 'Found call candidate %s';
+  sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
+  sSymbolXIsExperimental = 'Symbol "%s" is experimental';
+  sSymbolXIsNotImplemented = 'Symbol "%s" is implemented';
+  sSymbolXBelongsToALibrary = 'Symbol "%s" belongs to a library';
+  sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
+  sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
+  sRangeCheckError = 'Range check error';
+  sHighRangeLimitLTLowRangeLimit = 'High range limit < low range limit';
+  sRangeCheckEvaluatingConstantsVMinMax = 'range check error while evaluating constants (%s must be between %s and %s)';
+  sIllegalChar = 'Illegal character';
+  sOverflowInArithmeticOperation = 'Overflow in arithmetic operation';
+  sDivByZero = 'Division by zero';
+
+type
+  { TResolveData - base class for data stored in TPasElement.CustomData }
+
+  TResolveData = Class(TPasElementBase)
+  private
+    FElement: TPasElement;
+    procedure SetElement(AValue: TPasElement);
+  public
+    Owner: TObject; // e.g. a TPasResolver
+    Next: TResolveData; // TPasResolver uses this for its memory chain
+    constructor Create; virtual;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;// Element.CustomData=Self
+  end;
+  TResolveDataClass = class of TResolveData;
+
+type
+  MaxPrecInt = int64;
+  MaxPrecUInt = qword;
+  MaxPrecFloat = extended;
+const
+  // Note: when FPC compares int64 with qword it converts the qword to an int64,
+  //       possibly resulting in a range check error -> using a qword const instead
+  HighIntAsUInt = MaxPrecUInt(High(MaxPrecInt));
+
+type
+  { TResEvalValue }
+
+  TREVKind = (
+    revkNone,
+    revkCustom,
+    revkNil,  // TResEvalValue
+    revkBool, // TResEvalBool
+    revkInt,  // TResEvalInt
+    revkUInt, // TResEvalUInt
+    revkFloat, // TResEvalFloat
+    revkString, // TResEvalString
+    revkUnicodeString, // TResEvalUTF16
+    revkEnum,     // TResEvalEnum
+    revkRangeInt, // range of enum, int, char, widechar, e.g. 1..2
+    revkRangeUInt, // range of uint, e.g. 1..2
+    revkSetEmpty, // []
+    revkSetOfInt  // set of enum, int, char, widechar, e.g. [1,2..3]
+    );
+  TResEvalValue = class(TResolveData)
+  public
+    Kind: TREVKind;
+    IdentEl: TPasElement;
+    constructor CreateKind(const aKind: TREVKind);
+    function Clone: TResEvalValue; virtual;
+    function AsDebugString: string; virtual;
+    function AsString: string; virtual;
+  end;
+  TResEvalValueClass = class of TResEvalValue;
+
+  { TResEvalBool }
+
+  TResEvalBool = class(TResEvalValue)
+  public
+    B: boolean;
+    constructor Create; override;
+    constructor CreateValue(const aValue: boolean);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalInt }
+
+  TResEvalInt = class(TResEvalValue)
+  public
+    Int: MaxPrecInt;
+    constructor Create; override;
+    constructor CreateValue(const aValue: MaxPrecInt);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalUInt }
+
+  TResEvalUInt = class(TResEvalValue)
+  public
+    UInt: MaxPrecUInt;
+    constructor Create; override;
+    constructor CreateValue(const aValue: MaxPrecUInt);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalFloat }
+
+  TResEvalFloat = class(TResEvalValue)
+  public
+    FloatValue: MaxPrecFloat;
+    constructor Create; override;
+    constructor CreateValue(const aValue: MaxPrecFloat);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalString - Kind=revkString }
+
+  TResEvalString = class(TResEvalValue)
+  public
+    S: RawByteString;
+    constructor Create; override;
+    constructor CreateValue(const aValue: RawByteString);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalUTF16 - Kind=revkUnicodeString }
+
+  TResEvalUTF16 = class(TResEvalValue)
+  public
+    S: UnicodeString;
+    constructor Create; override;
+    constructor CreateValue(const aValue: UnicodeString);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalEnum - Kind=revkEnum, Value.Int, IdentEl is TPasEnumValue }
+
+  TResEvalEnum = class(TResEvalValue)
+  public
+    Index: integer;
+    constructor Create; override;
+    constructor CreateValue(const aValue: integer; aIdentEl: TPasEnumValue);
+    function Clone: TResEvalValue; override;
+    function AsDebugString: string; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalRangeInt - Kind=revkRangeInt }
+
+  TResEvalRangeInt = class(TResEvalValue)
+  public
+    type
+      TRgIntElKind = (
+        revrikBool,
+        revrikEnum, // IdentEl is TPasEnumType
+        revrikInt,
+        revrikChar
+        );
+  public
+    ElKind: TRgIntElKind;
+    RangeStart, RangeEnd: MaxPrecInt;
+    constructor Create; override;
+    constructor CreateValue(const aElKind: TRgIntElKind;
+      const aRangeStart, aRangeEnd: MaxPrecInt);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+    function ElementAsString(El: MaxPrecInt): string;
+  end;
+
+  { TResEvalRangeUInt }
+
+  TResEvalRangeUInt = class(TResEvalValue)
+  public
+    RangeStart, RangeEnd: MaxPrecUInt;
+    constructor Create; override;
+    constructor CreateValue(const aRangeStart, aRangeEnd: MaxPrecUInt);
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalSetInt - Kind=revkASet }
+
+  TResEvalSetInt = class(TResEvalValue)
+  public
+    type
+      TSetElKind = (
+        revsikEnum, // IdentEl is TPasEnumType
+        revsikInt,
+        revsikChar,
+        revsikWChar
+        );
+      TItem = record
+        RangeStart, RangeEnd: MaxPrecInt;
+      end;
+      TItems = array of TItem;
+  public
+    ElKind: TSetElKind;
+    Ranges: TItems;
+    constructor Create; override;
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+    function ElementAsString(El: MaxPrecInt): string;
+  end;
+
+  TResEvalFlag = (
+    refConst, // computing a const, error if a value is not const
+    refAutoConst, // set refConst if in a const
+    refSet  // computing a set, allow ranges
+    );
+  TResEvalFlags = set of TResEvalFlag;
+
+  TResExprEvaluator = class;
+
+  TPasResEvalLogHandler = procedure(Sender: TResExprEvaluator; const id: int64;
+    MsgType: TMessageType; MsgNumber: integer;
+    const Fmt: String; Args: Array of const; PosEl: TPasElement) of object;
+  TPasResEvalIdentHandler = function(Sender: TResExprEvaluator;
+    Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue of object;
+  TPasResEvalParamsHandler = function(Sender: TResExprEvaluator;
+    Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue of object;
+
+  { TResExprEvaluator }
+
+  TResExprEvaluator = class
+  private
+    FOnEvalIdentifier: TPasResEvalIdentHandler;
+    FOnEvalParams: TPasResEvalParamsHandler;
+    FOnLog: TPasResEvalLogHandler;
+  protected
+    procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
+      const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
+    procedure RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String;
+      Args: Array of const; ErrorPosEl: TPasElement);
+    procedure RaiseNotYetImplemented(id: int64; El: TPasElement; Msg: string = ''); virtual;
+    procedure RaiseInternalError(id: int64; const Msg: string = '');
+    procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
+    procedure RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
+    procedure RaiseOverflowArithmetic(id: int64; ErrorEl: TPasElement);
+    procedure RaiseDivByZero(id: int64; ErrorEl: TPasElement);
+    function EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags): TResEvalValue;
+    function EvalBinaryExpr(Expr: TBinaryExpr; Flags: TResEvalFlags): TResEvalValue;
+    function EvalBinaryRangeExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryShiftExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalBinaryLessGreaterExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+    function EvalArrayParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
+    function EvalFuncParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
+    function EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
+    function ExprStringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
+    function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
+    function CreateResEvalInt(UInt: MaxPrecUInt): TResEvalValue; virtual;
+  public
+    function Eval(Expr: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
+    function IsInRange(Expr, RangeExpr: TPasExpr; EmitHints: boolean): boolean;
+    function IsConst(Expr: TPasExpr): boolean;
+    function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
+    procedure EmitRangeCheckConst(id: int64; const aValue, MinVal, MaxVal: String;
+      PosEl: TPasElement); virtual;
+    procedure EmitRangeCheckConst(id: int64; const aValue: String;
+      MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
+    property OnLog: TPasResEvalLogHandler read FOnLog write FOnLog;
+    property OnEvalIdentifier: TPasResEvalIdentHandler read FOnEvalIdentifier write FOnEvalIdentifier;
+    property OnEvalParams: TPasResEvalParamsHandler read FOnEvalParams write FOnEvalParams;
+  end;
+  TResExprEvaluatorClass = class of TResExprEvaluator;
+
+procedure ReleaseEvalValue(var Value: TResEvalValue);
+
+function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
+function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer): Unicodestring;
+function CanBeConvertedToUTF16(const s: String): integer;
+function CodePointToString(CodePoint: longword): String;
+function CodePointToUnicodeString(u: longword): UnicodeString;
+
+function GetObjName(o: TObject): string;
+function dbgs(const Flags: TResEvalFlags): string; overload;
+function dbgs(v: TResEvalValue): string; overload;
+
+implementation
+
+procedure ReleaseEvalValue(var Value: TResEvalValue);
+begin
+  if Value=nil then exit;
+  if Value.Element<>nil then exit;
+  Value.Free;
+  Value:=nil;
+end;
+
+function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
+var
+  s: RawByteString;
+  p: PAnsiChar;
+  InLit: boolean;
+  Len: integer;
+
+  procedure AddHash(o: integer);
+  var
+    h: String;
+  begin
+    if (Result<>'') and InLit then
+      begin
+      Result:=Result+'''';
+      inc(Len);
+      InLit:=false;
+      end;
+    h:='#'+IntToStr(o);
+    inc(Len,length(h));
+    if Len<=MaxLength then
+      Result:=Result+h;
+  end;
+
+  procedure AddLit(const Lit: string; CaptionLen: integer);
+  begin
+    if not InLit then
+      begin
+      Result:=Result+'''';
+      inc(Len);
+      InLit:=true;
+      end;
+    Result:=Result+Lit;
+    inc(Len,CaptionLen);
+  end;
+
+var
+  l: SizeInt;
+  CP: TSystemCodePage;
+  EndP: PAnsiChar;
+begin
+  Result:='';
+  s:=r;
+  CP:=StringCodePage(s);
+  if (CP<>CP_ACP) and (CP<>CP_UTF8) then
+    SetCodePage(s, CP_ACP, true);
+  p:=PAnsiChar(s);
+  EndP:=p+length(s);
+  Len:=0;
+  InLit:=false;
+  while Len<MaxLength do
+    case p^ of
+    #0:
+      begin
+      if p-PAnsiChar(s)=length(s) then
+        break;
+      AddHash(0);
+      inc(p);
+      end;
+    '''':
+      begin
+      AddLit('''''',2);
+      inc(p);
+      end;
+    #1..#31,#127..#192:
+      begin
+      AddHash(ord(p^));
+      inc(p);
+      end
+    else
+      begin
+      l:=Utf8CodePointLen(p,EndP-p,true);
+      if l<=0 then
+        begin
+        // invalid
+        AddHash(ord(p^));
+        inc(p);
+        end
+      else
+        begin
+        AddLit(copy(s,p-PAnsiChar(s)+1,l),1);
+        inc(p,l);
+        end;
+      end;
+    end;
+  if InLit then
+    Result:=Result+'''';
+end;
+
+function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer
+  ): Unicodestring;
+var
+  p: PWideChar;
+  InLit: boolean;
+  Len: integer;
+
+  procedure AddHash(o: integer);
+  var
+    h: UnicodeString;
+  begin
+    if (Result<>'') and InLit then
+      begin
+      Result:=Result+'''';
+      inc(Len);
+      InLit:=false;
+      end;
+    h:='#'+UnicodeString(IntToStr(o));
+    inc(Len,length(h));
+    if Len<=MaxLength then
+      Result:=Result+h;
+  end;
+
+  procedure AddLit(const Lit: Unicodestring; CaptionLen: integer);
+  begin
+    if not InLit then
+      begin
+      Result:=Result+'''';
+      inc(Len);
+      InLit:=true;
+      end;
+    Result:=Result+Lit;
+    inc(Len,CaptionLen);
+  end;
+
+begin
+  Result:='';
+  p:=PWideChar(u);
+  Len:=0;
+  InLit:=false;
+  while Len<MaxLength do
+    case p^ of
+    #0:
+      begin
+      if p-PWideChar(u)=length(u) then
+        break;
+      AddHash(0);
+      inc(p);
+      end;
+    '''':
+      begin
+      AddLit('''''',2);
+      inc(p);
+      end;
+    #1..#31,#127..#255,#$D800..#$ffff:
+      begin
+      AddHash(ord(p^));
+      inc(p);
+      end
+    else
+      begin
+      AddLit(p^,1);
+      inc(p);
+      end;
+    end;
+  if InLit then
+    Result:=Result+'''';
+end;
+
+function CanBeConvertedToUTF16(const s: String): integer;
+var
+  p, EndP: PAnsiChar;
+  cp: TSystemCodePage;
+  l: SizeInt;
+begin
+  if s='' then exit(0);
+  cp:=StringCodePage(s);
+  if (cp<>CP_UTF8) and ((cp<>CP_ACP) or (DefaultSystemCodePage<>CP_UTF8)) then
+    begin
+    // need conversion -> not yet supported
+    exit(1);
+    end;
+  p:=PChar(s);
+  EndP:=p+length(s);
+  while p<EndP do
+    begin
+    l:=Utf8CodePointLen(p,EndP-p,false);
+    if l<=0 then
+      exit(p-PAnsiChar(s)+1);
+    inc(p,l);
+    end;
+end;
+
+function CodePointToString(CodePoint: longword): String;
+begin
+  case CodePoint of
+    0..$7f:
+      begin
+        Result:=char(byte(CodePoint));
+      end;
+    $80..$7ff:
+      begin
+        Result:=char(byte($c0 or (CodePoint shr 6)))
+               +char(byte($80 or (CodePoint and $3f)));
+      end;
+    $800..$ffff:
+      begin
+        Result:=char(byte($e0 or (CodePoint shr 12)))
+               +char(byte((CodePoint shr 6) and $3f) or $80)
+               +char(byte(CodePoint and $3f) or $80);
+      end;
+    $10000..$10ffff:
+      begin
+        Result:=char(byte($f0 or (CodePoint shr 18)))
+               +char(byte((CodePoint shr 12) and $3f) or $80)
+               +char(byte((CodePoint shr 6) and $3f) or $80)
+               +char(byte(CodePoint and $3f) or $80);
+      end;
+  else
+    Result:='';
+  end;
+end;
+
+function CodePointToUnicodeString(u: longword): UnicodeString;
+begin
+  if u < $10000 then
+    // Note: codepoints $D800 - $DFFF are reserved
+    Result:=WideChar(u)
+  else
+    Result:=WideChar($D800+((u - $10000) shr 10))+WideChar($DC00+((u - $10000) and $3ff));
+end;
+
+function GetObjName(o: TObject): string;
+begin
+  if o=nil then
+    Result:='nil'
+  else if o is TPasElement then
+    Result:=TPasElement(o).Name+':'+o.ClassName
+  else
+    Result:=o.ClassName;
+end;
+
+function dbgs(const Flags: TResEvalFlags): string;
+var
+  s: string;
+  f: TResEvalFlag;
+begin
+  Result:='';
+  for f in Flags do
+    if f in Flags then
+      begin
+      if Result<>'' then Result:=Result+',';
+      str(f,s);
+      Result:=Result+s;
+      end;
+  Result:='['+Result+']';
+end;
+
+function dbgs(v: TResEvalValue): string;
+begin
+  if v=nil then
+    Result:='nil'
+  else
+    Result:=v.AsDebugString;
+end;
+
+{ TResEvalBool }
+
+constructor TResEvalBool.Create;
+begin
+  inherited Create;
+  Kind:=revkBool;
+end;
+
+constructor TResEvalBool.CreateValue(const aValue: boolean);
+begin
+  Create;
+  B:=aValue;
+end;
+
+function TResEvalBool.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalBool(Result).B:=B;
+end;
+
+function TResEvalBool.AsString: string;
+begin
+  if B then Result:='false' else Result:='true';
+end;
+
+{ TResEvalRangeUInt }
+
+constructor TResEvalRangeUInt.Create;
+begin
+  inherited Create;
+  Kind:=revkRangeInt;
+end;
+
+constructor TResEvalRangeUInt.CreateValue(const aRangeStart,
+  aRangeEnd: MaxPrecUInt);
+begin
+  Create;
+  RangeStart:=aRangeStart;
+  RangeEnd:=aRangeEnd;
+end;
+
+function TResEvalRangeUInt.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalRangeUInt(Result).RangeStart:=RangeStart;
+  TResEvalRangeUInt(Result).RangeEnd:=RangeEnd;
+end;
+
+function TResEvalRangeUInt.AsString: string;
+begin
+  Result:=IntToStr(RangeStart)+'..'+IntToStr(RangeEnd);
+end;
+
+{ TResExprEvaluator }
+
+procedure TResExprEvaluator.LogMsg(const id: int64; MsgType: TMessageType;
+  MsgNumber: integer; const Fmt: String; Args: array of const;
+  PosEl: TPasElement);
+begin
+  OnLog(Self,id,MsgType,MsgNumber,Fmt,Args,PosEl);
+end;
+
+procedure TResExprEvaluator.RaiseMsg(const Id: int64; MsgNumber: integer;
+  const Fmt: String; Args: array of const; ErrorPosEl: TPasElement);
+begin
+  LogMsg(id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
+  raise Exception.Create('['+IntToStr(id)+'] ('+IntToStr(MsgNumber)+') '+SafeFormat(Fmt,Args));
+end;
+
+procedure TResExprEvaluator.RaiseNotYetImplemented(id: int64; El: TPasElement;
+  Msg: string);
+var
+  s: String;
+begin
+  s:=sNotYetImplemented+' ['+IntToStr(id)+']';
+  if Msg<>'' then
+    s:=s+' '+Msg;
+  {$IFDEF VerbosePasResolver}
+  writeln('TResExprEvaluator.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
+  {$ENDIF}
+  RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
+end;
+
+procedure TResExprEvaluator.RaiseInternalError(id: int64; const Msg: string);
+begin
+  raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
+end;
+
+procedure TResExprEvaluator.RaiseConstantExprExp(id: int64; ErrorEl: TPasElement
+  );
+begin
+  RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
+end;
+
+procedure TResExprEvaluator.RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
+end;
+
+procedure TResExprEvaluator.RaiseOverflowArithmetic(id: int64;
+  ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nOverflowInArithmeticOperation,sOverflowInArithmeticOperation,[],ErrorEl);
+end;
+
+procedure TResExprEvaluator.RaiseDivByZero(id: int64; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nDivByZero,sDivByZero,[],ErrorEl);
+end;
+
+function TResExprEvaluator.EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags
+  ): TResEvalValue;
+begin
+  Result:=Eval(Expr.Operand,Flags);
+  if Result=nil then exit;
+  case Expr.OpCode of
+    eopAdd: ;
+    eopSubtract:
+      case Result.Kind of
+      revkInt:
+        begin
+        if TResEvalInt(Result).Int=0 then exit;
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalInt(Result).Int:=-TResEvalInt(Result).Int;
+        end;
+      revkUInt:
+        begin
+        if TResEvalUInt(Result).UInt=0 then exit;
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalUInt(Result).UInt:=-TResEvalUInt(Result).UInt;
+        end;
+      else
+        begin
+        if Result.Element=nil then
+          Result.Free;
+        RaiseNotYetImplemented(20170518230738,Expr);
+        end;
+      end;
+    eopNot:
+      case Result.Kind of
+      revkBool:
+        begin
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalBool(Result).B:=not TResEvalBool(Result).B;
+        end;
+      revkInt:
+        begin
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
+        end;
+      revkUInt:
+        begin
+        if Result.Element<>nil then
+          Result:=Result.Clone;
+        TResEvalUInt(Result).UInt:=not TResEvalUInt(Result).UInt;
+        end;
+      else
+        begin
+        if Result.Element=nil then
+          Result.Free;
+        RaiseNotYetImplemented(20170518232804,Expr);
+        end;
+      end;
+    eopAddress:
+      begin
+      if Result.Element=nil then
+        Result.Free;
+      // @ operator requires a compiler (not just a resolver) -> return nil
+      Result:=TResEvalValue.CreateKind(revkNil);
+      end
+    else
+      RaiseNotYetImplemented(20170518232823,Expr,'operator='+OpcodeStrings[Expr.OpCode]);
+    end;
+end;
+
+function TResExprEvaluator.EvalBinaryExpr(Expr: TBinaryExpr;
+  Flags: TResEvalFlags): TResEvalValue;
+var
+  LeftValue, RightValue: TResEvalValue;
+begin
+  Result:=nil;
+  LeftValue:=nil;
+  RightValue:=nil;
+  try
+    LeftValue:=Eval(Expr.left,Flags);
+    if LeftValue=nil then exit;
+    RightValue:=Eval(Expr.right,Flags);
+    if RightValue=nil then exit;
+    case Expr.Kind of
+    pekRange:
+      // leftvalue..rightvalue
+      Result:=EvalBinaryRangeExpr(Expr,LeftValue,RightValue);
+    pekBinary:
+      case Expr.OpCode of
+      eopAdd:
+        Result:=EvalBinaryAddExpr(Expr,LeftValue,RightValue);
+      eopSubtract:
+        Result:=EvalBinarySubExpr(Expr,LeftValue,RightValue);
+      eopMultiply:
+        Result:=EvalBinaryMulExpr(Expr,LeftValue,RightValue);
+      eopDiv:
+        Result:=EvalBinaryDivExpr(Expr,LeftValue,RightValue);
+      eopMod:
+        Result:=EvalBinaryModExpr(Expr,LeftValue,RightValue);
+      eopPower:
+        Result:=EvalBinaryPowerExpr(Expr,LeftValue,RightValue);
+      eopShl,eopShr:
+        Result:=EvalBinaryShiftExpr(Expr,LeftValue,RightValue);
+      eopAnd,eopOr,eopXor:
+        Result:=EvalBinaryBoolOpExpr(Expr,LeftValue,RightValue);
+      eopEqual,eopNotEqual:
+        Result:=EvalBinaryNEqualExpr(Expr,LeftValue,RightValue);
+      eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
+        Result:=EvalBinaryLessGreaterExpr(Expr,LeftValue,RightValue);
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryExpr Opcode=',OpcodeStrings[Expr.OpCode],' Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170530100823,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryExpr Kind=',Expr.Kind,' Opcode=',OpcodeStrings[Expr.OpCode]);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530100827,Expr);
+    end;
+    {$IFDEF VerbosePasResEval}
+    if Result<>nil then
+      writeln('TResExprEvaluator.EvalBinaryExpr Left=',LeftValue.AsDebugString,' Opcode=',OpcodeStrings[Expr.OpCode],' Right=',RightValue.AsDebugString,' Result=',Result.AsDebugString)
+    else
+      writeln('TResExprEvaluator.EvalBinaryExpr Left=',LeftValue.AsDebugString,' Opcode=',OpcodeStrings[Expr.OpCode],' Right=',RightValue.AsDebugString,' Result not set');
+    {$ENDIF}
+  finally
+    ReleaseEvalValue(LeftValue);
+    ReleaseEvalValue(RightValue);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryRangeExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+// LeftValue..RightValue
+var
+  LeftInt, RightInt: LongWord;
+begin
+  case LeftValue.Kind of
+  revkInt:
+    if RightValue.Kind=revkInt then
+      begin
+      if TResEvalInt(LeftValue).Int>TResEvalInt(RightValue).Int then
+        RaiseMsg(20170518222939,nHighRangeLimitLTLowRangeLimit,
+          sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+      Result:=TResEvalRangeInt.CreateValue(revrikInt,
+                        TResEvalInt(LeftValue).Int,TResEvalInt(RightValue).Int);
+      exit;
+      end
+    else if RightValue.Kind=revkUInt then
+      begin
+      // Note: when FPC compares int64 with qword it converts the qword to an int64
+      if TResEvalUInt(RightValue).UInt<=HighIntAsUInt then
+        begin
+        if TResEvalInt(LeftValue).Int>TResEvalUInt(RightValue).UInt then
+          RaiseMsg(20170519000235,nHighRangeLimitLTLowRangeLimit,
+            sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+        Result:=TResEvalRangeInt.CreateValue(revrikInt,
+           TResEvalInt(LeftValue).Int,MaxPrecInt(TResEvalUInt(RightValue).UInt));
+        exit;
+        end
+      else if TResEvalInt(LeftValue).Int<0 then
+        RaiseRangeCheck(20170522151629,Expr.Right)
+      else if MaxPrecUInt(TResEvalInt(LeftValue).Int)>TResEvalUInt(RightValue).UInt then
+        RaiseMsg(20170522151708,nHighRangeLimitLTLowRangeLimit,
+          sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+      Result:=TResEvalRangeUInt.CreateValue(MaxPrecUInt(TResEvalInt(LeftValue).Int),
+         TResEvalUInt(RightValue).UInt);
+      exit;
+      end
+    else
+      RaiseRangeCheck(20170518222812,Expr.Right);
+  revkUInt:
+    if RightValue.Kind=revkInt then
+      begin
+      // Note: when FPC compares int64 with qword it converts the qword to an int64
+      if TResEvalUInt(LeftValue).UInt>HighIntAsUInt then
+        begin
+        if TResEvalInt(RightValue).Int<0 then
+          RaiseRangeCheck(20170522152608,Expr.Right)
+        else if TResEvalUInt(LeftValue).UInt>MaxPrecUInt(TResEvalInt(RightValue).Int) then
+          RaiseMsg(20170522152648,nHighRangeLimitLTLowRangeLimit,
+            sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+        Result:=TResEvalRangeUInt.CreateValue(TResEvalUInt(LeftValue).UInt,
+          MaxPrecUInt(TResEvalInt(RightValue).Int));
+        exit;
+        end
+      else if TResEvalUInt(LeftValue).UInt>TResEvalInt(RightValue).Int then
+        RaiseMsg(20170522152804,nHighRangeLimitLTLowRangeLimit,
+          sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+      Result:=TResEvalRangeInt.CreateValue(revrikInt,
+        MaxPrecInt(TResEvalUInt(LeftValue).UInt),TResEvalInt(RightValue).Int);
+      exit;
+      end
+    else if RightValue.Kind=revkUInt then
+      begin
+      if TResEvalUInt(LeftValue).UInt>TResEvalUInt(RightValue).UInt then
+        RaiseMsg(20170519000240,nHighRangeLimitLTLowRangeLimit,
+          sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+      Result:=TResEvalRangeUInt.CreateValue(TResEvalUInt(LeftValue).UInt,
+        TResEvalUInt(RightValue).UInt);
+      exit;
+      end
+    else
+      RaiseRangeCheck(20170522123106,Expr.Right);
+  revkEnum:
+    if (RightValue.Kind<>revkEnum) then
+      RaiseRangeCheck(20170522153003,Expr.Right)
+    else if (TResEvalEnum(LeftValue).IdentEl<>TResEvalEnum(RightValue).IdentEl) then
+      RaiseRangeCheck(20170522123241,Expr.Right)
+    else if TResEvalEnum(LeftValue).Index>TResEvalEnum(RightValue).Index then
+      RaiseMsg(20170522123320,nHighRangeLimitLTLowRangeLimit,
+        sHighRangeLimitLTLowRangeLimit,[],Expr.Right)
+    else
+      begin
+      Result:=TResEvalRangeInt.CreateValue(revrikEnum,
+        TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index);
+      exit;
+      end;
+  revkString,revkUnicodeString:
+    begin
+    LeftInt:=ExprStringToOrd(LeftValue,Expr.left);
+    if RightValue.Kind in [revkString,revkUnicodeString] then
+      begin
+      RightInt:=ExprStringToOrd(RightValue,Expr.right);
+      if LeftInt>RightInt then
+        RaiseMsg(20170523151508,nHighRangeLimitLTLowRangeLimit,
+          sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
+      Result:=TResEvalRangeInt.CreateValue(revrikChar,LeftInt,RightInt);
+      exit;
+      end
+    else
+      RaiseRangeCheck(20170522123106,Expr.Right);
+    end
+  else
+    {$IFDEF EnablePasResRangeCheck}
+    writeln('TResExprEvaluator.EvalBinaryRangeExpr Left=',GetObjName(Expr.Left),' LeftValue.Kind=',LeftValue.Kind);
+    RaiseNotYetImplemented(20170518221103,Expr.Left);
+    {$ELSE}
+    exit(nil);
+    {$ENDIF}
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+
+  procedure IntAddUInt(const i: MaxPrecInt; const u: MaxPrecUInt);
+  var
+    Int: MaxPrecInt;
+    UInt: MaxPrecUInt;
+  begin
+    if (i>=0) then
+      begin
+      UInt:=MaxPrecUInt(i)+u;
+      Result:=CreateResEvalInt(UInt);
+      end
+    else if u<=HighIntAsUInt then
+      begin
+      Int:=i + MaxPrecInt(u);
+      Result:=TResEvalInt.CreateValue(Int);
+      end
+    else
+      RaiseRangeCheck(20170601140523,Expr);
+  end;
+
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+  LeftCP, RightCP: TSystemCodePage;
+begin
+  Result:=nil;
+  try
+    {$Q+}
+    {$R+}
+    case LeftValue.Kind of
+    revkInt:
+      case RightValue.Kind of
+      revkInt:
+        // int+int
+        if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int>0) then
+          begin
+          UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int)+MaxPrecUInt(TResEvalInt(RightValue).Int);
+          Result:=CreateResEvalInt(UInt);
+          end
+        else
+          begin
+          Int:=TResEvalInt(LeftValue).Int + TResEvalInt(RightValue).Int;
+          Result:=TResEvalInt.CreateValue(Int);
+          end;
+      revkUInt:
+        IntAddUInt(TResEvalInt(LeftValue).Int,TResEvalUInt(RightValue).UInt);
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170525115537,Expr);
+      end;
+    revkUInt:
+      case RightValue.Kind of
+      revkInt:
+        IntAddUInt(TResEvalUInt(LeftValue).UInt,TResEvalInt(RightValue).Int);
+      revkUInt:
+        begin
+        UInt:=TResEvalUInt(LeftValue).UInt+TResEvalUInt(RightValue).UInt;
+        Result:=TResEvalUInt.CreateValue(UInt);
+        end
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170601141031,Expr);
+      end;
+    revkString:
+      case RightValue.Kind of
+      revkString:
+        begin
+        LeftCP:=StringCodePage(TResEvalString(LeftValue).S);
+        RightCP:=StringCodePage(TResEvalString(RightValue).S);
+        if (LeftCP=RightCP)
+            or ((LeftCP=CP_ACP) and (RightCP=DefaultSystemCodePage))
+            or ((RightCP=CP_ACP) and (LeftCP=DefaultSystemCodePage)) then
+          begin
+          Result:=TResEvalString.Create;
+          TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
+          end
+        else
+          begin
+          Result:=TResEvalUTF16.Create;
+          TResEvalUTF16(Result).S:=UnicodeString(TResEvalString(LeftValue).S)+UnicodeString(TResEvalString(RightValue).S);
+          end;
+        end;
+      revkUnicodeString:
+        begin
+        Result:=TResEvalUTF16.Create;
+        TResEvalUTF16(Result).S:=UnicodeString(TResEvalString(LeftValue).S)+TResEvalUTF16(RightValue).S;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170601141834,Expr);
+      end;
+    revkUnicodeString:
+      case RightValue.Kind of
+      revkString:
+        begin
+        Result:=TResEvalUTF16.Create;
+        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+UnicodeString(TResEvalString(RightValue).S);
+        end;
+      revkUnicodeString:
+        begin
+        Result:=TResEvalUTF16.Create;
+        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170601141811,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr ?+ Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170525115548,Expr);
+    end;
+  except
+    on EOverflow do
+      RaiseOverflowArithmetic(20170601140130,Expr);
+    on ERangeError do
+      RaiseRangeCheck(20170601140132,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      // int-int
+      try
+        {$Q+}
+        Int:=TResEvalInt(LeftValue).Int - TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        on E: EOverflow do
+          if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int<0) then
+            begin
+            UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int)+MaxPrecUInt(-TResEvalInt(RightValue).Int);
+            Result:=CreateResEvalInt(UInt);
+            end
+          else
+            RaiseOverflowArithmetic(20170525230247,Expr);
+      end;
+    // ToDo: int-uint
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170525230028,Expr);
+    end;
+  // ToDo: uint-int, uint-uint
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinarySubExpr sub ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170525225946,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      // int*int
+      try
+        {$Q+}
+        Int:=TResEvalInt(LeftValue).Int * TResEvalInt(RightValue).Int;
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        on E: EOverflow do
+          if (TResEvalInt(LeftValue).Int>0) and (TResEvalInt(RightValue).Int>0) then
+            try
+              // try uint*uint
+              {$Q+}
+              UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int) * MaxPrecUInt(TResEvalInt(RightValue).Int);
+              {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+              Result:=CreateResEvalInt(UInt);
+            except
+              on E: EOverflow do
+                RaiseOverflowArithmetic(20170530101616,Expr);
+            end
+          else
+            RaiseOverflowArithmetic(20170525230247,Expr);
+      end;
+    // ToDo: int*uint
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170525230028,Expr);
+    end;
+  // ToDo: uint*int, uint*uint
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryMulExpr mul ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170525225946,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      // int div int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170530102619,Expr)
+      else
+        begin
+        Int:=TResEvalInt(LeftValue).Int div TResEvalInt(RightValue).Int;
+        Result:=TResEvalInt.CreateValue(Int);
+        end;
+    revkUInt:
+      // int div uint
+      if TResEvalUInt(RightValue).UInt=0 then
+        RaiseDivByZero(20170530102745,Expr)
+      else
+        begin
+        if TResEvalUInt(RightValue).UInt>HighIntAsUInt then
+          Int:=0
+        else
+          Int:=TResEvalInt(LeftValue).Int div TResEvalUInt(RightValue).UInt;
+        Result:=TResEvalInt.CreateValue(Int);
+        end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryDivExpr int div ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530102403,Expr);
+    end;
+  revkUInt:
+    case RightValue.Kind of
+    revkInt:
+      // uint div int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170530103026,Expr)
+      else if TResEvalUInt(LeftValue).UInt<=HighIntAsUInt then
+        begin
+        Int:=MaxPrecInt(TResEvalUInt(LeftValue).UInt) div TResEvalInt(RightValue).Int;
+        Result:=TResEvalInt.CreateValue(Int);
+        end
+      else if TResEvalInt(RightValue).Int>0 then
+        begin
+        UInt:=TResEvalUInt(LeftValue).UInt div MaxPrecUInt(TResEvalInt(RightValue).Int);
+        Result:=CreateResEvalInt(UInt);
+        end
+      else
+        RaiseOverflowArithmetic(20170530104315,Expr);
+    revkUInt:
+      // uint div uint
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170530103026,Expr)
+      else
+        begin
+        UInt:=TResEvalUInt(LeftValue).UInt div TResEvalUInt(RightValue).UInt;
+        Result:=CreateResEvalInt(UInt);
+        end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryDivExpr uint div ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530102403,Expr);
+    end;
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170530102352,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      // int mod int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170530104638,Expr)
+      else
+        begin
+        Int:=TResEvalInt(LeftValue).Int mod TResEvalInt(RightValue).Int;
+        Result:=TResEvalInt.CreateValue(Int);
+        end;
+    revkUInt:
+      // int mod uint
+      if TResEvalUInt(RightValue).UInt=0 then
+        RaiseDivByZero(20170530104758,Expr)
+      else
+        begin
+        if TResEvalInt(LeftValue).Int<0 then
+          UInt:=MaxPrecUInt(-TResEvalInt(LeftValue).Int) mod TResEvalUInt(RightValue).UInt
+        else
+          UInt:=MaxPrecUInt(TResEvalInt(LeftValue).Int) mod TResEvalUInt(RightValue).UInt;
+        Result:=CreateResEvalInt(UInt);
+        end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryModExpr int mod ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530110057,Expr);
+    end;
+  revkUInt:
+    case RightValue.Kind of
+    revkInt:
+      // uint mod int
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170530110110,Expr)
+      else if TResEvalUInt(LeftValue).UInt<=HighIntAsUInt then
+        begin
+        Int:=MaxPrecInt(TResEvalUInt(LeftValue).UInt) mod TResEvalInt(RightValue).Int;
+        Result:=TResEvalInt.CreateValue(Int);
+        end
+      else if TResEvalInt(RightValue).Int>0 then
+        begin
+        UInt:=TResEvalUInt(LeftValue).UInt mod MaxPrecUInt(TResEvalInt(RightValue).Int);
+        Result:=CreateResEvalInt(UInt);
+        end
+      else
+        RaiseOverflowArithmetic(20170530110602,Expr);
+    revkUInt:
+      // uint div uint
+      if TResEvalInt(RightValue).Int=0 then
+        RaiseDivByZero(20170530110609,Expr)
+      else
+        begin
+        UInt:=TResEvalUInt(LeftValue).UInt mod TResEvalUInt(RightValue).UInt;
+        Result:=CreateResEvalInt(UInt);
+        end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryModExpr uint mod ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530110633,Expr);
+    end;
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryModExpr mod ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170530110644,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryShiftExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+  ShiftLeft: Boolean;
+begin
+  Result:=nil;
+  ShiftLeft:=Expr.OpCode=eopShl;
+  case LeftValue.Kind of
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      // int shl int
+      begin
+      if (TResEvalInt(RightValue).Int<0) or (TResEvalInt(RightValue).Int>63) then
+        EmitRangeCheckConst(20170530203840,IntToStr(TResEvalInt(RightValue).Int),0,63,Expr);
+      if ShiftLeft then
+        Int:=TResEvalInt(LeftValue).Int shl byte(TResEvalInt(RightValue).Int)
+      else
+        Int:=TResEvalInt(LeftValue).Int shr byte(TResEvalInt(RightValue).Int);
+      Result:=TResEvalInt.CreateValue(Int);
+      end;
+    revkUInt:
+      // int shl uint
+      begin
+      if (TResEvalUInt(RightValue).UInt>63) then
+        EmitRangeCheckConst(20170530203840,IntToStr(TResEvalUInt(RightValue).UInt),0,63,Expr);
+      if ShiftLeft then
+        Int:=TResEvalInt(LeftValue).Int shl byte(TResEvalUInt(RightValue).UInt)
+      else
+        Int:=TResEvalInt(LeftValue).Int shr byte(TResEvalUInt(RightValue).UInt);
+      Result:=TResEvalInt.CreateValue(Int);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryModExpr int shl/shr ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530205332,Expr);
+    end;
+  revkUInt:
+    case RightValue.Kind of
+    revkInt:
+      // uint shl int
+      begin
+      if (TResEvalInt(RightValue).Int<0) or (TResEvalInt(RightValue).Int>63) then
+        EmitRangeCheckConst(20170530205414,IntToStr(TResEvalInt(RightValue).Int),0,63,Expr);
+      if ShiftLeft then
+        UInt:=TResEvalUInt(LeftValue).UInt shl byte(TResEvalInt(RightValue).Int)
+      else
+        UInt:=TResEvalUInt(LeftValue).UInt shr byte(TResEvalInt(RightValue).Int);
+      Result:=CreateResEvalInt(UInt);
+      end;
+    revkUInt:
+      // uint shl uint
+      begin
+      if (TResEvalUInt(RightValue).UInt>63) then
+        EmitRangeCheckConst(20170530205601,IntToStr(TResEvalUInt(RightValue).UInt),0,63,Expr);
+      if ShiftLeft then
+        UInt:=TResEvalUInt(LeftValue).UInt shl byte(TResEvalUInt(RightValue).UInt)
+      else
+        UInt:=TResEvalUInt(LeftValue).UInt shr byte(TResEvalUInt(RightValue).UInt);
+      Result:=CreateResEvalInt(UInt);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryShiftExpr uint shl/shr ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530205640,Expr);
+    end;
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryShiftExpr shl/shr ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170530205646,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+// AND, OR, XOR
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkBool:
+    case RightValue.Kind of
+    revkBool:
+      begin
+      // logical and/or/xor
+      Result:=TResEvalBool.Create;
+      case Expr.OpCode of
+      eopAnd: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B and TResEvalBool(RightValue).B;
+      eopOr: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B or TResEvalBool(RightValue).B;
+      eopXor: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B xor TResEvalBool(RightValue).B;
+      end;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryBoolOpExpr bool ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170531011502,Expr);
+    end;
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      begin
+      // bitwise and/or/xor
+      Result:=TResEvalInt.Create;
+      case Expr.OpCode of
+      eopAnd: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int and TResEvalInt(RightValue).Int;
+      eopOr: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int or TResEvalInt(RightValue).Int;
+      eopXor: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int xor TResEvalInt(RightValue).Int;
+      end;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryBoolOpExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530211140,Expr);
+    end;
+  revkUInt:
+    case RightValue.Kind of
+    revkUInt:
+      begin
+      // bitwise and/or/xor
+      Result:=TResEvalUInt.Create;
+      case Expr.OpCode of
+      eopAnd: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt and TResEvalUInt(RightValue).UInt;
+      eopOr: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt or TResEvalUInt(RightValue).UInt;
+      eopXor: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt xor TResEvalUInt(RightValue).UInt;
+      end;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryBoolOpExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530211140,Expr);
+    end;
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryBoolOpExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170530205938,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  UInt: MaxPrecUInt;
+begin
+  Result:=TResEvalBool.Create;
+  try
+    {$Q+}
+    {$R+}
+    case LeftValue.Kind of
+    revkBool:
+      case RightValue.Kind of
+      revkBool:
+        TResEvalBool(Result).B:=TResEvalBool(LeftValue).B=TResEvalBool(RightValue).B;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryNEqualExpr bool ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170531011937,Expr);
+      end;
+    revkInt:
+      case RightValue.Kind of
+      revkInt:
+        TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalInt(RightValue).Int;
+      revkUInt:
+        TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalUInt(RightValue).UInt;
+      revkFloat:
+        TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalFloat(RightValue).FloatValue;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryNEqualExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170531012412,Expr);
+      end;
+    revkUInt:
+      begin
+      UInt:=TResEvalUInt(LeftValue).UInt;
+      case RightValue.Kind of
+      revkInt:
+        TResEvalBool(Result).B:=(UInt<=HighIntAsUInt)
+                               and (MaxPrecInt(UInt)=TResEvalInt(RightValue).Int);
+      revkUInt:
+        TResEvalBool(Result).B:=UInt=TResEvalUInt(RightValue).UInt;
+      revkFloat:
+        TResEvalBool(Result).B:=UInt=TResEvalFloat(RightValue).FloatValue;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryNEqualExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170601122803,Expr);
+      end;
+      end;
+    revkFloat:
+      case RightValue.Kind of
+      revkInt:
+        TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalInt(RightValue).Int;
+      revkUInt:
+        TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalUInt(RightValue).UInt;
+      revkFloat:
+        TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalFloat(RightValue).FloatValue;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryNEqualExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170601122806,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      Result.Free;
+      RaiseNotYetImplemented(20170531011931,Expr);
+    end;
+    {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+    {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+  except
+    on EOverflow do
+      RaiseOverflowArithmetic(20170601132729,Expr);
+    on ERangeError do
+      RaiseRangeCheck(20170601132740,Expr);
+  end;
+  if Expr.OpCode=eopNotEqual then
+    TResEvalBool(Result).B:=not TResEvalBool(Result).B;
+end;
+
+function TResExprEvaluator.EvalBinaryLessGreaterExpr(Expr: TBinaryExpr;
+  LeftValue, RightValue: TResEvalValue): TResEvalValue;
+begin
+  Result:=TResEvalBool.Create;
+  try
+    {$Q+}
+    {$R+}
+    case LeftValue.Kind of
+    revkInt:
+      case RightValue.Kind of
+      revkInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalInt(RightValue).Int;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalInt(RightValue).Int;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalInt(RightValue).Int;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalInt(RightValue).Int;
+        end;
+      revkUInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalUInt(RightValue).UInt;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalUInt(RightValue).UInt;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalUInt(RightValue).UInt;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalUInt(RightValue).UInt;
+        end;
+      revkFloat:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalFloat(RightValue).FloatValue;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalFloat(RightValue).FloatValue;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170601122512,Expr);
+      end;
+    revkUInt:
+      case RightValue.Kind of
+      revkInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalInt(RightValue).Int;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalInt(RightValue).Int;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalInt(RightValue).Int;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalInt(RightValue).Int;
+        end;
+      revkUInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalUInt(RightValue).UInt;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalUInt(RightValue).UInt;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalUInt(RightValue).UInt;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalUInt(RightValue).UInt;
+        end;
+      revkFloat:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalFloat(RightValue).FloatValue;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalFloat(RightValue).FloatValue;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170601133222,Expr);
+      end;
+    revkFloat:
+      case RightValue.Kind of
+      revkInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalInt(RightValue).Int;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalInt(RightValue).Int;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalInt(RightValue).Int;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalInt(RightValue).Int;
+        end;
+      revkUInt:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalUInt(RightValue).UInt;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalUInt(RightValue).UInt;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalUInt(RightValue).UInt;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalUInt(RightValue).UInt;
+        end;
+      revkFloat:
+        case Expr.OpCode of
+        eopLessThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThan:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalFloat(RightValue).FloatValue;
+        eopLessthanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalFloat(RightValue).FloatValue;
+        eopGreaterThanEqual:
+          TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalFloat(RightValue).FloatValue;
+        end;
+      else
+        {$IFDEF VerbosePasResolver}
+        writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+        {$ENDIF}
+        Result.Free;
+        RaiseNotYetImplemented(20170601133421,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      Result.Free;
+      RaiseNotYetImplemented(20170601122529,Expr);
+    end;
+  except
+    on EOverflow do
+      RaiseOverflowArithmetic(20170601132956,Expr);
+    on ERangeError do
+      RaiseRangeCheck(20170601132958,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
+  RightValue: TResEvalValue): TResEvalValue;
+var
+  Int: MaxPrecInt;
+begin
+  Result:=nil;
+  case LeftValue.Kind of
+  revkInt:
+    case RightValue.Kind of
+    revkInt:
+      // int^^int
+      try
+        {$Q+}{$R+}
+        Int:=trunc(Math.power(TResEvalInt(LeftValue).Int,TResEvalInt(RightValue).Int));
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        RaiseOverflowArithmetic(20170530210533,Expr);
+      end;
+    revkUInt:
+      // int^^uint
+      try
+        {$Q+}{$R+}
+        Int:=trunc(Math.power(TResEvalInt(LeftValue).Int,TResEvalUInt(RightValue).UInt));
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        RaiseOverflowArithmetic(20170530211028,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryPowerExpr int ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530205640,Expr);
+    end;
+  revkUInt:
+    case RightValue.Kind of
+    revkInt:
+      // uint^^int
+      try
+        {$Q+}{$R+}
+        Int:=trunc(Math.power(TResEvalUInt(LeftValue).UInt,TResEvalInt(RightValue).Int));
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        RaiseOverflowArithmetic(20170530211102,Expr);
+      end;
+    revkUInt:
+      // uint^^uint
+      try
+        {$Q+}{$R+}
+        Int:=trunc(Math.power(TResEvalUInt(LeftValue).UInt,TResEvalUInt(RightValue).UInt));
+        {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
+        {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
+        Result:=TResEvalInt.CreateValue(Int);
+      except
+        RaiseOverflowArithmetic(20170530211121,Expr);
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryPowerExpr uint ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530211140,Expr);
+    end;
+  else
+    {$IFDEF VerbosePasResolver}
+    writeln('TResExprEvaluator.EvalBinaryPowerExpr ^^ ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+    {$ENDIF}
+    RaiseNotYetImplemented(20170530205938,Expr);
+  end;
+end;
+
+function TResExprEvaluator.EvalArrayParams(Expr: TParamsExpr;
+  Flags: TResEvalFlags): TResEvalValue;
+begin
+  Result:=nil;
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalArrayParams ');
+  {$ENDIF}
+  if refConst in Flags then
+    RaiseConstantExprExp(20170522173150,Expr);
+end;
+
+function TResExprEvaluator.EvalFuncParams(Expr: TParamsExpr;
+  Flags: TResEvalFlags): TResEvalValue;
+begin
+  Result:=nil;
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalFuncParams ');
+  {$ENDIF}
+  Result:=OnEvalParams(Self,Expr,Flags);
+  if (refConst in Flags) and (Result=nil) then
+    RaiseConstantExprExp(20170522173150,Expr);
+end;
+
+function TResExprEvaluator.EvalSetParams(Expr: TParamsExpr; Flags: TResEvalFlags
+  ): TResEvalValue;
+begin
+  Result:=nil;
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalSetParams ');
+  {$ENDIF}
+  if length(Expr.Params)=0 then
+    begin
+    Result:=TResEvalValue.CreateKind(revkSetEmpty);
+    exit;
+    end;
+  if refConst in Flags then
+    RaiseConstantExprExp(20170522173150,Expr);
+end;
+
+function TResExprEvaluator.ExprStringToOrd(Value: TResEvalValue;
+  PosEl: TPasElement): longword;
+var
+  l: SizeInt;
+  S: RawByteString;
+  U: UnicodeString;
+begin
+  if Value.Kind=revkString then
+    begin
+    S:=TResEvalString(Value).S;
+    l:=length(S);
+    if l=0 then
+      RaiseMsg(20170522221143,nXExpectedButYFound,sXExpectedButYFound,
+        ['char','string'],PosEl)
+    else if l=1 then
+      Result:=ord(S[1])
+    else if l<=4 then
+      begin
+      U:=UTF8Decode(S);
+      if length(U)<>1 then
+        RaiseMsg(20170523150826,nXExpectedButYFound,sXExpectedButYFound,
+          ['char','string'],PosEl);
+      Result:=ord(U[1]);
+      end;
+    end
+  else if Value.Kind=revkUnicodeString then
+    begin
+    if length(TResEvalUTF16(Value).S)<>1 then
+      RaiseMsg(20170522221358,nXExpectedButYFound,sXExpectedButYFound,
+        ['char','string'],PosEl)
+    else
+      Result:=ord(TResEvalUTF16(Value).S[1]);
+    end
+  else
+    RaiseNotYetImplemented(20170522220959,PosEl);
+end;
+
+function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
+  ): TResEvalValue;
+{ Extracts the value from a Pascal string literal
+
+  S is a Pascal string literal e.g. 'Line'#10
+    ''  empty string
+    '''' => "'"
+    #decimal
+    #$hex
+    ^l  l is a letter a-z
+}
+
+  procedure RangeError(id: int64);
+  begin
+    Result.Free;
+    RaiseRangeCheck(id,Expr);
+  end;
+
+  procedure Add(h: String);
+  begin
+    if Result.Kind=revkString then
+      TResEvalString(Result).S:=TResEvalString(Result).S+h
+    else
+      begin
+      if CanBeConvertedToUTF16(h)>0 then
+        begin
+        Result.Free;
+        RaiseMsg(20170523114733,nIllegalChar,sIllegalChar,[],Expr);
+        end;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+UnicodeString(h);
+      end;
+  end;
+
+  procedure AddHash(u: longword);
+  var
+    h: RawByteString;
+  begin
+    if (u>255) and (Result.Kind=revkString) then
+      begin
+      h:=TResEvalString(Result).S;
+      Result.Free;
+      if CanBeConvertedToUTF16(h)>0 then
+        RaiseMsg(20170523123140,nIllegalChar,sIllegalChar,[],Expr);
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=UnicodeString(h);
+      end;
+    if Result.Kind=revkString then
+      TResEvalString(Result).S:=TResEvalString(Result).S+Chr(u)
+    else
+      TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
+  end;
+
+var
+  p, StartP: PChar;
+  c: Char;
+  u: longword;
+  S: String;
+begin
+  Result:=nil;
+  S:=Expr.Value;
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalPrimitiveExprString (',S,')');
+  {$ENDIF}
+  if S='' then
+    RaiseInternalError(20170523113809);
+  Result:=TResEvalString.Create;
+  p:=PChar(S);
+  repeat
+    case p^ of
+    #0: break;
+    '''':
+      begin
+      inc(p);
+      StartP:=p;
+      repeat
+        c:=p^;
+        case c of
+        #0:
+          RaiseInternalError(20170523113938);
+        '''':
+          begin
+          if p>StartP then
+            Add(copy(S,StartP-PChar(S)+1,p-StartP));
+          inc(p);
+          StartP:=p;
+          if p^<>'''' then
+            break;
+          Add('''');
+          inc(p);
+          StartP:=p;
+          end;
+        else
+          inc(p);
+        end;
+      until false;
+      if p>StartP then
+        Add(copy(S,StartP-PChar(S)+1,p-StartP));
+      end;
+    '#':
+      begin
+      inc(p);
+      if p^='$' then
+        begin
+        // #$hexnumber
+        inc(p);
+        StartP:=p;
+        u:=0;
+        repeat
+          c:=p^;
+          case c of
+          #0: break;
+          '0'..'9': u:=u*16+ord(c)-ord('0');
+          'a'..'f': u:=u*16+ord(c)-ord('a')+10;
+          'A'..'F': u:=u*16+ord(c)-ord('A')+10;
+          else break;
+          end;
+          if u>$ffff then
+            RangeError(20170523115712);
+          inc(p);
+        until false;
+        if p=StartP then
+          RaiseInternalError(20170207164956);
+        AddHash(u);
+        end
+      else
+        begin
+        // #decimalnumber
+        StartP:=p;
+        u:=0;
+        repeat
+          c:=p^;
+          case c of
+          #0: break;
+          '0'..'9': u:=u*10+ord(c)-ord('0');
+          else break;
+          end;
+          if u>$ffff then
+            RangeError(20170523123137);
+          inc(p);
+        until false;
+        if p=StartP then
+          RaiseInternalError(20170523123806);
+        AddHash(u);
+        end;
+      end;
+    '^':
+      begin
+      // ^A is #1
+      inc(p);
+      c:=p^;
+      case c of
+      'a'..'z': AddHash(ord(c)-ord('a')+1);
+      'A'..'Z': AddHash(ord(c)-ord('A')+1);
+      else RaiseInternalError(20170523123809);
+      end;
+      inc(p);
+      end;
+    else
+      RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(p^)));
+    end;
+  until false;
+  {$IFDEF VerbosePasResEval}
+  writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
+  {$ENDIF}
+end;
+
+function TResExprEvaluator.CreateResEvalInt(UInt: MaxPrecUInt): TResEvalValue;
+begin
+  if UInt<=HighIntAsUInt then
+    Result:=TResEvalInt.CreateValue(MaxPrecInt(UInt))
+  else
+    Result:=TResEvalUInt.CreateValue(UInt);
+end;
+
+function TResExprEvaluator.Eval(Expr: TPasExpr; Flags: TResEvalFlags
+  ): TResEvalValue;
+var
+  C: TClass;
+  Code: integer;
+  Int: MaxPrecInt;
+  UInt: MaxPrecUInt;
+  Flo: MaxPrecFloat;
+begin
+  Result:=nil;
+  if Expr.CustomData is TResEvalValue then
+    begin
+    Result:=TResEvalValue(Expr.CustomData);
+    exit;
+    end;
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
+  {$ENDIF}
+  if refAutoConst in Flags then
+    begin
+    Exclude(Flags,refAutoConst);
+    if IsConst(Expr) then
+      Include(Flags,refConst);
+    end;
+
+  C:=Expr.ClassType;
+  if C=TPrimitiveExpr then
+    begin
+    case TPrimitiveExpr(Expr).Kind of
+      pekIdent:
+        Result:=OnEvalIdentifier(Self,TPrimitiveExpr(Expr),Flags);
+      pekNumber:
+        begin
+        // try MaxPrecInt
+        val(TPrimitiveExpr(Expr).Value,Int,Code);
+        if Code=0 then
+          begin
+          Result:=TResEvalInt.CreateValue(Int);
+          exit;
+          end;
+        // try MaxPrecUInt
+        val(TPrimitiveExpr(Expr).Value,UInt,Code);
+        if Code=0 then
+          begin
+          Result:=TResEvalUInt.CreateValue(UInt);
+          exit;
+          end;
+        // try float
+        val(TPrimitiveExpr(Expr).Value,Flo,Code);
+        if Code=0 then
+          begin
+          Result:=TResEvalFloat.CreateValue(Flo);
+          exit;
+          end;
+        RaiseRangeCheck(20170518202252,Expr);
+        end;
+      pekString:
+        begin
+        Result:=EvalPrimitiveExprString(TPrimitiveExpr(Expr));
+        exit;
+        end;
+    else
+      RaiseNotYetImplemented(20170518200951,Expr);
+    end;
+    end
+  else if C=TNilExpr then
+    Result:=TResEvalValue.CreateKind(revkNil)
+  else if C=TBoolConstExpr then
+    Result:=TResEvalBool.CreateValue(TBoolConstExpr(Expr).Value)
+  else if C=TUnaryExpr then
+    Result:=EvalUnaryExpr(TUnaryExpr(Expr),Flags)
+  else if C=TBinaryExpr then
+    Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
+  else if C=TParamsExpr then
+    case TParamsExpr(Expr).Kind of
+    pekArrayParams: Result:=EvalArrayParams(TParamsExpr(Expr),Flags);
+    pekFuncParams: Result:=EvalFuncParams(TParamsExpr(Expr),Flags);
+    pekSet: Result:=EvalSetParams(TParamsExpr(Expr),Flags);
+    else
+      RaiseInternalError(20170522173013);
+    end
+  else if refConst in Flags then
+    RaiseConstantExprExp(20170518213800,Expr);
+end;
+
+function TResExprEvaluator.IsInRange(Expr, RangeExpr: TPasExpr;
+  EmitHints: boolean): boolean;
+var
+  ExprValue, RangeValue: TResEvalValue;
+  RgInt: TResEvalRangeInt;
+  RgUInt: TResEvalRangeUInt;
+  CharIndex: LongWord;
+begin
+  Result:=false;
+  ExprValue:=Eval(Expr,[refAutoConst]);
+  if ExprValue=nil then
+    exit(true); // a variable -> ok
+  RangeValue:=nil;
+  try
+    RangeValue:=Eval(RangeExpr,[]);
+    {$IFDEF VerbosePasResEval}
+    //writeln('TResExprEvaluator.IsInRange ExprValue=',dbgs(ExprValue),' RangeValue=',dbgs(RangeValue));
+    {$ENDIF}
+    if RangeValue=nil then
+      RaiseNotYetImplemented(20170522171226,RangeExpr);
+    case RangeValue.Kind of
+    revkSetEmpty:
+      begin
+      Result:=false;
+      exit;
+      end;
+    revkRangeInt:
+      begin
+      RgInt:=TResEvalRangeInt(RangeValue);
+      case RgInt.ElKind of
+        revrikBool:
+          if ExprValue.Kind=revkBool then
+            exit(true)
+          else
+            RaiseNotYetImplemented(20170522220104,Expr);
+        revrikEnum:
+          begin
+          if ExprValue.Kind<>revkEnum then
+            RaiseInternalError(20170522172754)
+          else if ExprValue.IdentEl<>RgInt.IdentEl then
+            RaiseInternalError(20170522174028)
+          else if (TResEvalEnum(ExprValue).Index<RgInt.RangeStart)
+              or (TResEvalEnum(ExprValue).Index>RgInt.RangeEnd) then
+            begin
+            if EmitHints then
+              EmitRangeCheckConst(20170522174406,ExprValue.AsString,
+                RgInt.ElementAsString(RgInt.RangeStart),
+                RgInt.ElementAsString(RgInt.RangeEnd),
+                Expr);
+            exit(false);
+            end
+          else
+            exit(true);
+          end;
+        revrikInt: // int..int
+          if ExprValue.Kind=revkInt then
+            begin
+            // int in int..int
+            if (TResEvalInt(ExprValue).Int<RgInt.RangeStart)
+                or (TResEvalInt(ExprValue).Int>RgInt.RangeEnd) then
+              begin
+              if EmitHints then
+                EmitRangeCheckConst(20170522174958,ExprValue.AsString,
+                  RgInt.ElementAsString(RgInt.RangeStart),
+                  RgInt.ElementAsString(RgInt.RangeEnd),
+                  Expr);
+              exit(false);
+              end
+            else
+              exit(true);
+            end
+          else if ExprValue.Kind=revkUInt then
+            begin
+            // uint in int..int
+            if (TResEvalUInt(ExprValue).UInt>HighIntAsUInt)
+                or (MaxPrecInt(TResEvalUInt(ExprValue).UInt)<RgInt.RangeStart)
+                or (MaxPrecInt(TResEvalUInt(ExprValue).UInt)>RgInt.RangeEnd) then
+              begin
+              if EmitHints then
+                EmitRangeCheckConst(20170522215852,ExprValue.AsString,
+                  RgInt.ElementAsString(RgInt.RangeStart),
+                  RgInt.ElementAsString(RgInt.RangeEnd),
+                  Expr);
+              exit(false);
+              end
+            else
+              exit(true);
+            end
+          else
+            RaiseNotYetImplemented(20170522215906,Expr);
+        revrikChar:
+          if ExprValue.Kind in [revkString,revkUnicodeString] then
+            begin
+            // string in char..char
+            CharIndex:=ExprStringToOrd(ExprValue,Expr);
+            if (CharIndex<RgInt.RangeStart) or (CharIndex>RgInt.RangeEnd) then
+              begin
+              if EmitHints then
+                EmitRangeCheckConst(20170522221709,ExprValue.AsString,
+                  RgInt.ElementAsString(RgInt.RangeStart),
+                  RgInt.ElementAsString(RgInt.RangeEnd),
+                  Expr);
+              exit(false);
+              end
+            else
+              exit(true);
+            end
+          else
+            RaiseNotYetImplemented(20170522220210,Expr);
+      else
+        RaiseInternalError(20170522172630);
+      end;
+      end;
+    revkRangeUInt:
+      if ExprValue.Kind=revkInt then
+        begin
+        // int in uint..uint
+        RgUInt:=TResEvalRangeUInt(RangeValue);
+        if (TResEvalInt(ExprValue).Int<0)
+            or (MaxPrecUInt(TResEvalInt(ExprValue).Int)<RgUInt.RangeStart)
+            or (MaxPrecUInt(TResEvalInt(ExprValue).Int)>RgUInt.RangeEnd) then
+          begin
+          if EmitHints then
+            EmitRangeCheckConst(20170522172250,ExprValue.AsString,
+              IntToStr(RgUInt.RangeStart),
+              IntToStr(RgUInt.RangeEnd),Expr);
+          exit(false);
+          end
+        else
+          exit(true);
+        end
+      else if ExprValue.Kind=revkUInt then
+        begin
+        // uint in uint..uint
+        RgUInt:=TResEvalRangeUInt(RangeValue);
+        if (TResEvalUInt(ExprValue).UInt<RgUInt.RangeStart)
+            or (TResEvalUInt(ExprValue).UInt>RgUInt.RangeEnd) then
+          begin
+          if EmitHints then
+            EmitRangeCheckConst(20170522172544,IntToStr(TResEvalUInt(ExprValue).UInt),
+              IntToStr(RgUInt.RangeStart),
+              IntToStr(RgUInt.RangeEnd),Expr);
+          exit(false);
+          end
+        else
+          exit(true);
+        end
+      else
+        RaiseNotYetImplemented(20170522171551,Expr);
+    else
+      RaiseNotYetImplemented(20170522171307,RangeExpr);
+    end;
+  finally
+    ReleaseEvalValue(ExprValue);
+    ReleaseEvalValue(RangeValue);
+  end;
+end;
+
+function TResExprEvaluator.IsConst(Expr: TPasExpr): boolean;
+var
+  El: TPasElement;
+  C: TClass;
+begin
+  El:=Expr;
+  while El<>nil do
+    begin
+    C:=El.ClassType;
+    if C.InheritsFrom(TPasProcedure) then exit(true);
+    if C.InheritsFrom(TPasImplBlock) then exit(false);
+    El:=El.Parent;
+    end;
+  Result:=true;
+end;
+
+function TResExprEvaluator.IsSimpleExpr(Expr: TPasExpr): boolean;
+var
+  C: TClass;
+begin
+  C:=Expr.ClassType;
+  Result:=(C=TNilExpr)
+       or (C=TBoolConstExpr)
+       or (C=TPrimitiveExpr);
+end;
+
+procedure TResExprEvaluator.EmitRangeCheckConst(id: int64; const aValue,
+  MinVal, MaxVal: String; PosEl: TPasElement);
+begin
+  LogMsg(id,mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
+end;
+
+procedure TResExprEvaluator.EmitRangeCheckConst(id: int64;
+  const aValue: String; MinVal, MaxVal: MaxPrecInt; PosEl: TPasElement);
+begin
+  EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl);
+end;
+
+{ TResolveData }
+
+procedure TResolveData.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if Element<>nil then
+    Element.Release;
+  FElement:=AValue;
+  if Element<>nil then
+    Element.AddRef;
+end;
+
+constructor TResolveData.Create;
+begin
+
+end;
+
+destructor TResolveData.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TResolveData.Destroy START ',ClassName);
+  {$ENDIF}
+  Element:=nil;
+  Owner:=nil;
+  Next:=nil;
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TResolveData.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ TResEvalValue }
+
+constructor TResEvalValue.CreateKind(const aKind: TREVKind);
+begin
+  Create;
+  Kind:=aKind;
+end;
+
+function TResEvalValue.Clone: TResEvalValue;
+begin
+  Result:=TResEvalValueClass(ClassType).Create;
+  Result.Kind:=Kind;
+  Result.IdentEl:=IdentEl;
+end;
+
+function TResEvalValue.AsDebugString: string;
+begin
+  str(Kind,Result);
+  Result:=Result+'='+AsString;
+end;
+
+function TResEvalValue.AsString: string;
+begin
+  case Kind of
+    revkNone: Result:='<None>';
+    revkNil: Result:='nil';
+    revkSetEmpty: Result:='[]';
+  else
+    str(Kind,Result);
+  end;
+end;
+
+{ TResEvalUInt }
+
+constructor TResEvalUInt.Create;
+begin
+  inherited Create;
+  Kind:=revkUInt;
+end;
+
+constructor TResEvalUInt.CreateValue(const aValue: MaxPrecUInt);
+begin
+  Create;
+  UInt:=aValue;
+end;
+
+function TResEvalUInt.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalUInt(Result).UInt:=UInt;
+end;
+
+function TResEvalUInt.AsString: string;
+begin
+  Result:=IntToStr(UInt);
+end;
+
+{ TResEvalInt }
+
+constructor TResEvalInt.Create;
+begin
+  inherited Create;
+  Kind:=revkInt;
+end;
+
+constructor TResEvalInt.CreateValue(const aValue: MaxPrecInt);
+begin
+  Create;
+  Int:=aValue;
+end;
+
+function TResEvalInt.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalInt(Result).Int:=Int;
+end;
+
+function TResEvalInt.AsString: string;
+begin
+  Result:=IntToStr(Int);
+end;
+
+{ TResEvalFloat }
+
+constructor TResEvalFloat.Create;
+begin
+  inherited Create;
+  Kind:=revkFloat;
+end;
+
+constructor TResEvalFloat.CreateValue(const aValue: MaxPrecFloat);
+begin
+  Create;
+  FloatValue:=aValue;
+end;
+
+function TResEvalFloat.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalFloat(Result).FloatValue:=FloatValue;
+end;
+
+function TResEvalFloat.AsString: string;
+begin
+  str(FloatValue,Result);
+end;
+
+{ TResEvalString }
+
+constructor TResEvalString.Create;
+begin
+  inherited Create;
+  Kind:=revkString;
+end;
+
+constructor TResEvalString.CreateValue(const aValue: RawByteString);
+begin
+  Create;
+  S:=aValue;
+end;
+
+function TResEvalString.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalString(Result).S:=S;
+end;
+
+function TResEvalString.AsString: string;
+begin
+  Result:=RawStrToCaption(S,60);
+end;
+
+{ TResEvalUTF16 }
+
+constructor TResEvalUTF16.Create;
+begin
+  inherited Create;
+  Kind:=revkUnicodeString;
+end;
+
+constructor TResEvalUTF16.CreateValue(const aValue: UnicodeString);
+begin
+  Create;
+  S:=aValue;
+end;
+
+function TResEvalUTF16.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalUTF16(Result).S:=S;
+end;
+
+function TResEvalUTF16.AsString: string;
+begin
+  Result:=String(UnicodeStrToCaption(S,60));
+end;
+
+{ TResEvalEnum }
+
+constructor TResEvalEnum.Create;
+begin
+  inherited Create;
+  Kind:=revkEnum;
+end;
+
+constructor TResEvalEnum.CreateValue(const aValue: integer;
+  aIdentEl: TPasEnumValue);
+begin
+  Create;
+  Index:=aValue;
+  IdentEl:=aIdentEl;
+end;
+
+function TResEvalEnum.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalEnum(Result).Index:=Index;
+end;
+
+function TResEvalEnum.AsDebugString: string;
+begin
+  str(Kind,Result);
+  Result:=Result+'='+IdentEl.Name+'='+IntToStr(Index);
+end;
+
+function TResEvalEnum.AsString: string;
+begin
+  Result:=IdentEl.Name;
+end;
+
+{ TResEvalRangeInt }
+
+constructor TResEvalRangeInt.Create;
+begin
+  inherited Create;
+  Kind:=revkRangeInt;
+end;
+
+constructor TResEvalRangeInt.CreateValue(const aElKind: TRgIntElKind;
+  const aRangeStart, aRangeEnd: MaxPrecInt);
+begin
+  Create;
+  ElKind:=aElKind;
+  RangeStart:=aRangeStart;
+  RangeEnd:=aRangeEnd;
+end;
+
+function TResEvalRangeInt.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalRangeInt(Result).ElKind:=ElKind;
+  TResEvalRangeInt(Result).RangeStart:=RangeStart;
+  TResEvalRangeInt(Result).RangeEnd:=RangeEnd;
+end;
+
+function TResEvalRangeInt.AsString: string;
+begin
+  Result:=ElementAsString(RangeStart)+'..'+ElementAsString(RangeEnd);
+end;
+
+function TResEvalRangeInt.ElementAsString(El: MaxPrecInt): string;
+begin
+  case ElKind of
+    revrikBool: if El=0 then Result:='false' else Result:='true';
+    revrikEnum: Result:=TPasEnumValue(TPasEnumType(IdentEl).Values[El]).Name;
+    revrikInt: Result:=IntToStr(El);
+    revrikChar:
+      if ((El>=32) and (El<=38)) or ((El>=40) and (El<=126)) then
+        Result:=''''+Chr(El)+''''
+      else
+        Result:='#'+IntToStr(El);
+  end;
+end;
+
+{ TResEvalSetInt }
+
+constructor TResEvalSetInt.Create;
+begin
+  inherited Create;
+  Kind:=revkSetOfInt;
+end;
+
+function TResEvalSetInt.Clone: TResEvalValue;
+var
+  RS: TResEvalSetInt;
+  i: Integer;
+begin
+  Result:=inherited Clone;
+  TResEvalSetInt(Result).ElKind:=ElKind;
+  RS:=TResEvalSetInt(Result);
+  SetLength(RS.Ranges,length(Ranges));
+  for i:=0 to length(Ranges)-1 do
+    RS.Ranges[i]:=Ranges[i];
+end;
+
+function TResEvalSetInt.AsString: string;
+var
+  i: Integer;
+begin
+  Result:='[';
+  for i:=0 to length(Ranges)-1 do
+    begin
+    if i>0 then Result:=Result+',';
+    Result:=Result+ElementAsString(Ranges[i].RangeStart);
+    if Ranges[i].RangeStart<>Ranges[i].RangeEnd then
+      Result:=Result+'..'+ElementAsString(Ranges[i].RangeEnd);
+    end;
+  Result:=Result+']';
+end;
+
+function TResEvalSetInt.ElementAsString(El: MaxPrecInt): string;
+begin
+  case ElKind of
+    revsikEnum: Result:=TPasEnumValue(TPasEnumType(IdentEl).Values[El]).Name;
+    revsikInt: Result:=IntToStr(El);
+    revsikChar: Result:=Chr(El);
+    revsikWChar: Result:=String(WideChar(El));
+  end;
+end;
+
+end.
+
diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp
new file mode 100644
index 0000000000..51ae9576d5
--- /dev/null
+++ b/packages/fcl-passrc/src/pasresolver.pp
@@ -0,0 +1,13178 @@
+{
+    This file is part of the Free Component Library
+
+    Pascal source parser
+    Copyright (c) 2000-2005 by
+      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
+
+    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.
+
+ **********************************************************************
+
+Abstract:
+  Resolves references by setting TPasElement.CustomData as TResolvedReference.
+  Creates search scopes for elements with sub identifiers by setting
+    TPasElement.CustomData as TPasScope: unit, program, library, interface,
+    implementation, procs
+
+Works:
+- built-in types as TPasUnresolvedSymbolRef: longint, int64, string, pointer, ...
+- references in statements, error if not found
+- interface and implementation types, vars, const
+- params, local types, vars, const
+- nested procedures
+- nested forward procs, nested must be resolved before proc body
+- program/library/implementation forward procs
+- search in used units
+- unitname.identifier
+- alias types, 'type a=b'
+- type alias type 'type a=type b'
+- choose the most compatible overloaded procedure
+- while..do
+- repeat..until
+- if..then..else
+- binary operators
+- case..of
+- try..finally..except, on, else, raise
+- for loop
+- spot duplicates
+- type cast base types
+- char
+  - ord(), chr()
+- record
+  - variants
+  - const param makes children const too
+- class:
+  - forward declaration
+  - instance.a
+  - find ancestor, search in ancestors
+  - virtual, abstract, override
+  - method body
+  - Self
+  - inherited
+  - property
+    - read var, read function
+    - write var, write function
+    - stored function
+    - defaultexpr
+  - is and as operator
+  - nil
+  - constructor result type, rrfNewInstance
+  - destructor call type: rrfFreeInstance
+  - type cast
+  - class of
+  - class method, property, var, const
+  - class-of.constructor
+  - class-of typecast upwards/downwards
+  - class-of option to allow is-operator
+  - typecast Self in class method upwards/downwards
+  - property with params
+  - default property
+  - visibility, override: warn and fix if lower
+  - events, proc type of object
+  - sealed
+- with..do
+- enums - TPasEnumType, TPasEnumValue
+  - propagate to parent scopes
+  - function ord(): integer
+  - function low(ordinal): ordinal
+  - function high(ordinal): ordinal
+  - function pred(ordinal): ordinal
+  - function high(ordinal): ordinal
+  - cast integer to enum
+- sets - TPasSetType
+  - set of char
+  - set of integer
+  - set of boolean
+  - set of enum
+  - ranges 'a'..'z'  2..5
+  - operators: +, -, *, ><, <=, >=
+  - in-operator
+  - assign operators: +=, -=, *=
+  - include(), exclude()
+- typed const: check expr type
+- function length(const array or string): integer
+- procedure setlength(var array or string; newlength: integer)
+- ranges TPasRangeType
+- procedure exit, procedure exit(const function result)
+- check if types only refer types+const
+- check const expression types, e.g. bark on "const c:string=3;"
+- procedure inc/dec(var ordinal; decr: ordinal = 1)
+- function Assigned(Pointer or Class or Class-Of): boolean
+- arrays TPasArrayType
+  - TPasEnumType, char, integer, range
+  - low, high, length, setlength, assigned
+  - function concat(array1,array2,...): array
+  - function copy(array): array, copy(a,start), copy(a,start,end)
+  - insert(item; var array; index: integer)
+  - delete(var array; start, count: integer)
+  - element
+  - multi dimensional
+  - const
+  - open array, override, pass array literal, pass var
+  - type cast array to arrays with same dimensions and compatible element type
+- check if var initexpr fits vartype: var a: type = expr;
+- built-in functions high, low for range types
+- procedure type
+  - call
+  - as function result
+  - as parameter
+  - Delphi without @
+  - FPC equal and not equal
+  - "is nested"
+  - bark on arguments access mismatch
+- function without params: mark if call or address, rrfImplicitCallWithoutParams
+- procedure break, procedure continue
+- built-in functions pred, succ for range type and enums
+- untyped parameters
+- built-in procedure str(const boolean|integer|enumvalue|classinstance,var s: string)
+- pointer TPasPointerType
+  - nil, assigned(), typecast, class, classref, dynarray, procvar
+- emit hints platform, deprecated, experimental, library, unimplemented
+- dotted unitnames
+- eval:
+  - nil, true, false
+
+ToDo:
+- range checking:
+  - integer ranges
+  - boolean ranges
+  - enum ranges
+  - char ranges
+  - +, -, *, div, mod, /, shl, shr, or, and, xor, in, ^^, ><
+  - =, <>, <, <=, >, >=
+  - ord(), low(), high(), pred(), succ(), length()
+  - string[index]
+  - arr[index]
+  - call(param)
+  - indexedprop[param]
+  - a:=value
+  - set+set, set*set, set-set
+- @@
+- fail to write a loop var inside the loop
+- warn: create class with abstract methods
+- classes - TPasClassType
+   - nested var, const
+   - nested types
+- check if constant is longint or int64
+- for..in..do
+- records - TPasRecordType,
+   - const  TRecordValues
+   - function default(record type): record
+   - pointer of record
+- proc: check if forward and impl default values match
+- call array of proc without ()
+- array+array
+- pointer type, ^type, @ operator, [] operator
+- type alias type
+- object
+- interfaces
+  - implements, supports
+- TPasResString
+- generics, nested param lists
+- type helpers
+- record/class helpers
+- generics
+- operator overload
+- attributes
+- anonymous functions
+- TPasFileType
+- labels
+- many more: search for "ToDo:"
+
+Debug flags: -d<x>
+  VerbosePasResolver
+
+Notes:
+ Functions and function types without parameters:
+   property P read f; // use function f, not its result
+   f.  // implicit resolve f once if param less function or function type
+   f[]  // implicit resolve f once if a param less function or function type
+   @f;  use function f, not its result
+   @p.f;  @ operator applies to f, not p
+   @f();  @ operator applies to result of f
+   f(); use f's result
+   FuncVar:=Func; if mode=objfpc: incompatible
+                  if mode=delphi: implicit addr of function f
+   if f=g then : can implicit resolve each side once
+   p(f), f as var parameter: can implicit
+}
+unit PasResolver;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses
+  Classes, SysUtils, Math, contnrs,
+  PasTree, PScanner, PParser, PasResolveEval;
+
+const
+  ParserMaxEmbeddedColumn = 2048;
+  ParserMaxEmbeddedRow = $7fffffff div ParserMaxEmbeddedColumn;
+
+type
+  TResolverBaseType = (
+    btNone,        // undefined
+    btCustom,      // provided by descendant resolver
+    btContext,     // a class or record
+    btModule,
+    btUntyped,     // TPasArgument without ArgType
+    btChar,        // char
+    btAnsiChar,    // ansichar
+    btWideChar,    // widechar
+    btString,      // string
+    btAnsiString,  // ansistring
+    btShortString, // shortstring
+    btWideString,  // widestring
+    btUnicodeString,// unicodestring
+    btRawByteString, // rawbytestring
+    btSingle,      // single  1.5E-45..3.4E38, digits 7-8, bytes 4
+    btDouble,      // double  5.0E-324..1.7E308, digits 15-16, bytes 8
+    btExtended,    // extended  platform, double or 1.9E-4932..1.1E4932, digits 19-20, bytes 10
+    btCExtended,   // cextended
+    btCurrency,    // as int64, but least 4 digits are the decimals (*10000), bytes 8
+    btBoolean,     // boolean
+    btByteBool,    // bytebool  true=not zero
+    btWordBool,    // wordbool  true=not zero
+    btLongBool,    // longbool  true=not zero
+    btQWordBool,   // qwordbool true=not zero
+    btByte,        // byte  0..255
+    btShortInt,    // shortint -128..127
+    btWord,        // word  unsigned 2 bytes
+    btSmallInt,    // smallint signed 2 bytes
+    btUIntSingle,  // unsigned integer range of single 22bit
+    btIntSingle,   // integer range of single  23bit
+    btLongWord,    // longword unsigned 4 bytes
+    btLongint,     // longint  signed 4 bytes
+    btUIntDouble,  // unsigned integer range of double 52bit
+    btIntDouble,   // integer range of double  53bit
+    btQWord,       // qword   0..18446744073709551615, bytes 8
+    btInt64,       // int64   -9223372036854775808..9223372036854775807, bytes 8
+    btComp,        // as Int64 but not ordinal
+    btPointer,     // pointer
+    btFile,        // file
+    btText,        // text
+    btVariant,     // variant
+    btNil,         // nil = pointer, class, procedure, method, ...
+    btProc,        // TPasProcedure
+    btBuiltInProc,
+    btSet,         // []    see SubType, can also be round bracket in var a:arraytype = (x,y)
+    btRange        // a..b  see SubType
+    );
+  TResolveBaseTypes = set of TResolverBaseType;
+const
+  btAllInteger = [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,
+    btLongWord,btLongint,btIntDouble,btUIntDouble,btQWord,btInt64,btComp];
+  btAllChars = [btChar,btAnsiChar,btWideChar];
+  btAllStrings = [btString,btAnsiString,btShortString,
+    btWideString,btUnicodeString,btRawByteString];
+  btAllStringAndChars = btAllStrings+btAllChars;
+  btAllFloats = [btSingle,btDouble,btExtended,btCExtended,btCurrency];
+  btAllBooleans = [btBoolean,btByteBool,btWordBool,btLongBool,btQWordBool];
+  btAllStandardTypes = [
+    btChar,
+    btAnsiChar,
+    btWideChar,
+    btString,
+    btAnsiString,
+    btShortString,
+    btWideString,
+    btUnicodeString,
+    btRawByteString,
+    btSingle,
+    btDouble,
+    btExtended,
+    btCExtended,
+    btCurrency,
+    btBoolean,
+    btByteBool,
+    btWordBool,
+    btLongBool,
+    btQWordBool,
+    btByte,
+    btShortInt,
+    btWord,
+    btSmallInt,
+    btLongWord,
+    btLongint,
+    btQWord,
+    btInt64,
+    btComp,
+    btPointer,
+    btFile,
+    btText,
+    btVariant
+    ];
+  btArrayRangeTypes = btAllChars+[btBoolean]+btAllInteger;
+
+  ResBaseTypeNames: array[TResolverBaseType] of string =(
+    'None',
+    'Custom',
+    'Context',
+    'Module',
+    'Untyped',
+    'Char',
+    'AnsiChar',
+    'WideChar',
+    'String',
+    'AnsiString',
+    'ShortString',
+    'WideString',
+    'UnicodeString',
+    'RawByteString',
+    'Single',
+    'Double',
+    'Extended',
+    'CExtended',
+    'Currency',
+    'Boolean',
+    'ByteBool',
+    'WordBool',
+    'LongBool',
+    'QWordBool',
+    'Byte',
+    'ShortInt',
+    'Word',
+    'SmallInt',
+    'UIntSingle',
+    'IntSingle',
+    'LongWord',
+    'Longint',
+    'UIntDouble',
+    'IntDouble',
+    'QWord',
+    'Int64',
+    'Comp',
+    'Pointer',
+    'File',
+    'Text',
+    'Variant',
+    'Nil',
+    'Procedure/Function',
+    'BuiltInProc',
+    'set',
+    'range..'
+    );
+
+const
+  MinSafeIntCurrency = -922337203685477;
+  MaxSafeIntCurrency =  922337203685477;
+  MinSafeIntSingle = -16777216;
+  MaxSafeIntSingle =  16777216;
+  MinSafeIntDouble = -$10000000000000;
+  MaxSafeIntDouble =   $fffffffffffff;
+
+type
+  TResolverBuiltInProc = (
+    bfCustom,
+    bfLength,
+    bfSetLength,
+    bfInclude,
+    bfExclude,
+    bfBreak,
+    bfContinue,
+    bfExit,
+    bfInc,
+    bfDec,
+    bfAssigned,
+    bfChr,
+    bfOrd,
+    bfLow,
+    bfHigh,
+    bfPred,
+    bfSucc,
+    bfStrProc,
+    bfStrFunc,
+    bfConcatArray,
+    bfCopyArray,
+    bfInsertArray,
+    bfDeleteArray,
+    bfTypeInfo
+    );
+  TResolverBuiltInProcs = set of TResolverBuiltInProc;
+const
+  ResolverBuiltInProcNames: array[TResolverBuiltInProc] of string = (
+    'Custom',
+    'Length',
+    'SetLength',
+    'Include',
+    'Exclude',
+    'Break',
+    'Continue',
+    'Exit',
+    'Inc',
+    'Dec',
+    'Assigned',
+    'Chr',
+    'Ord',
+    'Low',
+    'High',
+    'Pred',
+    'Succ',
+    'Str',
+    'Str',
+    'Concat',
+    'Copy',
+    'Insert',
+    'Delete',
+    'TypeInfo'
+    );
+  bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
+
+const
+  ResolverResultVar = 'Result';
+
+type
+
+  { EPasResolve }
+
+  EPasResolve = class(Exception)
+  private
+    FPasElement: TPasElement;
+    procedure SetPasElement(AValue: TPasElement);
+  public
+    Id: int64;
+    MsgType: TMessageType;
+    MsgNumber: integer;
+    MsgPattern: String;
+    Args: TMessageArgs;
+    SourcePos: TPasSourcePos;
+    destructor Destroy; override;
+    property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
+  end;
+
+type
+
+  { TUnresolvedPendingRef }
+
+  TUnresolvedPendingRef = class(TPasUnresolvedSymbolRef)
+  public
+    Element: TPasType; // TPasClassOfType or TPasPointerType
+  end;
+
+  TPasScope = class;
+
+  TIterateScopeElement = procedure(El: TPasElement; ElScope, StartScope: TPasScope;
+    Data: Pointer; var Abort: boolean) of object;
+
+  { TPasScope -
+    Elements like TPasClassType use TPasScope descendants as CustomData for
+    their sub identifiers.
+    TPasResolver.Scopes has a stack of TPasScope for searching identifiers.
+    }
+
+  TPasScope = Class(TResolveData)
+  public
+    VisibilityContext: TPasElement; // methods sets this to a TPasClassType,
+      // used to check if the current context is allowed to access a
+      // private/protected element
+    class function IsStoredInElement: boolean; virtual;
+    class function FreeOnPop: boolean; virtual;
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); virtual;
+    procedure WriteIdentifiers(Prefix: string); virtual;
+  end;
+  TPasScopeClass = class of TPasScope;
+
+  { TPasModuleScope }
+
+  TPasModuleScope = class(TPasScope)
+  public
+    FirstName: string;
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+  end;
+
+  TPasIdentifierKind = (
+    pikNone, // not yet initialized
+    pikBaseType, // e.g. longint
+    pikBuiltInProc,  // e.g. High(), SetLength()
+    pikSimple, // simple vars, consts, types, enums
+    pikProc // may need parameter list with round brackets
+    );
+  TPasIdentifierKinds = set of TPasIdentifierKind;
+
+  { TPasIdentifier }
+
+  TPasIdentifier = Class(TObject)
+  private
+    FElement: TPasElement;
+    procedure SetElement(AValue: TPasElement);
+  public
+    {$IFDEF VerbosePasResolver}
+    Owner: TObject;
+    {$ENDIF}
+    Identifier: String;
+    NextSameIdentifier: TPasIdentifier; // next identifier with same name
+    Kind: TPasIdentifierKind;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;
+  end;
+
+  { TPasIdentifierScope - elements with a list of sub identifiers }
+
+  TPasIdentifierScope = Class(TPasScope)
+  private
+    FItems: TFPHashList;
+    procedure InternalAdd(Item: TPasIdentifier);
+    procedure OnClearItem(Item, Dummy: pointer);
+    procedure OnWriteItem(Item, Dummy: pointer);
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
+    function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
+    function AddIdentifier(const Identifier: String; El: TPasElement;
+      const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
+    function FindElement(const aName: string): TPasElement;
+    procedure IterateLocalElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean);
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    procedure WriteIdentifiers(Prefix: string); override;
+  end;
+
+  { TPasDefaultScope - root scope }
+
+  TPasDefaultScope = class(TPasIdentifierScope)
+  public
+    class function IsStoredInElement: boolean; override;
+  end;
+
+  { TPasSectionScope - e.g. interface, implementation, program, library }
+
+  TPasSectionScope = Class(TPasIdentifierScope)
+  public
+    UsesScopes: TFPList; // list of TPasSectionScope
+    constructor Create; override;
+    destructor Destroy; override;
+    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;
+  end;
+
+  { TPasEnumTypeScope }
+
+  TPasEnumTypeScope = Class(TPasIdentifierScope)
+  public
+    CanonicalSet: TPasSetType;
+    destructor Destroy; override;
+  end;
+
+  { TPasRecordScope }
+
+  TPasRecordScope = Class(TPasIdentifierScope)
+  end;
+
+  TPasClassScopeFlag = (
+    pcsfAncestorResolved,
+    pcsfSealed
+    );
+  TPasClassScopeFlags = set of TPasClassScopeFlag;
+
+  { TPasClassScope }
+
+  TPasClassScope = Class(TPasIdentifierScope)
+  public
+    AncestorScope: TPasClassScope;
+    CanonicalClassOf: TPasClassOfType;
+    DirectAncestor: TPasType; // TPasClassType or TPasAliasType or TPasTypeAliasType
+    DefaultProperty: TPasProperty;
+    Flags: TPasClassScopeFlags;
+    destructor Destroy; override;
+    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;
+  end;
+  TPasClassScopeClass = class of TPasClassScope;
+
+  { TPasProcedureScope }
+
+  TPasProcedureScope = Class(TPasIdentifierScope)
+  public
+    DeclarationProc: TPasProcedure; // the corresponding forward declaration
+    ImplProc: TPasProcedure; // the corresponding proc with Body
+    OverriddenProc: TPasProcedure; // if IsOverride then this is the ancestor proc (virtual or override)
+    ClassScope: TPasClassScope;
+    SelfArg: TPasArgument;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    function GetSelfScope: TPasProcedureScope; // get the next parent procscope with a classcope
+    procedure WriteIdentifiers(Prefix: string); override;
+    destructor Destroy; override;
+  end;
+
+  { TPasPropertyScope }
+
+  TPasPropertyScope = Class(TPasIdentifierScope)
+  public
+    AncestorProp: TPasProperty; { if TPasProperty(Element).VarType=nil this is an override
+                                  otherwise it is a redeclaration }
+    destructor Destroy; override;
+  end;
+
+  { TPasExceptOnScope }
+
+  TPasExceptOnScope = Class(TPasIdentifierScope)
+  end;
+
+  TPasWithScope = class;
+
+  TPasWithExprScopeFlag = (
+    wesfNeedTmpVar,
+    wesfOnlyTypeMembers,
+    wesfConstParent // not writable
+    );
+  TPasWithExprScopeFlags = set of TPasWithExprScopeFlag;
+
+  { TPasWithExprScope }
+
+  TPasWithExprScope = Class(TPasScope)
+  public
+    WithScope: TPasWithScope; // owner
+    Index: integer;
+    Expr: TPasExpr;
+    Scope: TPasScope;
+    Flags: TPasWithExprScopeFlags;
+    class function IsStoredInElement: boolean; override;
+    class function FreeOnPop: boolean; override;
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    procedure WriteIdentifiers(Prefix: string); override;
+  end;
+  TPasWithExprScopeClass = class of TPasWithExprScope;
+
+  { TPasWithScope }
+
+  TPasWithScope = Class(TPasScope)
+  public
+    // Element is the TPasImplWithDo
+    ExpressionScopes: TObjectList; // list of TPasWithExprScope
+    constructor Create; override;
+    destructor Destroy; override;
+  end;
+
+  { TPasSubScope - base class for sub scopes aka dotted scopes }
+
+  TPasSubScope = Class(TPasIdentifierScope)
+  public
+    class function IsStoredInElement: boolean; override;
+  end;
+
+  { TPasIterateFilterData }
+
+  TPasIterateFilterData = record
+    OnIterate: TIterateScopeElement;
+    Data: Pointer;
+  end;
+  PPasIterateFilterData = ^TPasIterateFilterData;
+
+  { TPasModuleDotScope - scope for searching unitname.<identifier> }
+
+  TPasModuleDotScope = Class(TPasSubScope)
+  private
+    FModule: TPasModule;
+    procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
+      Data: Pointer; var Abort: boolean);
+    procedure SetModule(AValue: TPasModule);
+  public
+    InterfaceScope: TPasSectionScope;
+    ImplementationScope: TPasSectionScope;
+    destructor Destroy; override;
+    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;
+    property Module: TPasModule read FModule write SetModule;
+  end;
+
+  { TPasDotIdentifierScope }
+
+  TPasDotIdentifierScope = Class(TPasSubScope)
+  public
+    IdentifierScope: TPasIdentifierScope;
+    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;
+  end;
+
+  { TPasDotRecordScope - used for aRecord.subidentifier }
+
+  TPasDotRecordScope = Class(TPasDotIdentifierScope)
+  end;
+
+  { TPasDotEnumTypeScope - used for EnumType.EnumValue }
+
+  TPasDotEnumTypeScope = Class(TPasDotIdentifierScope)
+  end;
+
+  { TPasDotClassScope - used for aClass.subidentifier }
+
+  TPasDotClassScope = Class(TPasDotIdentifierScope)
+  private
+    FClassScope: TPasClassScope;
+    procedure SetClassScope(AValue: TPasClassScope);
+  public
+    InheritedExpr: boolean; // this is 'inherited <name>' instead of '.<name'
+    property ClassScope: TPasClassScope read FClassScope write SetClassScope;
+  end;
+
+  TResolvedReferenceFlag = (
+    rrfDotScope, // found reference via a dot scope (TPasDotIdentifierScope)
+    rrfImplicitCallWithoutParams, // a TPrimitiveExpr is an implicit call without params
+    rrfNewInstance, // constructor call (without it call constructor as normal method)
+    rrfFreeInstance, // destructor call (without it call destructor as normal method)
+    rrfVMT, // use VMT for call
+    rrfConstInherited  // parent is const and children are too
+    );
+  TResolvedReferenceFlags = set of TResolvedReferenceFlag;
+
+type
+
+  { TResolvedRefContext }
+
+  TResolvedRefContext = Class
+  end;
+
+  TResolvedRefAccess = (
+    rraNone,
+    rraRead,  // expression is read
+    rraAssign, // expression is LHS assign
+    rraReadAndAssign, // expression is LHS +=, -=, *=, /=
+    rraVarParam, // expression is passed to a var parameter
+    rraOutParam, // expression is passed to an out parameter
+    rraParamToUnknownProc // used as param, before knowing what overladed proc to call,
+      // will later be changed to rraRead, rraVarParam, rraOutParam
+    );
+  TPRResolveVarAccesses = set of TResolvedRefAccess;
+
+  { TResolvedReference - CustomData for normal references }
+
+  TResolvedReference = Class(TResolveData)
+  private
+    FDeclaration: TPasElement;
+    procedure SetDeclaration(AValue: TPasElement);
+  public
+    Flags: TResolvedReferenceFlags;
+    Access: TResolvedRefAccess;
+    Context: TResolvedRefContext;
+    WithExprScope: TPasWithExprScope;// if set, this reference used a With-block expression.
+    destructor Destroy; override;
+    property Declaration: TPasElement read FDeclaration write SetDeclaration;
+  end;
+
+  { TResolvedRefCtxConstructor }
+
+  TResolvedRefCtxConstructor = Class(TResolvedRefContext)
+  public
+    Typ: TPasType; // e.g. TPasClassType
+  end;
+
+  TPasResolverResultFlag = (
+    rrfReadable,
+    rrfWritable,
+    rrfAssignable,  // not writable in general, e.g. aString[1]:=
+    rrfCanBeStatement
+    );
+  TPasResolverResultFlags = set of TPasResolverResultFlag;
+
+type
+  { TPasResolverResult }
+
+  TPasResolverResult = record
+    BaseType: TResolverBaseType;
+    SubType: TResolverBaseType; // for btSet and btRange
+    IdentEl: TPasElement; // if set then this specific identifier is the value, can be a type
+    TypeEl: TPasType; // can be nil for const expression
+    ExprEl: TPasExpr;
+    Flags: TPasResolverResultFlags;
+  end;
+  PPasResolvedElement = ^TPasResolverResult;
+
+type
+  TPasResolverComputeFlag = (
+    rcSkipTypeAlias,
+    rcSetReferenceFlags,  // set flags of references while computing type, used by Resolve* methods
+    rcNoImplicitProc,    // do not call a function without params, includes rcNoImplicitProcType
+    rcNoImplicitProcType, // do not call a proc type without params
+    rcConstant,  // resolve a constant expresson
+    rcType       // resolve a type expression
+    );
+  TPasResolverComputeFlags = set of TPasResolverComputeFlag;
+
+  TResElDataBuiltInSymbol = Class(TResolveData)
+  public
+  end;
+
+  { TResElDataBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. longint }
+
+  TResElDataBaseType = Class(TResElDataBuiltInSymbol)
+  public
+    BaseType: TResolverBaseType;
+  end;
+  TResElDataBaseTypeClass = class of TResElDataBaseType;
+
+  TResElDataBuiltInProc = Class;
+
+  TOnGetCallCompatibility = function(Proc: TResElDataBuiltInProc;
+    Exp: TPasExpr; RaiseOnError: boolean): integer of object;
+  TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
+    out ResolvedEl: TPasResolverResult) of object;
+  TOnEvalBIFunction = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
+    out Evaluated: TResEvalValue) of object;
+  TOnFinishParamsExpr = procedure(Proc: TResElDataBuiltInProc;
+    Params: TParamsExpr) of object;
+
+  TBuiltInProcFlag = (
+    bipfCanBeStatement // a call is enough for a simple statement
+    );
+  TBuiltInProcFlags = set of TBuiltInProcFlag;
+
+  { TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
+
+  TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
+  public
+    Proc: TPasUnresolvedSymbolRef;
+    Signature: string;
+    BuiltIn: TResolverBuiltInProc;
+    GetCallCompatibility: TOnGetCallCompatibility;
+    GetCallResult: TOnGetCallResult;
+    Eval: TOnEvalBIFunction;
+    FinishParamsExpression: TOnFinishParamsExpr;
+    Flags: TBuiltInProcFlags;
+  end;
+
+  { TPRFindData }
+
+  TPRFindData = record
+    ErrorPosEl: TPasElement;
+    Found: TPasElement;
+    ElScope: TPasScope; // Where Found was found
+    StartScope: TPasScope; // where the searched started
+  end;
+  PPRFindData = ^TPRFindData;
+
+  TPasResolverOption = (
+    proFixCaseOfOverrides,  // fix Name of overriding proc/property to the overriden proc/property
+    proClassPropertyNonStatic,  // class property accessor must be non static
+    proPropertyAsVarParam, // allows to pass a property as a var/out argument
+    proClassOfIs, // class-of supports is and as operator
+    proExtClassInstanceNoTypeMembers, // class members of external class cannot be accessed by instance
+    proOpenAsDynArrays, // open arrays work like dynamic arrays
+    proProcTypeWithoutIsNested, // proc types can use nested procs without 'is nested'
+    proMethodAddrAsPointer  // can assign @method to a pointer
+    );
+  TPasResolverOptions = set of TPasResolverOption;
+
+  { TPasResolver }
+
+  TPasResolver = Class(TPasTreeContainer)
+  private
+    type
+      TResolveDataListKind = (lkBuiltIn,lkModule);
+    function GetBaseTypes(bt: TResolverBaseType): TPasUnresolvedSymbolRef; inline;
+    function GetScopes(Index: integer): TPasScope; inline;
+  private
+    FAnonymousElTypePostfix: String;
+    FBaseTypeChar: TResolverBaseType;
+    FBaseTypeExtended: TResolverBaseType;
+    FBaseTypeLength: TResolverBaseType;
+    FBaseTypes: array[TResolverBaseType] of TPasUnresolvedSymbolRef;
+    FBaseTypeString: TResolverBaseType;
+    FDefaultNameSpace: String;
+    FDefaultScope: TPasDefaultScope;
+    FDynArrayMaxIndex: int64;
+    FDynArrayMinIndex: int64;
+    FLastCreatedData: array[TResolveDataListKind] of TResolveData;
+    FLastElement: TPasElement;
+    FLastMsg: string;
+    FLastMsgArgs: TMessageArgs;
+    FLastMsgElement: TPasElement;
+    FLastMsgId: int64;
+    FLastMsgNumber: integer;
+    FLastMsgPattern: string;
+    FLastMsgType: TMessageType;
+    FLastSourcePos: TPasSourcePos;
+    FOptions: TPasResolverOptions;
+    FPendingForwards: TFPList; // list of TPasElement needed to check for forward procs
+    FRootElement: TPasModule;
+    FScopeClass_Class: TPasClassScopeClass;
+    FScopeClass_WithExpr: TPasWithExprScopeClass;
+    FScopeCount: integer;
+    FScopes: array of TPasScope; // stack of scopes
+    FStoreSrcColumns: boolean;
+    FSubScopeCount: integer;
+    FSubScopes: array of TPasScope; // stack of scopes
+    FTopScope: TPasScope;
+    procedure ClearResolveDataList(Kind: TResolveDataListKind);
+    function GetBaseTypeNames(bt: TResolverBaseType): string;
+  protected
+    const
+      cIncompatible = High(integer);
+      cExact = 0;
+      cCompatible = cExact+1;
+      cIntToIntConversion = ord(High(TResolverBaseType));
+      cToFloatConversion = 2*cIntToIntConversion;
+      cTypeConversion = cExact+10000; // e.g. TObject to Pointer
+      cLossyConversion = cExact+100000;
+      cCompatibleWithDefaultParams = cLossyConversion+100000;
+    type
+      TFindCallElData = record
+        Params: TParamsExpr;
+        Found: TPasElement; // TPasProcedure or TPasUnresolvedSymbolRef(built in proc) or TPasType (typecast)
+        ElScope, StartScope: TPasScope;
+        Distance: integer; // compatibility distance
+        Count: integer;
+        List: TFPList; // if not nil then collect all found elements here
+      end;
+      PFindCallElData = ^TFindCallElData;
+
+      TFindOverloadProcData = record
+        Proc: TPasProcedure;
+        Args: TFPList;        // List of TPasArgument objects
+        OnlyScope: TPasScope;
+        Found: TPasProcedure;
+        ElScope, StartScope: TPasScope;
+        FoundNonProc: TPasElement;
+      end;
+      PFindOverloadProcData = ^TFindOverloadProcData;
+
+    procedure OnFindFirstElement(El: TPasElement; ElScope, StartScope: TPasScope;
+      FindFirstElementData: Pointer; var Abort: boolean); virtual;
+    procedure OnFindCallElements(El: TPasElement; ElScope, StartScope: TPasScope;
+      FindProcsData: Pointer; var Abort: boolean); virtual;
+    procedure OnFindOverloadProc(El: TPasElement; ElScope, StartScope: TPasScope;
+      FindOverloadData: Pointer; var Abort: boolean); virtual;
+  protected
+    procedure SetCurrentParser(AValue: TPasParser); override;
+    procedure CheckTopScope(ExpectedClass: TPasScopeClass);
+    function AddIdentifier(Scope: TPasIdentifierScope;
+      const aName: String; El: TPasElement;
+      const Kind: TPasIdentifierKind): TPasIdentifier; virtual;
+    procedure AddModule(El: TPasModule); virtual;
+    procedure AddSection(El: TPasSection); virtual;
+    procedure AddType(El: TPasType); virtual;
+    procedure AddRecordType(El: TPasRecordType); virtual;
+    procedure AddClassType(El: TPasClassType); virtual;
+    procedure AddVariable(El: TPasVariable); virtual;
+    procedure AddEnumType(El: TPasEnumType); virtual;
+    procedure AddEnumValue(El: TPasEnumValue); virtual;
+    procedure AddProperty(El: TPasProperty); virtual;
+    procedure AddProcedure(El: TPasProcedure); virtual;
+    procedure AddProcedureBody(El: TProcedureBody); virtual;
+    procedure AddArgument(El: TPasArgument); virtual;
+    procedure AddFunctionResult(El: TPasResultElement); virtual;
+    procedure AddExceptOn(El: TPasImplExceptOn); virtual;
+    procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
+    procedure ResolveImplElement(El: TPasImplElement); virtual;
+    procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
+    procedure ResolveImplLabelMark(Mark: TPasImplLabelMark); virtual;
+    procedure ResolveImplForLoop(Loop: TPasImplForLoop); virtual;
+    procedure ResolveImplWithDo(El: TPasImplWithDo); virtual;
+    procedure ResolveImplAsm(El: TPasImplAsmStatement); virtual;
+    procedure ResolveImplAssign(El: TPasImplAssign); virtual;
+    procedure ResolveImplSimple(El: TPasImplSimple); virtual;
+    procedure ResolveImplRaise(El: TPasImplRaise); virtual;
+    procedure ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveStatementConditionExpr(El: TPasExpr); virtual;
+    procedure ResolveNameExpr(El: TPasExpr; const aName: string; Access: TResolvedRefAccess); virtual;
+    procedure ResolveInherited(El: TInheritedExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveInheritedCall(El: TBinaryExpr; Access: TResolvedRefAccess);         virtual;
+    procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveArrayParamsArgs(Params: TParamsExpr;
+      const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess); virtual;
+    function ResolveBracketOperatorClass(Params: TParamsExpr;
+      const ResolvedValue: TPasResolverResult; ClassScope: TPasClassScope;
+      Access: TResolvedRefAccess): boolean; virtual;
+    procedure ResolveSetParamsExpr(Params: TParamsExpr); virtual;
+    procedure ResolveArrayValues(El: TArrayValues); virtual;
+    procedure SetResolvedRefAccess(Expr: TPasExpr; Ref: TResolvedReference;
+      Access: TResolvedRefAccess); virtual;
+    procedure AccessExpr(Expr: TPasExpr; Access: TResolvedRefAccess);
+    procedure FinishModule(CurModule: TPasModule); virtual;
+    procedure FinishUsesClause; virtual;
+    procedure FinishTypeSection(El: TPasDeclarations); virtual;
+    procedure FinishTypeDef(El: TPasType); virtual;
+    procedure FinishEnumType(El: TPasEnumType); virtual;
+    procedure FinishSetType(El: TPasSetType); virtual;
+    procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
+    procedure FinishRangeType(El: TPasRangeType); virtual;
+    procedure FinishConstRangeExpr(Left, Right: TPasExpr;
+      out LeftResolved, RightResolved: TPasResolverResult);
+    procedure FinishRecordType(El: TPasRecordType); virtual;
+    procedure FinishClassType(El: TPasClassType); virtual;
+    procedure FinishClassOfType(El: TPasClassOfType); virtual;
+    procedure FinishArrayType(El: TPasArrayType); virtual;
+    procedure FinishConstDef(El: TPasConst); virtual;
+    procedure FinishProcedure(aProc: TPasProcedure); virtual;
+    procedure FinishProcedureType(El: TPasProcedureType); virtual;
+    procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
+    procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
+    procedure FinishExceptOnExpr; virtual;
+    procedure FinishExceptOnStatement; virtual;
+    procedure FinishDeclaration(El: TPasElement); virtual;
+    procedure FinishVariable(El: TPasVariable); virtual;
+    procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
+    procedure FinishArgument(El: TPasArgument); virtual;
+    procedure FinishAncestors(aClass: TPasClassType); virtual;
+    procedure FinishPropertyParamAccess(Params: TParamsExpr;
+      Prop: TPasProperty);
+    procedure EmitTypeHints(PosEl: TPasElement; aType: TPasType); virtual;
+    function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
+    procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
+    procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
+    procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure);
+    procedure CheckPendingForwards(El: TPasElement);
+    procedure ComputeBinaryExpr(Bin: TBinaryExpr;
+      out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+      StartEl: TPasElement);
+    procedure ComputeArrayParams(Params: TParamsExpr;
+      out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+      StartEl: TPasElement);
+    procedure ComputeArrayParams_Class(Params: TParamsExpr;
+      var ResolvedEl: TPasResolverResult; ClassScope: TPasClassScope;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement); virtual;
+    procedure ComputeFuncParams(Params: TParamsExpr;
+      out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+      StartEl: TPasElement);
+    procedure ComputeSetParams(Params: TParamsExpr;
+      out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+      StartEl: TPasElement);
+    procedure CheckIsClass(El: TPasElement; const ResolvedEl: TPasResolverResult);
+    function CheckTypeCastClassInstanceToClass(
+      const FromClassRes, ToClassRes: TPasResolverResult;
+      ErrorEl: TPasElement): integer; virtual;
+    procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
+      const LHS, RHS: TPasResolverResult);
+    function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
+      ErrorEl: TPasElement; RaiseOnError: boolean): boolean;
+    procedure CombineArrayLitElTypes(Left, Right: TPasExpr;
+      var LHS: TPasResolverResult; const RHS: TPasResolverResult);
+    procedure ConvertRangeToFirstValue(var ResolvedEl: TPasResolverResult);
+    function IsCharLiteral(const Value: string): boolean; virtual;
+    function CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc; Expr: TPasExpr;
+      MinCount: integer; RaiseOnError: boolean): boolean;
+    function CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
+      MaxCount: integer; RaiseOnError: boolean): integer;
+    function CheckRaiseTypeArgNo(id: int64; ArgNo: integer; Param: TPasExpr;
+      const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
+  protected
+    fExprEvaluator: TResExprEvaluator;
+    procedure OnExprEvalLog(Sender: TResExprEvaluator; const id: int64;
+      MsgType: TMessageType; MsgNumber: integer; const Fmt: String;
+      Args: array of const; PosEl: TPasElement); virtual;
+    function OnExprEvalIdentifier(Sender: TResExprEvaluator;
+      Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
+    function OnExprEvalParams(Sender: TResExprEvaluator;
+      Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
+    function Eval(Expr: TPasExpr; Flags: TResEvalFlags; Store: boolean = true): TResEvalValue;
+  protected
+    // custom types (added by descendant resolvers)
+    function CheckAssignCompatibilityCustom(
+      const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean; var Handled: boolean): integer; virtual;
+    function CheckEqualCompatibilityCustomType(
+      const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean): integer; virtual;
+  protected
+    // built-in functions
+    function BI_Length_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    procedure BI_Length_OnEval(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; out Evaluated: TResEvalValue); virtual;
+    function BI_SetLength_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_SetLength_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
+    function BI_InExclude_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_InExclude_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
+    function BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    function BI_Continue_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    function BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    function BI_IncDec_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_IncDec_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
+    function BI_Assigned_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_Chr_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_LowHigh_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    procedure BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; out Evaluated: TResEvalValue); virtual;
+    function BI_PredSucc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_PredSucc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    procedure BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; out Evaluated: TResEvalValue); virtual;
+    function BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
+      const ParamResolved: TPasResolverResult; ArgNo: integer;
+      RaiseOnError: boolean): integer;
+    function BI_StrProc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
+    function BI_StrFunc_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_StrFunc_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_ConcatArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_ConcatArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_CopyArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_CopyArray_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+    function BI_InsertArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_InsertArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
+    function BI_DeleteArray_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_DeleteArray_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr); virtual;
+    function BI_TypeInfo_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
+    procedure BI_TypeInfo_OnGetCallResult({%H-}Proc: TResElDataBuiltInProc;
+      {%H-}Params: TParamsExpr; out ResolvedEl: TPasResolverResult); virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear; virtual; // does not free built-in identifiers
+    // overrides of TPasTreeContainer
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+      overload; override;
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASrcPos: TPasSourcePos): TPasElement;
+      overload; override;
+    function FindElement(const aName: String): TPasElement; override; // used by TPasParser
+    function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
+      NoProcsWithArgs: boolean): TPasElement;
+    function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
+      ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
+    procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
+    procedure IterateElements(const aName: string;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); virtual;
+    procedure CheckFoundElement(const FindData: TPRFindData;
+      Ref: TResolvedReference); virtual;
+    function GetVisibilityContext: TPasElement;
+    procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
+    function NeedArrayValues(El: TPasElement): boolean; override;
+    // built in types and functions
+    procedure ClearBuiltInIdentifiers; virtual;
+    procedure AddObjFPCBuiltInIdentifiers(
+      const TheBaseTypes: TResolveBaseTypes = btAllStandardTypes;
+      const TheBaseProcs: TResolverBuiltInProcs = bfAllStandardProcs); virtual;
+    function AddBaseType(const aName: string; Typ: TResolverBaseType): TResElDataBaseType;
+    function AddCustomBaseType(const aName: string; aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
+    function IsBaseType(aType: TPasType; BaseType: TResolverBaseType; ResolveAlias: boolean = false): boolean;
+    function AddBuiltInProc(const aName: string; Signature: string;
+      const GetCallCompatibility: TOnGetCallCompatibility;
+      const GetCallResult: TOnGetCallResult;
+      const EvalConst: TOnEvalBIFunction = nil;
+      const FinishParamsExpr: TOnFinishParamsExpr = nil;
+      const BuiltIn: TResolverBuiltInProc = bfCustom;
+      const Flags: TBuiltInProcFlags = []): TResElDataBuiltInProc;
+    // add extra TResolveData (E.CustomData) to free list
+    procedure AddResolveData(El: TPasElement; Data: TResolveData;
+      Kind: TResolveDataListKind);
+    function CreateReference(DeclEl, RefEl: TPasElement;
+      Access: TResolvedRefAccess;
+      FindData: PPRFindData = nil): TResolvedReference; virtual;
+    // scopes
+    function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
+    procedure PopScope;
+    procedure PushScope(Scope: TPasScope); overload;
+    function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
+    function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
+    function PushClassDotScope(var CurClassType: TPasClassType): TPasDotClassScope;
+    function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotRecordScope;
+    function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
+    procedure ResetSubScopes(out Depth: integer);
+    procedure RestoreSubScopes(Depth: integer);
+    // log and messages
+    class procedure UnmangleSourceLineNumber(LineNumber: integer;
+      out Line, Column: integer);
+    class function GetElementSourcePosStr(El: TPasElement): string;
+    procedure SetLastMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
+      Const Fmt : String; Args : Array of const; PosEl: TPasElement);
+    procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
+      const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
+    procedure RaiseMsg(const Id: int64; MsgNumber: integer; const Fmt: String;
+      Args: Array of const; ErrorPosEl: TPasElement);
+    procedure RaiseNotYetImplemented(id: int64; El: TPasElement; Msg: string = ''); virtual;
+    procedure RaiseInternalError(id: int64; const Msg: string = '');
+    procedure RaiseInvalidScopeForElement(id: int64; El: TPasElement; const Msg: string = '');
+    procedure RaiseIdentifierNotFound(id: int64; Identifier: string; El: TPasElement);
+    procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
+    procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
+    procedure RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
+    procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
+      const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
+    procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
+      const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
+    procedure RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
+      const Args: array of const; const GotType, ExpType: TPasResolverResult;
+      ErrorEl: TPasElement);
+    procedure RaiseInvalidProcTypeModifier(id: int64; ProcType: TPasProcedureType;
+      ptm: TProcTypeModifier; ErrorEl: TPasElement);
+    procedure RaiseInvalidProcModifier(id: int64; Proc: TPasProcedure;
+      pm: TProcedureModifier; ErrorEl: TPasElement);
+    procedure WriteScopes;
+    // find value and type of an element
+    procedure ComputeElement(El: TPasElement; out ResolvedEl: TPasResolverResult;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil);
+    // checking compatibilility
+    function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: boolean = false): boolean; // check if it is exactly the same
+    function CheckCallProcCompatibility(ProcType: TPasProcedureType;
+      Params: TParamsExpr; RaiseOnError: boolean;
+      SetReferenceFlags: boolean = false): integer;
+    function CheckCallPropertyCompatibility(PropEl: TPasProperty;
+      Params: TParamsExpr; RaiseOnError: boolean): integer;
+    function CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
+      Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean = false): integer;
+    function CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument;
+      ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean = false): integer;
+    function CheckAssignCompatibilityUserType(
+      const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean): integer;
+    function CheckAssignCompatibilityArrayType(
+      const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean): integer;
+    function CheckConstArrayCompatibility(Params: TParamsExpr;
+      const ArrayResolved: TPasResolverResult; RaiseOnError: boolean;
+      Flags: TPasResolverComputeFlags; StartEl: TPasElement = nil): integer;
+    function CheckEqualCompatibilityUserType(
+      const TypeA, TypeB: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean): integer;
+    function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
+    function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
+      ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;
+    function CheckTypeCastArray(FromType, ToType: TPasArrayType;
+      ErrorEl: TPasElement; RaiseOnError: boolean): integer;
+    function CheckSrcIsADstType(
+      const ResolvedSrcType, ResolvedDestType: TPasResolverResult;
+      ErrorEl: TPasElement): integer;
+    function CheckClassIsClass(SrcType, DestType: TPasType;
+      ErrorEl: TPasElement): integer; virtual;
+    function CheckClassesAreRelated(TypeA, TypeB: TPasType;
+      ErrorEl: TPasElement): integer;
+    function CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure): boolean;
+    function CheckProcTypeCompatibility(Proc1, Proc2: TPasProcedureType;
+      IsAssign: boolean; ErrorEl: TPasElement; RaiseOnIncompatible: boolean): boolean;
+    function CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
+    function CheckProcArgTypeCompatibility(Arg1, Arg2: TPasType): boolean;
+    function CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
+      ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
+    function CheckAssignCompatibility(const LHS, RHS: TPasElement;
+      RaiseOnIncompatible: boolean = true): integer;
+    procedure CheckAssignExprRange(const LeftResolved: TPasResolverResult; RHS: TPasExpr);
+    function CheckAssignResCompatibility(const LHS, RHS: TPasResolverResult;
+      ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
+    function CheckEqualElCompatibility(Left, Right: TPasElement;
+      ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
+      SetReferenceFlags: boolean = false): integer;
+    function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
+      LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
+      RErrorEl: TPasElement = nil): integer;
+    function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult): boolean;
+    function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
+    // uility functions
+    property BaseTypeNames[bt: TResolverBaseType]: string read GetBaseTypeNames;
+    function GetProcTypeDescription(ProcType: TPasProcedureType; UseName: boolean = true; AddPaths: boolean = false): string;
+    function GetResolverResultDescription(const T: TPasResolverResult; OnlyType: boolean = false): string;
+    function GetTypeDescription(aType: TPasType; AddPath: boolean = false): string;
+    function GetTypeDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
+    function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean = false): string; virtual;
+    function GetPasPropertyType(El: TPasProperty): TPasType;
+    function GetPasPropertyAncestor(El: TPasProperty; WithRedeclarations: boolean = false): TPasProperty;
+    function GetPasPropertyGetter(El: TPasProperty): TPasElement;
+    function GetPasPropertySetter(El: TPasProperty): TPasElement;
+    function GetPasPropertyStored(El: TPasProperty): TPasElement;
+    function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
+    function GetLoop(El: TPasElement): TPasImplElement;
+    function ResolveAliasType(aType: TPasType): TPasType;
+    function ExprIsAddrTarget(El: TPasExpr): boolean;
+    function IsNameExpr(El: TPasExpr): boolean; inline; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
+    function GetNameExprValue(El: TPasExpr): string; // TSelfExpr or TPrimitiveExpr with Kind=pekIdent
+    function GetNextDottedExpr(El: TPasExpr): TPasExpr;
+    function GetPathStart(El: TPasExpr): TPasExpr;
+    function GetNewInstanceExpr(El: TPasExpr): TPasExpr;
+    function ParentNeedsExprResult(El: TPasExpr): boolean;
+    function GetReference_NewInstanceClass(Ref: TResolvedReference): TPasClassType;
+    function IsDynArray(TypeEl: TPasType): boolean;
+    function IsOpenArray(TypeEl: TPasType): boolean;
+    function IsDynOrOpenArray(TypeEl: TPasType): boolean;
+    function IsVarInit(Expr: TPasExpr): boolean;
+    function IsEmptySet(const ResolvedEl: TPasResolverResult): boolean;
+    function IsClassMethod(El: TPasElement): boolean;
+    function IsExternalClassName(aClass: TPasClassType; const ExtName: string): boolean;
+    function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
+    function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
+    function IsTypeCast(Params: TParamsExpr): boolean;
+    function ProcNeedsParams(El: TPasProcedureType): boolean;
+    function GetRangeLength(RangeResolved: TPasResolverResult): integer;
+    function HasTypeInfo(El: TPasType): boolean; virtual;
+    function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
+    function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
+    function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
+    procedure GetIntegerProps(bt: TResolverBaseType; out Precision: word; out Signed: boolean);
+    function GetIntegerRange(bt: TResolverBaseType; out MinVal, MaxVal: int64): boolean;
+    function GetIntegerBaseType(Precision: word; Signed: boolean; ErrorEl: TPasElement): TResolverBaseType;
+    function GetCombinedChar(const Char1, Char2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
+    function GetCombinedString(const Str1, Str2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
+  public
+    // options
+    property Options: TPasResolverOptions read FOptions write FOptions;
+    property AnonymousElTypePostfix: String read FAnonymousElTypePostfix
+      write FAnonymousElTypePostfix; // default empty, if set, anonymous element types are named ArrayName+Postfix and added to declarations
+    property BaseTypes[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseTypes;
+    property BaseTypeChar: TResolverBaseType read FBaseTypeChar write FBaseTypeChar;
+    property BaseTypeExtended: TResolverBaseType read FBaseTypeExtended write FBaseTypeExtended;
+    property BaseTypeString: TResolverBaseType read FBaseTypeString write FBaseTypeString;
+    property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength;
+    property DynArrayMinIndex: int64 read FDynArrayMinIndex write FDynArrayMinIndex;
+    property DynArrayMaxIndex: int64 read FDynArrayMaxIndex write FDynArrayMaxIndex;
+    // parsed values
+    property DefaultNameSpace: String read FDefaultNameSpace;
+    property RootElement: TPasModule read FRootElement;
+    // scopes
+    property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; {
+       If true Line and Column is mangled together in TPasElement.SourceLineNumber.
+       Use method UnmangleSourceLineNumber to extract. }
+    property Scopes[Index: integer]: TPasScope read GetScopes;
+    property ScopeCount: integer read FScopeCount;
+    property TopScope: TPasScope read FTopScope;
+    property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
+    property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
+    property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
+    // last element
+    property LastElement: TPasElement read FLastElement;
+    property LastMsg: string read FLastMsg write FLastMsg;
+    property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
+    property LastMsgElement: TPasElement read FLastMsgElement write FLastMsgElement;
+    property LastMsgId: int64 read FLastMsgId write FLastMsgId;
+    property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
+    property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
+    property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
+    property LastSourcePos: TPasSourcePos read FLastSourcePos write FLastSourcePos;
+  end;
+
+function GetTreeDbg(El: TPasElement; Indent: integer = 0): string;
+function GetResolverResultDbg(const T: TPasResolverResult): string;
+function GetClassAncestorsDbg(El: TPasClassType): string;
+function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
+
+procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
+  BaseType: TResolverBaseType; IdentEl: TPasElement;
+  TypeEl: TPasType; Flags: TPasResolverResultFlags); overload;
+procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
+  BaseType: TResolverBaseType; TypeEl: TPasType;
+  Flags: TPasResolverResultFlags); overload;
+procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
+  BaseType: TResolverBaseType; TypeEl: TPasType; ExprEl: TPasExpr;
+  Flags: TPasResolverResultFlags); overload;
+
+function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
+function ChompDottedIdentifier(const Identifier: string): string;
+function FirstDottedIdentifier(const Identifier: string): string;
+function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
+{$IF FPC_FULLVERSION<30101}
+function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDots: Boolean = False): Boolean;
+{$ENDIF}
+
+function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
+function dbgs(const a: TResolvedRefAccess): string;
+function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
+
+implementation
+
+function GetTreeDbg(El: TPasElement; Indent: integer): string;
+
+  procedure LineBreak(SubIndent: integer);
+  begin
+    Inc(Indent,SubIndent);
+    Result:=Result+LineEnding+Space(Indent);
+  end;
+
+var
+  i, l: Integer;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName+'=';
+  if El is TPasExpr then
+    begin
+    if El.ClassType<>TBinaryExpr then
+      Result:=Result+OpcodeStrings[TPasExpr(El).OpCode];
+    if El.ClassType=TUnaryExpr then
+      Result:=Result+GetTreeDbg(TUnaryExpr(El).Operand,Indent)
+    else if El.ClassType=TBinaryExpr then
+      Result:=Result+'Left={'+GetTreeDbg(TBinaryExpr(El).left,Indent)+'}'
+         +OpcodeStrings[TPasExpr(El).OpCode]
+         +'Right={'+GetTreeDbg(TBinaryExpr(El).right,Indent)+'}'
+    else if El.ClassType=TPrimitiveExpr then
+      Result:=Result+TPrimitiveExpr(El).Value
+    else if El.ClassType=TBoolConstExpr then
+      Result:=Result+BoolToStr(TBoolConstExpr(El).Value,'true','false')
+    else if El.ClassType=TNilExpr then
+      Result:=Result+'nil'
+    else if El.ClassType=TInheritedExpr then
+      Result:=Result+'inherited'
+    else if El.ClassType=TSelfExpr then
+      Result:=Result+'Self'
+    else if El.ClassType=TParamsExpr then
+      begin
+      LineBreak(2);
+      Result:=Result+GetTreeDbg(TParamsExpr(El).Value,Indent)+'(';
+      l:=length(TParamsExpr(El).Params);
+      if l>0 then
+        begin
+        inc(Indent,2);
+        for i:=0 to l-1 do
+          begin
+          LineBreak(0);
+          Result:=Result+GetTreeDbg(TParamsExpr(El).Params[i],Indent);
+          if i<l-1 then
+            Result:=Result+','
+          end;
+        dec(Indent,2);
+        end;
+      Result:=Result+')';
+      end
+    else if El.ClassType=TRecordValues then
+      begin
+      Result:=Result+'(';
+      l:=length(TRecordValues(El).Fields);
+      if l>0 then
+        begin
+        inc(Indent,2);
+        for i:=0 to l-1 do
+          begin
+          LineBreak(0);
+          Result:=Result+TRecordValues(El).Fields[i].Name+':'
+            +GetTreeDbg(TRecordValues(El).Fields[i].ValueExp,Indent);
+          if i<l-1 then
+            Result:=Result+','
+          end;
+        dec(Indent,2);
+        end;
+      Result:=Result+')';
+      end
+    else if El.ClassType=TArrayValues then
+      begin
+      Result:=Result+'[';
+      l:=length(TArrayValues(El).Values);
+      if l>0 then
+        begin
+        inc(Indent,2);
+        for i:=0 to l-1 do
+          begin
+          LineBreak(0);
+          Result:=Result+GetTreeDbg(TArrayValues(El).Values[i],Indent);
+          if i<l-1 then
+            Result:=Result+','
+          end;
+        dec(Indent,2);
+        end;
+      Result:=Result+']';
+      end;
+    end
+  else if El is TPasProcedure then
+    begin
+    Result:=Result+GetTreeDbg(TPasProcedure(El).ProcType,Indent);
+    end
+  else if El is TPasProcedureType then
+    begin
+    if TPasProcedureType(El).IsReferenceTo then
+      Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
+    Result:=Result+'(';
+    l:=TPasProcedureType(El).Args.Count;
+    if l>0 then
+      begin
+      inc(Indent,2);
+      for i:=0 to l-1 do
+        begin
+        LineBreak(0);
+        Result:=Result+GetTreeDbg(TPasArgument(TPasProcedureType(El).Args[i]),Indent);
+        if i<l-1 then
+          Result:=Result+';'
+        end;
+      dec(Indent,2);
+      end;
+    Result:=Result+')';
+    if El is TPasFunction then
+      Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
+    if TPasProcedureType(El).IsOfObject then
+      Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
+    if TPasProcedureType(El).IsNested then
+      Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
+    if cCallingConventions[TPasProcedureType(El).CallingConvention]<>'' then
+      Result:=Result+'; '+cCallingConventions[TPasProcedureType(El).CallingConvention];
+    end
+  else if El.ClassType=TPasResultElement then
+    Result:=Result+GetTreeDbg(TPasResultElement(El).ResultType,Indent)
+  else if El.ClassType=TPasArgument then
+    begin
+    if AccessNames[TPasArgument(El).Access]<>'' then
+      Result:=Result+AccessNames[TPasArgument(El).Access];
+    if TPasArgument(El).ArgType=nil then
+      Result:=Result+'untyped'
+    else
+      Result:=Result+GetTreeDbg(TPasArgument(El).ArgType,Indent);
+    end
+  else if El.ClassType=TPasUnresolvedSymbolRef then
+    begin
+    if TPasUnresolvedSymbolRef(El).CustomData is TResElDataBuiltInProc then
+      Result:=Result+TResElDataBuiltInProc(TPasUnresolvedSymbolRef(El).CustomData).Signature;
+    end;
+end;
+
+function GetResolverResultDbg(const T: TPasResolverResult): string;
+begin
+  Result:='[bt='+ResBaseTypeNames[T.BaseType];
+  if T.SubType<>btNone then
+    Result:=Result+' Sub='+ResBaseTypeNames[T.SubType];
+  Result:=Result
+         +' Ident='+GetObjName(T.IdentEl)
+         +' Type='+GetObjName(T.TypeEl)
+         +' Expr='+GetObjName(T.ExprEl)
+         +' Flags='+ResolverResultFlagsToStr(T.Flags)
+         +']';
+end;
+
+function GetClassAncestorsDbg(El: TPasClassType): string;
+
+  function GetClassDesc(C: TPasClassType): string;
+  var
+    Module: TPasModule;
+  begin
+    if C.IsExternal then
+      Result:='class external '
+    else
+      Result:='class ';
+    Module:=C.GetModule;
+    if Module<>nil then
+      Result:=Result+Module.Name+'.';
+    Result:=Result+C.FullName;
+  end;
+
+var
+  Scope, AncestorScope: TPasClassScope;
+  AncestorEl: TPasClassType;
+begin
+  if El=nil then exit('nil');
+  Result:=GetClassDesc(El);
+  if El.CustomData is TPasClassScope then
+    begin
+    Scope:=TPasClassScope(El.CustomData);
+    AncestorScope:=Scope.AncestorScope;
+    while AncestorScope<>nil do
+      begin
+      Result:=Result+LineEnding+'  ';
+      AncestorEl:=AncestorScope.Element as TPasClassType;
+      Result:=Result+GetClassDesc(AncestorEl);
+      AncestorScope:=AncestorScope.AncestorScope;
+      end;
+    end;
+end;
+
+function ResolverResultFlagsToStr(const Flags: TPasResolverResultFlags): string;
+var
+  f: TPasResolverResultFlag;
+  s: string;
+begin
+  Result:='';
+  for f in Flags do
+    begin
+    if Result<>'' then Result:=Result+',';
+    str(f,s);
+    Result:=Result+s;
+    end;
+  Result:='['+Result+']';
+end;
+
+procedure SetResolverIdentifier(out ResolvedType: TPasResolverResult;
+  BaseType: TResolverBaseType; IdentEl: TPasElement; TypeEl: TPasType;
+  Flags: TPasResolverResultFlags);
+begin
+  ResolvedType.BaseType:=BaseType;
+  ResolvedType.SubType:=btNone;
+  ResolvedType.IdentEl:=IdentEl;
+  ResolvedType.TypeEl:=TypeEl;
+  ResolvedType.ExprEl:=nil;
+  ResolvedType.Flags:=Flags;
+end;
+
+procedure SetResolverTypeExpr(out ResolvedType: TPasResolverResult;
+  BaseType: TResolverBaseType; TypeEl: TPasType; Flags: TPasResolverResultFlags
+  );
+begin
+  ResolvedType.BaseType:=BaseType;
+  ResolvedType.SubType:=btNone;
+  ResolvedType.IdentEl:=nil;
+  ResolvedType.TypeEl:=TypeEl;
+  ResolvedType.ExprEl:=nil;
+  ResolvedType.Flags:=Flags;
+end;
+
+procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
+  BaseType: TResolverBaseType; TypeEl: TPasType; ExprEl: TPasExpr;
+  Flags: TPasResolverResultFlags);
+begin
+  ResolvedType.BaseType:=BaseType;
+  ResolvedType.SubType:=btNone;
+  ResolvedType.IdentEl:=nil;
+  ResolvedType.TypeEl:=TypeEl;
+  ResolvedType.ExprEl:=ExprEl;
+  ResolvedType.Flags:=Flags;
+end;
+
+function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
+begin
+  Result:=true;
+  if Proc.IsExternal then exit(false);
+  if Proc.IsForward then exit;
+  if Proc.Parent.ClassType=TInterfaceSection then exit;
+  if Proc.Parent.ClassType=TPasClassType then
+    begin
+    // a method declaration
+    if not Proc.IsAbstract then exit;
+    end;
+  Result:=false;
+end;
+
+function ChompDottedIdentifier(const Identifier: string): string;
+var
+  p: Integer;
+begin
+  Result:=Identifier;
+  p:=length(Identifier);
+  while (p>0) do
+    begin
+    if Identifier[p]='.' then
+      break;
+    dec(p);
+    end;
+  Result:=LeftStr(Identifier,p-1);
+end;
+
+function FirstDottedIdentifier(const Identifier: string): string;
+var
+  p: SizeInt;
+begin
+  p:=Pos('.',Identifier);
+  if p<1 then
+    Result:=Identifier
+  else
+    Result:=LeftStr(Identifier,p-1);
+end;
+
+function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean;
+var
+  l: Integer;
+begin
+  l:=length(Prefix);
+  if (l>length(Identifier))
+      or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then
+    exit(false);
+  Result:=(length(Identifier)=l) or (Identifier[l+1]='.');
+end;
+
+{$IF FPC_FULLVERSION<30101}
+function IsValidIdent(const Ident: string; AllowDots: Boolean;
+  StrictDots: Boolean): Boolean;
+const
+  Alpha = ['A'..'Z', 'a'..'z', '_'];
+  AlphaNum = Alpha + ['0'..'9'];
+  Dot = '.';
+var
+  First: Boolean;
+  I, Len: Integer;
+begin
+  Len := Length(Ident);
+  if Len < 1 then
+    Exit(False);
+  First := True;
+  for I := 1 to Len do
+  begin
+    if First then
+    begin
+      Result := Ident[I] in Alpha;
+      First := False;
+    end
+    else if AllowDots and (Ident[I] = Dot) then
+    begin
+      if StrictDots then
+      begin
+        Result := I < Len;
+        First := True;
+      end;
+    end
+    else
+      Result := Ident[I] in AlphaNum;
+    if not Result then
+      Break;
+  end;
+end;
+{$ENDIF}
+
+function dbgs(const Flags: TPasResolverComputeFlags): string;
+var
+  s: string;
+  f: TPasResolverComputeFlag;
+begin
+  Result:='';
+  for f in Flags do
+    if f in Flags then
+      begin
+      if Result<>'' then Result:=Result+',';
+      str(f,s);
+      Result:=Result+s;
+      end;
+  Result:='['+Result+']';
+end;
+
+function dbgs(const a: TResolvedRefAccess): string;
+begin
+  str(a,Result);
+end;
+
+function dbgs(const Flags: TResolvedReferenceFlags): string;
+var
+  s: string;
+  f: TResolvedReferenceFlag;
+begin
+  Result:='';
+  for f in Flags do
+    if f in Flags then
+      begin
+      if Result<>'' then Result:=Result+',';
+      str(f,s);
+      Result:=Result+s;
+      end;
+  Result:='['+Result+']';
+end;
+
+{ TPasPropertyScope }
+
+destructor TPasPropertyScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasPropertyScope.Destroy START ',ClassName);
+  {$ENDIF}
+  ReleaseAndNil(TPasElement(AncestorProp));
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasPropertyScope.Destroy END',ClassName);
+  {$ENDIF}
+end;
+
+{ TPasEnumTypeScope }
+
+destructor TPasEnumTypeScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasEnumTypeScope.Destroy START ',ClassName);
+  {$ENDIF}
+  ReleaseAndNil(TPasElement(CanonicalSet));
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasEnumTypeScope.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ TPasDotIdentifierScope }
+
+function TPasDotIdentifierScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  Result:=IdentifierScope.FindIdentifier(Identifier);
+end;
+
+procedure TPasDotIdentifierScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+begin
+  IdentifierScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
+end;
+
+procedure TPasDotIdentifierScope.WriteIdentifiers(Prefix: string);
+begin
+  IdentifierScope.WriteIdentifiers(Prefix);
+end;
+
+{ TPasWithExprScope }
+
+class function TPasWithExprScope.IsStoredInElement: boolean;
+begin
+  Result:=false;
+end;
+
+class function TPasWithExprScope.FreeOnPop: boolean;
+begin
+  Result:=false;
+end;
+
+procedure TPasWithExprScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+begin
+  Scope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
+end;
+
+procedure TPasWithExprScope.WriteIdentifiers(Prefix: string);
+begin
+  writeln(Prefix+'WithExpr: '+GetTreeDbg(Expr,length(Prefix)));
+  Scope.WriteIdentifiers(Prefix);
+end;
+
+{ TPasWithScope }
+
+constructor TPasWithScope.Create;
+begin
+  inherited Create;
+  ExpressionScopes:=TObjectList.Create(true);
+end;
+
+destructor TPasWithScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasWithScope.Destroy START ',ClassName);
+  {$ENDIF}
+  FreeAndNil(ExpressionScopes);
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasWithScope.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ TPasProcedureScope }
+
+function TPasProcedureScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  Result:=inherited FindIdentifier(Identifier);
+  if Result<>nil then exit;
+  if ClassScope<>nil then
+    Result:=ClassScope.FindIdentifier(Identifier);
+end;
+
+procedure TPasProcedureScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+begin
+  inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
+  if Abort then exit;
+  if ClassScope<>nil then
+    ClassScope.IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
+end;
+
+function TPasProcedureScope.GetSelfScope: TPasProcedureScope;
+var
+  Proc: TPasProcedure;
+begin
+  Result:=Self;
+  repeat
+    if Result.ClassScope<>nil then exit;
+    Proc:=TPasProcedure(Element);
+    if not (Proc.Parent is TProcedureBody) then exit(nil);
+    Proc:=Proc.Parent.Parent as TPasProcedure;
+    Result:=TPasProcedureScope(Proc.CustomData);
+  until false;
+end;
+
+procedure TPasProcedureScope.WriteIdentifiers(Prefix: string);
+begin
+  inherited WriteIdentifiers(Prefix);
+  if ClassScope<>nil then
+    ClassScope.WriteIdentifiers(Prefix+'  ');
+end;
+
+destructor TPasProcedureScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasProcedureScope.Destroy START ',ClassName);
+  {$ENDIF}
+  inherited Destroy;
+  ReleaseAndNil(TPasElement(SelfArg));
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasProcedureScope.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ TPasClassScope }
+
+destructor TPasClassScope.Destroy;
+begin
+  ReleaseAndNil(TPasElement(CanonicalClassOf));
+  inherited Destroy;
+end;
+
+function TPasClassScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  Result:=inherited FindIdentifier(Identifier);
+  if Result<>nil then exit;
+  if AncestorScope<>nil then
+    Result:=AncestorScope.FindIdentifier(Identifier);
+end;
+
+procedure TPasClassScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+begin
+  inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
+  if Abort then exit;
+  if AncestorScope<>nil then
+    AncestorScope.IterateElements(aName,StartScope,OnIterateElement,Data,Abort);
+end;
+
+procedure TPasClassScope.WriteIdentifiers(Prefix: string);
+begin
+  inherited WriteIdentifiers(Prefix);
+  if AncestorScope<>nil then
+    AncestorScope.WriteIdentifiers(Prefix+'  ');
+end;
+
+{ TPasDotClassScope }
+
+procedure TPasDotClassScope.SetClassScope(AValue: TPasClassScope);
+begin
+  if FClassScope=AValue then Exit;
+  FClassScope:=AValue;
+  IdentifierScope:=AValue;
+end;
+
+{ TPasIdentifier }
+
+procedure TPasIdentifier.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if Element<>nil then
+    Element.Release;
+  FElement:=AValue;
+  if Element<>nil then
+    Element.AddRef;
+end;
+
+destructor TPasIdentifier.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasIdentifier.Destroy START ',ClassName,' "',Identifier,'"');
+  {$ENDIF}
+  Element:=nil;
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasIdentifier.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ EPasResolve }
+
+procedure EPasResolve.SetPasElement(AValue: TPasElement);
+begin
+  if FPasElement=AValue then Exit;
+  if PasElement<>nil then
+    PasElement.Release;
+  FPasElement:=AValue;
+  if PasElement<>nil then
+    PasElement.AddRef;
+end;
+
+destructor EPasResolve.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('EPasResolve.Destroy START ',ClassName);
+  {$ENDIF}
+  PasElement:=nil;
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('EPasResolve.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ TResolvedReference }
+
+procedure TResolvedReference.SetDeclaration(AValue: TPasElement);
+begin
+  if FDeclaration=AValue then Exit;
+  if Declaration<>nil then
+    Declaration.Release;
+  FDeclaration:=AValue;
+  if Declaration<>nil then
+    Declaration.AddRef;
+end;
+
+destructor TResolvedReference.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TResolvedReference.Destroy START ',ClassName);
+  {$ENDIF}
+  Declaration:=nil;
+  FreeAndNil(Context);
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TResolvedReference.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+{ TPasSubScope }
+
+class function TPasSubScope.IsStoredInElement: boolean;
+begin
+  Result:=false;
+end;
+
+{ TPasModuleDotScope }
+
+procedure TPasModuleDotScope.OnInternalIterate(El: TPasElement; ElScope,
+  StartScope: TPasScope; Data: Pointer; var Abort: boolean);
+var
+  FilterData: PPasIterateFilterData absolute Data;
+begin
+  if (El.ClassType=TPasModule) or (El.ClassType=TPasUsesUnit) then
+    exit; // skip used units
+  // call the original iterator
+  FilterData^.OnIterate(El,ElScope,StartScope,FilterData^.Data,Abort);
+end;
+
+procedure TPasModuleDotScope.SetModule(AValue: TPasModule);
+begin
+  if FModule=AValue then Exit;
+  if Module<>nil then
+    Module.Release;
+  FModule:=AValue;
+  if Module<>nil then
+    Module.AddRef;
+end;
+
+destructor TPasModuleDotScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasSubModuleScope.Destroy START ',ClassName);
+  {$ENDIF}
+  Module:=nil;
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasSubModuleScope.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+function TPasModuleDotScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  if ImplementationScope<>nil then
+    begin
+    Result:=ImplementationScope.FindLocalIdentifier(Identifier);
+    if (Result<>nil) and (Result.Element.ClassType<>TPasModule) then
+      exit;
+    end;
+  if InterfaceScope<>nil then
+    Result:=InterfaceScope.FindLocalIdentifier(Identifier)
+  else
+    Result:=nil;
+end;
+
+procedure TPasModuleDotScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+var
+  FilterData: TPasIterateFilterData;
+begin
+  FilterData.OnIterate:=OnIterateElement;
+  FilterData.Data:=Data;
+  if ImplementationScope<>nil then
+    begin
+    ImplementationScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
+    if Abort then exit;
+    end;
+  if InterfaceScope<>nil then
+    InterfaceScope.IterateLocalElements(aName,StartScope,@OnInternalIterate,@FilterData,Abort);
+end;
+
+procedure TPasModuleDotScope.WriteIdentifiers(Prefix: string);
+begin
+  if ImplementationScope<>nil then
+    ImplementationScope.WriteIdentifiers(Prefix+'  ');
+  if InterfaceScope<>nil then
+    InterfaceScope.WriteIdentifiers(Prefix+'  ');
+end;
+
+{ TPasSectionScope }
+
+constructor TPasSectionScope.Create;
+begin
+  inherited Create;
+  UsesScopes:=TFPList.Create;
+end;
+
+destructor TPasSectionScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasSectionScope.Destroy START ',ClassName);
+  {$ENDIF}
+  FreeAndNil(UsesScopes);
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasSectionScope.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+function TPasSectionScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+var
+  i: Integer;
+  UsesScope: TPasIdentifierScope;
+begin
+  Result:=inherited FindIdentifier(Identifier);
+  if Result<>nil then
+    exit;
+  for i:=0 to UsesScopes.Count-1 do
+    begin
+    UsesScope:=TPasIdentifierScope(UsesScopes[i]);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasSectionScope.FindIdentifier "',Identifier,'" in used unit ',GetObjName(UsesScope.Element));
+    {$ENDIF}
+    Result:=UsesScope.FindLocalIdentifier(Identifier);
+    if Result<>nil then exit;
+    end;
+end;
+
+procedure TPasSectionScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+var
+  i: Integer;
+  UsesScope: TPasIdentifierScope;
+begin
+  inherited IterateElements(aName, StartScope, OnIterateElement, Data, Abort);
+  if Abort then exit;
+  for i:=0 to UsesScopes.Count-1 do
+    begin
+    UsesScope:=TPasIdentifierScope(UsesScopes[i]);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasSectionScope.IterateElements "',aName,'" in used unit ',GetObjName(UsesScope.Element));
+    {$ENDIF}
+    UsesScope.IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
+    if Abort then exit;
+    end;
+end;
+
+procedure TPasSectionScope.WriteIdentifiers(Prefix: string);
+var
+  i: Integer;
+  UsesScope: TPasIdentifierScope;
+begin
+  inherited WriteIdentifiers(Prefix);
+  for i:=0 to UsesScopes.Count-1 do
+    begin
+    UsesScope:=TPasIdentifierScope(UsesScopes[i]);
+    writeln(Prefix+'Uses: '+GetObjName(UsesScope.Element));
+    end;
+end;
+
+{ TPasModuleScope }
+
+procedure TPasModuleScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+begin
+  if CompareText(aName,FirstName)<>0 then exit;
+  OnIterateElement(Element,Self,StartScope,Data,Abort);
+end;
+
+{ TPasDefaultScope }
+
+class function TPasDefaultScope.IsStoredInElement: boolean;
+begin
+  Result:=false;
+end;
+
+{ TPasScope }
+
+class function TPasScope.IsStoredInElement: boolean;
+begin
+  Result:=true;
+end;
+
+class function TPasScope.FreeOnPop: boolean;
+begin
+  Result:=not IsStoredInElement;
+end;
+
+procedure TPasScope.IterateElements(const aName: string; StartScope: TPasScope;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+begin
+  if aName='' then ;
+  if StartScope=nil then ;
+  if Data=nil then ;
+  if OnIterateElement=nil then ;
+  if Abort then ;
+end;
+
+procedure TPasScope.WriteIdentifiers(Prefix: string);
+begin
+  writeln(Prefix,'Element: ',GetObjName(Element));
+end;
+
+{ TPasIdentifierScope }
+
+// inline
+function TPasIdentifierScope.FindLocalIdentifier(const Identifier: String
+  ): TPasIdentifier;
+var
+  LoName: String;
+begin
+  LoName:=lowercase(Identifier);
+  Result:=TPasIdentifier(FItems.Find(LoName));
+end;
+
+procedure TPasIdentifierScope.OnClearItem(Item, Dummy: pointer);
+var
+  PasIdentifier: TPasIdentifier absolute Item;
+  Ident: TPasIdentifier;
+begin
+  if Dummy=nil then ;
+  //writeln('TPasIdentifierScope.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
+  while PasIdentifier<>nil do
+    begin
+    Ident:=PasIdentifier;
+    PasIdentifier:=PasIdentifier.NextSameIdentifier;
+    Ident.Free;
+    end;
+end;
+
+procedure TPasIdentifierScope.OnWriteItem(Item, Dummy: pointer);
+var
+  PasIdentifier: TPasIdentifier absolute Item;
+  Prefix: String;
+begin
+  Prefix:=AnsiString(Dummy);
+  while PasIdentifier<>nil do
+    begin
+    writeln(Prefix,'Identifier="',PasIdentifier.Identifier,'" Element=',GetObjName(PasIdentifier.Element));
+    PasIdentifier:=PasIdentifier.NextSameIdentifier;
+    end;
+end;
+
+procedure TPasIdentifierScope.InternalAdd(Item: TPasIdentifier);
+var
+  Index: Integer;
+  OldItem: TPasIdentifier;
+  LoName: string;
+begin
+  LoName:=lowercase(Item.Identifier);
+  Index:=FItems.FindIndexOf(LoName);
+  {$IFDEF VerbosePasResolver}
+  if Item.Owner<>nil then
+    raise Exception.Create('20160925184110');
+  Item.Owner:=Self;
+  {$ENDIF}
+  //writeln('  Index=',Index);
+  if Index>=0 then
+    begin
+    // insert LIFO - last in, first out
+    OldItem:=TPasIdentifier(FItems.List^[Index].Data);
+    {$IFDEF VerbosePasResolver}
+    if lowercase(OldItem.Identifier)<>LoName then
+      raise Exception.Create('20160925183438');
+    {$ENDIF}
+    Item.NextSameIdentifier:=OldItem;
+    FItems.List^[Index].Data:=Item;
+    end
+  else
+    begin
+    FItems.Add(LoName, Item);
+    {$IFDEF VerbosePasResolver}
+    if FindIdentifier(Item.Identifier)<>Item then
+      raise Exception.Create('20160925183849');
+    {$ENDIF}
+    end;
+end;
+
+constructor TPasIdentifierScope.Create;
+begin
+  FItems:=TFPHashList.Create;
+end;
+
+destructor TPasIdentifierScope.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasIdentifierScope.Destroy START ',ClassName);
+  {$ENDIF}
+  FItems.ForEachCall(@OnClearItem,nil);
+  FItems.Clear;
+  FreeAndNil(FItems);
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasIdentifierScope.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+function TPasIdentifierScope.FindIdentifier(const Identifier: String
+  ): TPasIdentifier;
+begin
+  Result:=FindLocalIdentifier(Identifier);
+  {$IFDEF VerbosePasResolver}
+  if (Result<>nil) and (Result.Owner<>Self) then
+    begin
+    writeln('TPasIdentifierScope.FindIdentifier Result.Owner<>Self Owner='+GetObjName(Result.Owner));
+    raise Exception.Create('20160925184159');
+    end;
+  {$ENDIF}
+end;
+
+function TPasIdentifierScope.RemoveLocalIdentifier(El: TPasElement): boolean;
+var
+  Identifier, PrevIdentifier: TPasIdentifier;
+  LoName: string;
+begin
+  LoName:=lowercase(El.Name);
+  Identifier:=TPasIdentifier(FItems.Find(LoName));
+  FindLocalIdentifier(El.Name);
+  PrevIdentifier:=nil;
+  Result:=false;
+  while Identifier<>nil do
+    begin
+    {$IFDEF VerbosePasResolver}
+    if (Identifier.Owner<>Self) then
+      raise Exception.Create('20160925184159');
+    {$ENDIF}
+    if Identifier.Element=El then
+      begin
+      if PrevIdentifier<>nil then
+        begin
+        PrevIdentifier.NextSameIdentifier:=Identifier.NextSameIdentifier;
+        Identifier.Free;
+        Identifier:=PrevIdentifier.NextSameIdentifier;
+        end
+      else
+        begin
+        FItems.Remove(Identifier);
+        PrevIdentifier:=Identifier;
+        Identifier:=Identifier.NextSameIdentifier;
+        PrevIdentifier.Free;
+        PrevIdentifier:=nil;
+        if Identifier<>nil then
+          FItems.Add(Loname,Identifier);
+        end;
+      Result:=true;
+      continue;
+      end;
+    PrevIdentifier:=Identifier;
+    Identifier:=Identifier.NextSameIdentifier;
+    end;
+end;
+
+function TPasIdentifierScope.AddIdentifier(const Identifier: String;
+  El: TPasElement; const Kind: TPasIdentifierKind): TPasIdentifier;
+var
+  Item: TPasIdentifier;
+begin
+  //writeln('TPasIdentifierScope.AddIdentifier Identifier="',Identifier,'" El=',GetObjName(El));
+  Item:=TPasIdentifier.Create;
+  Item.Identifier:=Identifier;
+  Item.Element:=El;
+  Item.Kind:=Kind;
+
+  InternalAdd(Item);
+  //writeln('TPasIdentifierScope.AddIdentifier END');
+  Result:=Item;
+end;
+
+function TPasIdentifierScope.FindElement(const aName: string): TPasElement;
+var
+  Item: TPasIdentifier;
+begin
+  //writeln('TPasIdentifierScope.FindElement "',aName,'"');
+  Item:=FindIdentifier(aName);
+  if Item=nil then
+    Result:=nil
+  else
+    Result:=Item.Element;
+  //writeln('TPasIdentifierScope.FindElement Found="',GetObjName(Result),'"');
+end;
+
+procedure TPasIdentifierScope.IterateLocalElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+var
+  Item: TPasIdentifier;
+  {$IFDEF VerbosePasResolver}
+  OldElement: TPasElement;
+  {$ENDIF}
+begin
+  Item:=FindLocalIdentifier(aName);
+  while Item<>nil do
+    begin
+    //writeln('TPasIdentifierScope.IterateLocalElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
+    {$IFDEF VerbosePasResolver}
+    OldElement:=Item.Element;
+    {$ENDIF}
+    OnIterateElement(Item.Element,Self,StartScope,Data,Abort);
+    {$IFDEF VerbosePasResolver}
+    if OldElement<>Item.Element then
+      raise Exception.Create('20160925183503');
+    {$ENDIF}
+    if Abort then exit;
+    Item:=Item.NextSameIdentifier;
+    end;
+end;
+
+procedure TPasIdentifierScope.IterateElements(const aName: string;
+  StartScope: TPasScope; const OnIterateElement: TIterateScopeElement;
+  Data: Pointer; var Abort: boolean);
+begin
+  IterateLocalElements(aName,StartScope,OnIterateElement,Data,Abort);
+end;
+
+procedure TPasIdentifierScope.WriteIdentifiers(Prefix: string);
+begin
+  inherited WriteIdentifiers(Prefix);
+  Prefix:=Prefix+'  ';
+  FItems.ForEachCall(@OnWriteItem,Pointer(Prefix));
+end;
+
+{ TPasResolver }
+
+// inline
+function TPasResolver.GetBaseTypes(bt: TResolverBaseType
+  ): TPasUnresolvedSymbolRef;
+begin
+  Result:=FBaseTypes[bt];
+end;
+
+// inline
+function TPasResolver.GetScopes(Index: integer): TPasScope;
+begin
+  Result:=FScopes[Index];
+end;
+
+// inline
+function TPasResolver.IsNameExpr(El: TPasExpr): boolean;
+begin
+  Result:=(El.ClassType=TSelfExpr)
+      or ((El.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(El).Kind=pekIdent));
+end;
+
+function TPasResolver.GetNameExprValue(El: TPasExpr): string;
+begin
+  if El=nil then
+    Result:=''
+  else if El.ClassType=TPrimitiveExpr then
+    begin
+    if TPrimitiveExpr(El).Kind=pekIdent then
+      Result:=TPrimitiveExpr(El).Value
+    else
+      Result:='';
+    end
+  else if El.ClassType=TSelfExpr then
+    Result:='self'
+  else
+    Result:='';
+end;
+
+function TPasResolver.GetNextDottedExpr(El: TPasExpr): TPasExpr;
+// returns TSelfExpr or TPrimitiveExpr (Kind=pekIdent)
+var
+  Bin: TBinaryExpr;
+  C: TClass;
+begin
+  Result:=nil;
+  if El=nil then exit;
+  repeat
+    if not (El.Parent is TBinaryExpr) then exit;
+    Bin:=TBinaryExpr(El.Parent);
+    if Bin.OpCode<>eopSubIdent then exit;
+    if El=Bin.right then
+      El:=Bin
+    else
+      begin
+      El:=Bin.right;
+      // find left most
+      repeat
+        C:=El.ClassType;
+        if C=TSelfExpr then
+          exit(El)
+        else if C=TPrimitiveExpr then
+          begin
+          if TPrimitiveExpr(El).Kind<>pekIdent then
+            RaiseNotYetImplemented(20170502163825,El);
+          exit(El);
+          end
+        else if C=TBinaryExpr then
+          begin
+          if TBinaryExpr(El).OpCode<>eopSubIdent then
+            RaiseNotYetImplemented(20170502163718,El);
+          El:=TBinaryExpr(El).left;
+          end
+        else if C=TParamsExpr then
+          begin
+          if not (TParamsExpr(El).Kind in [pekFuncParams,pekArrayParams]) then
+            RaiseNotYetImplemented(20170502163908,El);
+          El:=TParamsExpr(El).Value;
+          end;
+      until El=nil;
+      RaiseNotYetImplemented(20170502163953,Bin);
+      end;
+  until false;
+end;
+
+function TPasResolver.GetPathStart(El: TPasExpr): TPasExpr;
+// get leftmost name element (e.g. TPrimitiveExpr or TSelfExpr)
+// nil if not found
+var
+  C: TClass;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    C:=El.ClassType;
+    if C=TPrimitiveExpr then
+      exit(El)
+    else if C=TSelfExpr then
+      exit(El)
+    else if C=TBinaryExpr then
+      begin
+      if TBinaryExpr(El).OpCode=eopSubIdent then
+        El:=TBinaryExpr(El).left
+      else
+        exit;
+      end
+    else if C=TParamsExpr then
+      El:=TParamsExpr(El).Value
+    else
+      exit;
+    end;
+end;
+
+function TPasResolver.GetNewInstanceExpr(El: TPasExpr): TPasExpr;
+// if the expression is a constructor newinstance call,
+// return the element referring the constructor
+// else nil
+var
+  C: TClass;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    if (El.CustomData is TResolvedReference)
+        and (rrfNewInstance in TResolvedReference(El.CustomData).Flags) then
+      exit(El);
+    C:=El.ClassType;
+    if C=TBinaryExpr then
+      begin
+      if TBinaryExpr(El).OpCode=eopSubIdent then
+        El:=TBinaryExpr(El).right
+      else
+        exit;
+      end
+    else if C=TParamsExpr then
+      El:=TParamsExpr(El).Value
+    else
+      exit;
+    end;
+end;
+
+procedure TPasResolver.ClearResolveDataList(Kind: TResolveDataListKind);
+var
+  El: TPasElement;
+  RData: TResolveData;
+begin
+  // clear CustomData
+  while FLastCreatedData[Kind]<>nil do
+    begin
+    RData:=FLastCreatedData[Kind];
+    El:=RData.Element;
+    El.CustomData:=nil;
+    FLastCreatedData[Kind]:=RData.Next;
+    RData.Free;
+    end;
+end;
+
+function TPasResolver.GetBaseTypeNames(bt: TResolverBaseType): string;
+begin
+  if FBaseTypes[bt]<>nil then
+    Result:=FBaseTypes[bt].Name
+  else
+    Result:=ResBaseTypeNames[bt];
+end;
+
+procedure TPasResolver.OnFindFirstElement(El: TPasElement; ElScope,
+  StartScope: TPasScope; FindFirstElementData: Pointer; var Abort: boolean);
+var
+  Data: PPRFindData absolute FindFirstElementData;
+  ok: Boolean;
+begin
+  ok:=true;
+  if (El is TPasProcedure)
+      and ProcNeedsParams(TPasProcedure(El).ProcType) then
+    // found a proc, but it needs parameters -> remember the first and continue
+    ok:=false;
+  if ok or (Data^.Found=nil) then
+    begin
+    Data^.Found:=El;
+    Data^.ElScope:=ElScope;
+    Data^.StartScope:=StartScope;
+    end;
+  if ok then
+    Abort:=true;
+end;
+
+procedure TPasResolver.OnFindCallElements(El: TPasElement; ElScope,
+  StartScope: TPasScope; FindProcsData: Pointer; var Abort: boolean);
+var
+  Data: PFindCallElData absolute FindProcsData;
+  Proc, PrevProc: TPasProcedure;
+  Distance: integer;
+  BuiltInProc: TResElDataBuiltInProc;
+  CandidateFound: Boolean;
+  VarType, TypeEl: TPasType;
+  C: TClass;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnFindCallElements START --------- ',GetObjName(El),' at ',GetElementSourcePosStr(El));
+  {$ENDIF}
+  CandidateFound:=false;
+
+  if (El is TPasProcedure) then
+    begin
+    // identifier is a proc
+    Proc:=TPasProcedure(El);
+
+    if Data^.Found=Proc then
+      begin
+      // this proc was already found. This happens when this is the forward
+      // declaration or a previously found implementation.
+      Data^.ElScope:=ElScope;
+      Data^.StartScope:=StartScope;
+      exit;
+      end;
+
+    if (Proc.CustomData is TPasProcedureScope)
+        and (TPasProcedureScope(Proc.CustomData).DeclarationProc<>nil)
+    then
+      begin
+      // this proc has a forward declaration -> use that instead
+      Proc:=TPasProcedureScope(Proc.CustomData).DeclarationProc;
+      El:=Proc;
+      end;
+
+    if Data^.Found is TPasProcedure then
+      begin
+      // there is already a previous proc
+      PrevProc:=TPasProcedure(Data^.Found);
+
+      if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
+          and (PrevProc.Parent.ClassType=TPasClassType) then
+        begin
+        // there was already a perfect proc in a descendant
+        Abort:=true;
+        exit;
+        end;
+
+      // check if previous found proc is override of found proc
+      if (PrevProc.IsOverride)
+          and (TPasProcedureScope(PrevProc.CustomData).OverriddenProc=Proc) then
+        begin
+        // previous found proc is override of found proc -> skip
+        exit;
+        end;
+      end;
+
+    Distance:=CheckCallProcCompatibility(Proc.ProcType,Data^.Params,false);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnFindCallElements Proc Distance=',Distance,
+      ' Data^.Found=',Data^.Found<>nil,' Data^.Distance=',ord(Data^.Distance),
+      ' Signature={',GetProcTypeDescription(Proc.ProcType,true,true),'}');
+    {$ENDIF}
+    CandidateFound:=true;
+    end
+  else if El is TPasType then
+    begin
+    TypeEl:=ResolveAliasType(TPasType(El));
+    C:=TypeEl.ClassType;
+    if C=TPasUnresolvedSymbolRef then
+      begin
+      if TypeEl.CustomData.ClassType=TResElDataBuiltInProc then
+        begin
+        // call of built-in proc
+        BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
+        if (BuiltInProc.BuiltIn in [bfStrProc,bfStrFunc])
+            and ((BuiltInProc.BuiltIn=bfStrProc) = ParentNeedsExprResult(Data^.Params)) then
+          begin
+          // str function can only be used within an expression
+          // str procedure can only be used outside an expression
+          {$IFDEF VerbosePasResolver}
+          writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' skip');
+          {$ENDIF}
+          exit;
+          end;
+        Distance:=BuiltInProc.GetCallCompatibility(BuiltInProc,Data^.Params,false);
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.OnFindCallElements BuiltInProc=',El.Name,' Distance=',Distance);
+        {$ENDIF}
+        CandidateFound:=true;
+        end
+      else if TypeEl.CustomData is TResElDataBaseType then
+        begin
+        // type cast to base type
+        Abort:=true; // can't be overloaded
+        if Data^.Found<>nil then exit;
+        Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.OnFindCallElements Base type cast=',El.Name,' Distance=',Distance);
+        {$ENDIF}
+        CandidateFound:=true;
+        end;
+      end
+    else if (C=TPasClassType)
+        or (C=TPasClassOfType)
+        or (C=TPasRecordType)
+        or (C=TPasEnumType)
+        or (C=TPasProcedureType)
+        or (C=TPasFunctionType)
+        or (C=TPasArrayType) then
+      begin
+      // type cast to user type
+      Abort:=true; // can't be overloaded
+      if Data^.Found<>nil then exit;
+      Distance:=CheckTypeCast(TPasType(El),Data^.Params,false);
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.OnFindCallElements type cast to =',GetObjName(El),' Distance=',Distance);
+      {$ENDIF}
+      CandidateFound:=true;
+      end;
+    end
+  else if El is TPasVariable then
+    begin
+    Abort:=true; // can't be overloaded
+    if Data^.Found<>nil then exit;
+    VarType:=ResolveAliasType(TPasVariable(El).VarType);
+    if VarType is TPasProcedureType then
+      begin
+      Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.OnFindCallElements call var of proctype=',El.Name,' Distance=',Distance);
+      {$ENDIF}
+      CandidateFound:=true;
+      end;
+    end
+  else if El.ClassType=TPasArgument then
+    begin
+    Abort:=true; // can't be overloaded
+    if Data^.Found<>nil then exit;
+    VarType:=ResolveAliasType(TPasArgument(El).ArgType);
+    if VarType is TPasProcedureType then
+      begin
+      Distance:=CheckCallProcCompatibility(TPasProcedureType(VarType),Data^.Params,false);
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.OnFindCallElements call arg of proctype=',El.Name,' Distance=',Distance);
+      {$ENDIF}
+      CandidateFound:=true;
+      end;
+    end;
+
+  if not CandidateFound then
+    begin
+    // El does not support the () operator
+    Abort:=true;
+    if Data^.Found=nil then
+      begin
+      // El is the first element found -> raise error
+      // ToDo: use the ( as error position
+      RaiseMsg(20170216151525,nIllegalQualifier,sIllegalQualifier,['('],Data^.Params);
+      end;
+    exit;
+    end;
+
+  // El is a candidate (might be incompatible)
+  if (Data^.Found=nil)
+      or ((Data^.Distance=cIncompatible) and (Distance<cIncompatible)) then
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnFindCallElements Found first candidate Distance=',Distance);
+    {$ENDIF}
+    Data^.Found:=El;
+    Data^.ElScope:=ElScope;
+    Data^.StartScope:=StartScope;
+    Data^.Distance:=Distance;
+    Data^.Count:=1;
+    if Data^.List<>nil then
+      begin
+      Data^.List.Clear;
+      Data^.List.Add(El);
+      end;
+    end
+  else if Distance=cIncompatible then
+    // another candidate, but it is incompatible -> ignore
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnFindCallElements Found another candidate, but it is incompatible -> ignore')
+    {$ENDIF}
+  else if (Distance>=cCompatibleWithDefaultParams)
+        or (Data^.Distance=Distance)
+        or ((Distance>=cLossyConversion) and (Data^.Distance>=cLossyConversion)) then
+    begin
+    // found another compatible one -> collect
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnFindCallElements Found another candidate Distance=',Distance,' OldDistance=',Data^.Distance);
+    {$ENDIF}
+    inc(Data^.Count);
+    if (Data^.List<>nil) then
+      begin
+      if (Data^.List.IndexOf(El)>=0) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.OnFindCallElements Found El twice: ',GetTreeDbg(El),
+          ' ',GetElementSourcePosStr(El),
+          ' PrevElScope=',GetObjName(Data^.ElScope),' ',GetTreeDbg(Data^.ElScope.Element),
+          ' ElScope=',GetObjName(ElScope),' ',GetTreeDbg(ElScope.Element)
+          );
+        {$ENDIF}
+        RaiseInternalError(20160924230805);
+        end;
+      Data^.List.Add(El);
+      end;
+    end
+  else if (Distance<Data^.Distance) then
+    begin
+    // found a better one
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnFindCallElements Found a better candidate Distance=',Distance,' Data^.Distance=',Data^.Distance);
+    {$ENDIF}
+    Data^.Found:=El;
+    Data^.ElScope:=ElScope;
+    Data^.StartScope:=StartScope;
+    Data^.Distance:=Distance;
+    if (Distance<cLossyConversion) then
+      begin
+      // found a good one
+      Data^.Count:=1;
+      if Data^.List<>nil then
+        Data^.List.Clear;
+      end
+    else
+      begin
+      // found another lossy one
+      // -> collect them
+      inc(Data^.Count);
+      end;
+    if Data^.List<>nil then
+      Data^.List.Add(El);
+    end;
+end;
+
+procedure TPasResolver.OnFindOverloadProc(El: TPasElement; ElScope,
+  StartScope: TPasScope; FindOverloadData: Pointer; var Abort: boolean);
+var
+  Data: PFindOverloadProcData absolute FindOverloadData;
+  Proc: TPasProcedure;
+begin
+  //writeln('TPasResolver.OnFindOverloadProc START ',El.Name,':',El.ElementTypeName,' itself=',El=Data^.Proc);
+  if not (El is TPasProcedure) then
+    begin
+    // identifier is not a proc
+    if (El is TPasVariable) then
+      begin
+      if TPasVariable(El).Visibility=visStrictPrivate then
+        exit;
+      if (TPasVariable(El).Visibility=visPrivate)
+          and (El.GetModule<>StartScope.Element.GetModule) then
+        exit;
+      end;
+    Data^.FoundNonProc:=El;
+    Abort:=true;
+    exit;
+    end;
+  // identifier is a proc
+  if El=Data^.Proc then
+    exit; // found itself -> normal when searching for overloads
+
+  //writeln('TPasResolver.OnFindOverloadProc Data^.OnlyScope=',GetObjName(Data^.OnlyScope),' ElScope=',GetObjName(ElScope),' ',Data^.OnlyScope=ElScope);
+  if (Data^.OnlyScope<>nil) and (Data^.OnlyScope<>ElScope) then
+    begin
+    // do not search any further, only one scope should be searched
+    // for example when searching the method declaration of a method body
+    Abort:=false;
+    exit;
+    end;
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnFindOverloadProc ',GetTreeDbg(El,2));
+  {$ENDIF}
+  Proc:=TPasProcedure(El);
+  if CheckOverloadProcCompatibility(Data^.Proc,Proc) then
+    begin
+    Data^.Found:=Proc;
+    Data^.ElScope:=ElScope;
+    Data^.StartScope:=StartScope;
+    Abort:=true;
+    end;
+end;
+
+procedure TPasResolver.SetCurrentParser(AValue: TPasParser);
+begin
+  //writeln('TPasResolver.SetCurrentParser ',AValue<>nil);
+  if AValue=CurrentParser then exit;
+  Clear;
+  inherited SetCurrentParser(AValue);
+  if CurrentParser<>nil then
+    CurrentParser.Options:=CurrentParser.Options
+      +[po_resolvestandardtypes,po_nooverloadedprocs,po_keepclassforward,
+        po_arrayrangeexpr,po_CheckModeswitches,po_CheckCondFunction];
+end;
+
+procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass);
+begin
+  if TopScope=nil then
+    RaiseInternalError(20160922163319,'Expected TopScope='+ExpectedClass.ClassName+' but found nil');
+  if TopScope.ClassType<>ExpectedClass then
+    RaiseInternalError(20160922163323,'Expected TopScope='+ExpectedClass.ClassName+' but found '+TopScope.ClassName);
+end;
+
+function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
+  const aName: String; El: TPasElement; const Kind: TPasIdentifierKind
+  ): TPasIdentifier;
+var
+  Identifier, OlderIdentifier: TPasIdentifier;
+  ClassScope: TPasClassScope;
+  OlderEl: TPasElement;
+  IsClassScope: Boolean;
+  C: TClass;
+begin
+  IsClassScope:=(Scope is TPasClassScope);
+
+  if (El.Visibility=visPublished) then
+    begin
+    C:=El.ClassType;
+    if (C=TPasProperty) or (C=TPasVariable) then
+      // Note: VarModifiers are not yet set
+    else if (C=TPasProcedure) or (C=TPasFunction) then
+      // ok
+    else
+      RaiseMsg(20170403223024,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
+    end;
+
+  if (Kind=pikSimple) and IsClassScope
+      and (El.ClassType<>TPasProperty) then
+    begin
+    // check duplicate in ancestors
+    ClassScope:=TPasClassScope(Scope).AncestorScope;
+    while ClassScope<>nil do
+      begin
+      OlderIdentifier:=ClassScope.FindLocalIdentifier(aName);
+      while OlderIdentifier<>nil do
+        begin
+        OlderEl:=OlderIdentifier.Element;
+        OlderIdentifier:=OlderIdentifier.NextSameIdentifier;
+        if OlderEl is TPasVariable then
+          begin
+          if TPasVariable(OlderEl).Visibility=visStrictPrivate then
+            continue; // OlderEl is hidden
+          if (TPasVariable(OlderEl).Visibility=visPrivate)
+              and (OlderEl.GetModule<>El.GetModule) then
+            continue; // OlderEl is hidden
+          end;
+        RaiseMsg(20170221130001,nDuplicateIdentifier,sDuplicateIdentifier,
+                 [aName,GetElementSourcePosStr(OlderEl)],El);
+        end;
+      ClassScope:=ClassScope.AncestorScope;
+      end;
+    end;
+
+  Identifier:=Scope.AddIdentifier(aName,El,Kind);
+
+  // check duplicate in current scope
+  OlderIdentifier:=Identifier.NextSameIdentifier;
+  if (OlderIdentifier<>nil) then
+    if (Identifier.Kind=pikSimple)
+        or (OlderIdentifier.Kind=pikSimple)
+        or (El.Visibility=visPublished) then
+      begin
+      if (OlderIdentifier.Element.ClassType=TPasEnumValue)
+          and (OlderIdentifier.Element.Parent.Parent<>Scope.Element) then
+        // this enum was propagated from a sub type -> remove enum
+        Scope.RemoveLocalIdentifier(OlderIdentifier.Element);
+      RaiseMsg(20170216151530,nDuplicateIdentifier,sDuplicateIdentifier,
+               [aName,GetElementSourcePosStr(OlderIdentifier.Element)],El);
+      end;
+
+  Result:=Identifier;
+end;
+
+procedure TPasResolver.FinishModule(CurModule: TPasModule);
+var
+  CurModuleClass: TClass;
+  i: Integer;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishModule START ',CurModule.Name);
+  {$ENDIF}
+  CurModuleClass:=CurModule.ClassType;
+  if (CurModuleClass=TPasProgram) or (CurModuleClass=TPasLibrary) then
+    begin
+    // resolve begin..end block
+    ResolveImplBlock(CurModule.InitializationSection);
+    end
+  else if (CurModuleClass=TPasModule) then
+    begin
+    if CurModule.FinalizationSection<>nil then
+      // finalization section finished -> resolve
+      ResolveImplBlock(CurModule.FinalizationSection);
+    if CurModule.InitializationSection<>nil then
+      // initialization section finished -> resolve
+      ResolveImplBlock(CurModule.InitializationSection);
+    end
+  else
+    RaiseInternalError(20160922163327); // unknown module
+
+  // check all methods have bodies
+  // and all forward classes and pointers are resolved
+  for i:=0 to FPendingForwards.Count-1 do
+    CheckPendingForwards(TPasElement(FPendingForwards[i]));
+  FPendingForwards.Clear;
+
+  // close all sections
+  while (TopScope<>nil) and (TopScope.ClassType=TPasSectionScope) do
+    PopScope;
+  CheckTopScope(TPasModuleScope);
+  PopScope;
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishModule END ',CurModule.Name);
+  {$ENDIF}
+end;
+
+procedure TPasResolver.FinishUsesClause;
+var
+  Section, CurSection: TPasSection;
+  i, j: Integer;
+  PublicEl, UseModule: TPasElement;
+  Scope: TPasSectionScope;
+  UsesScope: TPasIdentifierScope;
+  UseUnit: TPasUsesUnit;
+  FirstName: String;
+  p: SizeInt;
+  OldIdentifier: TPasIdentifier;
+begin
+  CheckTopScope(TPasSectionScope);
+  Scope:=TPasSectionScope(TopScope);
+  Section:=TPasSection(Scope.Element);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishUsesClause Section=',Section.ClassName,' Section.UsesList.Count=',Section.UsesList.Count);
+  {$ENDIF}
+  for i:=0 to Section.UsesList.Count-1 do
+    begin
+    UseUnit:=Section.UsesClause[i];
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishUsesClause ',GetObjName(UseUnit));
+    {$ENDIF}
+    UseModule:=UseUnit.Module;
+
+    // check used unit
+    PublicEl:=nil;
+    if (UseModule.ClassType=TLibrarySection) then
+      PublicEl:=UseModule
+    else if (UseModule.ClassType=TPasModule) then
+      PublicEl:=TPasModule(UseModule).InterfaceSection
+    else
+      RaiseXExpectedButYFound(20170503004803,'unit',UseModule.ElementTypeName,UseUnit);
+    if PublicEl=nil then
+      RaiseInternalError(20160922163352,'uses element has no interface section: '+GetObjName(UseModule));
+    if PublicEl.CustomData=nil then
+      RaiseInternalError(20160922163358,'uses element has no resolver data: '
+        +UseUnit.Name+'->'+GetObjName(PublicEl));
+    if not (PublicEl.CustomData is TPasIdentifierScope) then
+      RaiseInternalError(20160922163403,'uses element has invalid resolver data: '
+        +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
+
+    // check if module was already used by a different name
+    j:=i;
+    CurSection:=Section;
+    repeat
+      dec(j);
+      if j<0 then
+        begin
+        if CurSection.ClassType<>TImplementationSection then
+          break;
+        CurSection:=CurSection.GetModule.InterfaceSection;
+        if CurSection=nil then break;
+        j:=length(CurSection.UsesClause)-1;
+        if j<0 then break;
+        end;
+      if CurSection.UsesClause[j].Module=UseModule then
+        RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
+          [UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
+    until false;
+
+    // add full uses name
+    AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
+
+    // add scope
+    UsesScope:=TPasIdentifierScope(PublicEl.CustomData);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishUsesClause Add UsesScope=',GetObjName(UsesScope));
+    {$ENDIF}
+    Scope.UsesScopes.Add(UsesScope);
+
+    EmitElementHints(Section,UseUnit);
+    end;
+
+  // Note: a sub identifier (e.g. a class member) hides all unitnames starting
+  //       with this identifier
+  // -> add first name of dotted unitname as identifier
+  for i:=0 to Section.UsesList.Count-1 do
+    begin
+    UseUnit:=Section.UsesClause[i];
+    FirstName:=UseUnit.Name;
+    p:=Pos('.',FirstName);
+    if p<1 then continue;
+    FirstName:=LeftStr(FirstName,p-1);
+    OldIdentifier:=Scope.FindLocalIdentifier(FirstName);
+    if OldIdentifier=nil then
+      AddIdentifier(Scope,FirstName,UseUnit.Module,pikSimple)
+    else
+      // a reference in the implementation needs to find a match in the
+      // implementation clause -> replace identfier in the scope
+      OldIdentifier.Element:=UseUnit;
+    end;
+end;
+
+procedure TPasResolver.FinishTypeSection(El: TPasDeclarations);
+var
+  i: Integer;
+  Decl: TPasElement;
+  ClassOfEl: TPasClassOfType;
+  Data: TPRFindData;
+  UnresolvedEl: TUnresolvedPendingRef;
+  Abort: boolean;
+  OldClassType: TPasClassType;
+  ClassOfName: String;
+begin
+  // resolve pending forwards
+  for i:=0 to El.Declarations.Count-1 do
+    begin
+    Decl:=TPasElement(El.Declarations[i]);
+    if Decl is TPasClassType then
+      begin
+      if TPasClassType(Decl).IsForward and (TPasClassType(Decl).CustomData=nil) then
+        RaiseMsg(20170216151534,nForwardTypeNotResolved,sForwardTypeNotResolved,[Decl.Name],Decl);
+      end
+    else if (Decl.ClassType=TPasClassOfType) then
+      begin
+      ClassOfEl:=TPasClassOfType(Decl);
+      Data:=Default(TPRFindData);
+      if (ClassOfEl.DestType.ClassType=TUnresolvedPendingRef) then
+        begin
+        // forward class-of -> resolve now
+        UnresolvedEl:=TUnresolvedPendingRef(ClassOfEl.DestType);
+        ClassOfName:=UnresolvedEl.Name;
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of unresolved "',ClassOfName,'"');
+        {$ENDIF}
+        Data.ErrorPosEl:=UnresolvedEl;
+        Abort:=false;
+        (TopScope as TPasIdentifierScope).IterateElements(ClassOfName,
+          TopScope,@OnFindFirstElement,@Data,Abort);
+        if (Data.Found=nil) then
+          RaiseIdentifierNotFound(20170216151543,UnresolvedEl.Name,UnresolvedEl);
+        if Data.Found.ClassType<>TPasClassType then
+          RaiseXExpectedButYFound(20170216151548,'class',Data.Found.ElementTypeName,UnresolvedEl);
+        // replace unresolved
+        ClassOfEl.DestType:=TPasClassType(Data.Found);
+        ClassOfEl.DestType.AddRef;
+        UnresolvedEl.Release;
+        end
+      else
+        begin
+        // class-of has found a type
+        // another later in the same type section has priority -> check
+        OldClassType:=ClassOfEl.DestType as TPasClassType;
+        if ClassOfEl.DestType.Parent=ClassOfEl.Parent then
+          continue; // class in same type section -> ok
+        // class not in same type section -> check
+        ClassOfName:=OldClassType.Name;
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.FinishTypeSection resolving "',ClassOfEl.Name,'" = class of resolved "',ClassOfName,'"');
+        {$ENDIF}
+        Data.ErrorPosEl:=ClassOfEl;
+        Abort:=false;
+        (TopScope as TPasIdentifierScope).IterateElements(ClassOfName,
+          TopScope,@OnFindFirstElement,@Data,Abort);
+        if (Data.Found=nil) then
+          continue;
+        if Data.Found.ClassType<>TPasClassType then
+          RaiseXExpectedButYFound(20170221171040,'class',Data.Found.ElementTypeName,ClassOfEl);
+        ClassOfEl.DestType:=TPasClassType(Data.Found);
+        ClassOfEl.DestType.AddRef;
+        OldClassType.Release;
+        end;
+      end;
+    end;
+end;
+
+procedure TPasResolver.FinishTypeDef(El: TPasType);
+var
+  C: TClass;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishTypeDef El=',GetObjName(El));
+  {$ENDIF}
+  C:=El.ClassType;
+  if C=TPasEnumType then
+    FinishEnumType(TPasEnumType(El))
+  else if C=TPasSetType then
+    FinishSetType(TPasSetType(El))
+  else if C=TPasRangeType then
+    FinishRangeType(TPasRangeType(El))
+  else if C=TPasRecordType then
+    FinishRecordType(TPasRecordType(El))
+  else if C=TPasClassType then
+    FinishClassType(TPasClassType(El))
+  else if C=TPasClassOfType then
+    FinishClassOfType(TPasClassOfType(El))
+  else if C=TPasArrayType then
+    FinishArrayType(TPasArrayType(El));
+end;
+
+procedure TPasResolver.FinishEnumType(El: TPasEnumType);
+begin
+  if TopScope.Element=El then
+    PopScope;
+end;
+
+procedure TPasResolver.FinishSetType(El: TPasSetType);
+var
+  BaseTypeData: TResElDataBaseType;
+  StartResolved, EndResolved: TPasResolverResult;
+  RangeExpr: TBinaryExpr;
+  C: TClass;
+  EnumType: TPasType;
+begin
+  EnumType:=El.EnumType;
+  C:=EnumType.ClassType;
+  if C=TPasEnumType then
+    begin
+    FinishSubElementType(El,EnumType);
+    exit;
+    end
+  else if C=TPasRangeType then
+    begin
+    RangeExpr:=TPasRangeType(EnumType).RangeExpr;
+    if RangeExpr.Parent=El then
+      FinishConstRangeExpr(RangeExpr.left,RangeExpr.right,StartResolved,EndResolved);
+    FinishSubElementType(El,EnumType);
+    exit;
+    end
+  else if C=TPasUnresolvedSymbolRef then
+    begin
+    if EnumType.CustomData is TResElDataBaseType then
+      begin
+      BaseTypeData:=TResElDataBaseType(EnumType.CustomData);
+      if BaseTypeData.BaseType in [btChar,btBoolean] then
+        exit;
+      RaiseXExpectedButYFound(20170216151553,'char or boolean',EnumType.ElementTypeName,EnumType);
+      end;
+    end;
+  RaiseXExpectedButYFound(20170216151557,'enum type',EnumType.ElementTypeName,EnumType);
+end;
+
+procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
+var
+  Decl: TPasDeclarations;
+  EnumScope: TPasEnumTypeScope;
+begin
+  EmitTypeHints(Parent,El);
+  if (El.Name<>'') or (AnonymousElTypePostfix='') then exit;
+  if Parent.Name='' then
+    RaiseMsg(20170415165455,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
+  if not (Parent.Parent is TPasDeclarations) then
+    RaiseMsg(20170416094735,nCannotNestAnonymousX,sCannotNestAnonymousX,[El.ElementTypeName],El);
+  // give anonymous sub type a name
+  El.Name:=Parent.Name+AnonymousElTypePostfix;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishSubElementType parent="',GetObjName(Parent),'" named anonymous type "',GetObjName(El),'"');
+  {$ENDIF}
+  Decl:=TPasDeclarations(Parent.Parent);
+  Decl.Declarations.Add(El);
+  El.AddRef;
+  El.Parent:=Decl;
+  Decl.Types.Add(El);
+  if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
+    begin
+    EnumScope:=TPasEnumTypeScope(El.CustomData);
+    if EnumScope.CanonicalSet<>Parent then
+      begin
+      if EnumScope.CanonicalSet<>nil then
+        EnumScope.CanonicalSet.Release;
+      EnumScope.CanonicalSet:=TPasSetType(Parent);
+      Parent.AddRef;
+      end;
+    end;
+end;
+
+procedure TPasResolver.FinishRangeType(El: TPasRangeType);
+var
+  StartResolved, EndResolved: TPasResolverResult;
+begin
+  ResolveExpr(El.RangeExpr.left,rraRead);
+  ResolveExpr(El.RangeExpr.right,rraRead);
+  FinishConstRangeExpr(El.RangeExpr.left,El.RangeExpr.right,StartResolved,EndResolved);
+end;
+
+procedure TPasResolver.FinishConstRangeExpr(Left, Right: TPasExpr; out LeftResolved,
+  RightResolved: TPasResolverResult);
+// for example Left..Right
+{$IFDEF EnablePasResRangeCheck}
+var
+  RgValue: TResEvalValue;
+{$ENDIF}
+begin
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
+  {$ENDIF}
+  // check type compatibility
+  ComputeElement(Left,LeftResolved,[rcSkipTypeAlias,rcConstant]);
+  ComputeElement(Right,RightResolved,[rcSkipTypeAlias,rcConstant]);
+  CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
+
+  {$IFDEF EnablePasResRangeCheck}
+  RgValue:=Eval(Left.Parent as TBinaryExpr,[refConst]);
+  ReleaseEvalValue(RgValue);
+  {$ENDIF}
+end;
+
+procedure TPasResolver.FinishRecordType(El: TPasRecordType);
+begin
+  if TopScope.Element=El then
+    PopScope;
+end;
+
+procedure TPasResolver.FinishClassType(El: TPasClassType);
+begin
+  if TopScope.Element=El then
+    PopScope;
+end;
+
+procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
+begin
+  if El.DestType is TUnresolvedPendingRef then exit;
+  if El.DestType is TPasClassType then exit;
+  RaiseMsg(20170216151602,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+    [El.DestType.Name,'class'],El);
+end;
+
+procedure TPasResolver.FinishArrayType(El: TPasArrayType);
+var
+  i: Integer;
+  Expr: TPasExpr;
+  RangeResolved: TPasResolverResult;
+begin
+  for i:=0 to length(El.Ranges)-1 do
+    begin
+    Expr:=El.Ranges[i];
+    ResolveExpr(Expr,rraRead);
+    ComputeElement(Expr,RangeResolved,[rcConstant]);
+    if (RangeResolved.IdentEl<>nil) and not (RangeResolved.IdentEl is TPasType) then
+      RaiseXExpectedButYFound(20170216151607,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
+    if (RangeResolved.BaseType=btRange) and (RangeResolved.SubType in btArrayRangeTypes) then
+      // range, e.g. 1..2
+    else if RangeResolved.BaseType in btArrayRangeTypes then
+      // full range, e.g. array[char]
+    else if (RangeResolved.BaseType=btContext) and (RangeResolved.TypeEl is TPasEnumType) then
+      // e.g. array[enumtype]
+    else
+      RaiseXExpectedButYFound(20170216151609,'range',RangeResolved.IdentEl.ElementTypeName,Expr);
+    end;
+  FinishSubElementType(El,El.ElType);
+end;
+
+procedure TPasResolver.FinishConstDef(El: TPasConst);
+begin
+  ResolveExpr(El.Expr,rraRead);
+  if El.VarType<>nil then
+    CheckAssignCompatibility(El,El.Expr,true)
+  else
+    Eval(El.Expr,[refConst]);
+end;
+
+procedure TPasResolver.FinishProcedure(aProc: TPasProcedure);
+var
+  i: Integer;
+  Body: TProcedureBody;
+  SubEl: TPasElement;
+  SubProcScope: TPasProcedureScope;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishProcedure START');
+  {$ENDIF}
+  CheckTopScope(TPasProcedureScope);
+  if TPasProcedureScope(TopScope).Element<>aProc then
+    RaiseInternalError(20170220163043);
+  Body:=aProc.Body;
+  if Body<>nil then
+    begin
+    if Body.Body is TPasImplAsmStatement then
+      aProc.Modifiers:=aProc.Modifiers+[pmAssembler];
+    ResolveImplBlock(Body.Body);
+
+    // check if all forward procs are resolved
+    for i:=0 to Body.Declarations.Count-1 do
+      begin
+      SubEl:=TPasElement(Body.Declarations[i]);
+      if (SubEl is TPasProcedure) and TPasProcedure(SubEl).IsForward then
+        begin
+        SubProcScope:=TPasProcedure(SubEl).CustomData as TPasProcedureScope;
+        if SubProcScope.ImplProc=nil then
+          RaiseMsg(20170216151613,nForwardProcNotResolved,sForwardProcNotResolved,
+            [SubEl.ElementTypeName,SubEl.Name],SubEl);
+        end;
+      end;
+    end;
+  PopScope;
+end;
+
+procedure TPasResolver.FinishProcedureType(El: TPasProcedureType);
+var
+  ProcName: String;
+  FindData: TFindOverloadProcData;
+  DeclProc, Proc, ParentProc: TPasProcedure;
+  Abort, HasDots: boolean;
+  DeclProcScope, ProcScope: TPasProcedureScope;
+  ParentScope: TPasScope;
+  pm: TProcedureModifier;
+  ptm: TProcTypeModifier;
+begin
+  if (El.Parent is TPasProcedure) and (TPasProcedure(El.Parent).ProcType=El) then
+    begin
+    // finished header of a procedure declaration
+    // -> search the best fitting proc
+    CheckTopScope(TPasProcedureScope);
+    Proc:=TPasProcedure(El.Parent);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
+    {$ENDIF}
+    ProcName:=Proc.Name;
+
+    if (proProcTypeWithoutIsNested in Options) and El.IsNested then
+      RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
+
+    if (Proc.Parent.ClassType=TProcedureBody) then
+      begin
+      // nested sub proc
+      if not (proProcTypeWithoutIsNested in Options) then
+        El.IsNested:=true;
+      // inherit 'of Object'
+      ParentProc:=Proc.Parent.Parent as TPasProcedure;
+      if ParentProc.ProcType.IsOfObject then
+        El.IsOfObject:=true;
+      end;
+
+    if El.IsReferenceTo then
+      begin
+      if El.IsNested then
+        RaiseInvalidProcTypeModifier(20170419142818,El,ptmIsNested,El);
+      if El.IsOfObject then
+        RaiseInvalidProcTypeModifier(20170419142844,El,ptmOfObject,El);
+      end;
+
+    if Proc.IsExternal then
+      begin
+      for pm in TProcedureModifier do
+        if (pm in Proc.Modifiers)
+            and not (pm in [pmVirtual, pmDynamic, pmOverride,
+                        pmOverload, pmMessage, pmReintroduce,
+                        pmExternal, pmDispId,
+                        pmfar]) then
+          RaiseMsg(20170216151616,nInvalidXModifierY,
+            sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ModifierNames[pm]],Proc);
+      for ptm in TProcTypeModifier do
+        if (ptm in Proc.ProcType.Modifiers)
+            and not (ptm in [ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo]) then
+          RaiseMsg(20170411171224,nInvalidXModifierY,
+            sInvalidXModifierY,[Proc.ElementTypeName,'external, '+ProcTypeModifiers[ptm]],Proc);
+      end;
+
+    HasDots:=Pos('.',ProcName)>1;
+
+    if Proc.Parent is TPasClassType then
+      begin
+      // method declaration
+      if Proc.IsAbstract then
+        begin
+        if not Proc.IsVirtual then
+          RaiseMsg(20170216151623,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract without virtual'],Proc);
+        if Proc.IsOverride then
+          RaiseMsg(20170216151625,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'abstract, override'],Proc);
+        end;
+      if Proc.IsVirtual and Proc.IsOverride then
+        RaiseMsg(20170216151627,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'virtual, override'],Proc);
+      if Proc.IsForward then
+        RaiseMsg(20170216151629,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'forward'],Proc);
+      if Proc.IsStatic then
+        if (Proc.ClassType<>TPasClassProcedure) and (Proc.ClassType<>TPasClassFunction) then
+          RaiseMsg(20170216151631,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,'static'],Proc);
+      end
+    else
+      begin
+      // intf proc, forward proc, proc body, method body
+      if Proc.IsAbstract then
+        RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
+      if Proc.IsVirtual then
+        RaiseInvalidProcModifier(20170216151635,Proc,pmVirtual,Proc);
+      if Proc.IsOverride then
+        RaiseInvalidProcModifier(20170216151637,Proc,pmOverride,Proc);
+      if Proc.IsMessage then
+        RaiseInvalidProcModifier(20170216151638,Proc,pmMessage,Proc);
+      if Proc.IsStatic then
+        RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
+      if (not HasDots)
+          and (Proc.ClassType<>TPasProcedure)
+          and (Proc.ClassType<>TPasFunction) then
+        RaiseMsg(20170419232724,nXExpectedButYFound,sXExpectedButYFound,
+          ['full method name','short name'],El);
+      end;
+
+    if HasDots then
+      begin
+      FinishMethodImplHeader(Proc);
+      exit;
+      end;
+
+    // finish interface/implementation/nested procedure/method declaration
+
+    if not IsValidIdent(ProcName) then
+      RaiseNotYetImplemented(20160922163407,El);
+
+    if Proc.LibraryExpr<>nil then
+      ResolveExpr(Proc.LibraryExpr,rraRead);
+    if Proc.LibrarySymbolName<>nil then
+      ResolveExpr(Proc.LibrarySymbolName,rraRead);
+
+    if Proc.Parent is TPasClassType then
+      begin
+      FinishMethodDeclHeader(Proc);
+      exit;
+      end;
+
+    // finish interface/implementation/nested procedure
+    FindData:=Default(TFindOverloadProcData);
+    FindData.Proc:=Proc;
+    FindData.Args:=Proc.ProcType.Args;
+    Abort:=false;
+    IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
+    if FindData.FoundNonProc<>nil then
+      begin
+      // proc hides a non proc -> forbidden within module
+      if (Proc.GetModule=FindData.FoundNonProc.GetModule) then
+        RaiseMsg(20170216151649,nDuplicateIdentifier,sDuplicateIdentifier,
+          [FindData.FoundNonProc.Name,GetElementSourcePosStr(FindData.FoundNonProc)],Proc.ProcType);
+      end;
+    if FindData.Found=nil then
+      exit; // no overload -> ok
+
+    // overload found with same signature
+    DeclProc:=FindData.Found;
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishProcedureHeader overload found: Proc2=',GetTreeDbg(DeclProc),' ',GetElementSourcePosStr(DeclProc),' IsForward=',DeclProc.IsForward,' Parent=',GetObjName(DeclProc.Parent));
+    {$ENDIF}
+    if (Proc.Parent=DeclProc.Parent)
+        or ((Proc.Parent is TImplementationSection)
+           and (DeclProc.Parent is TInterfaceSection)
+           and (Proc.Parent.Parent=DeclProc.Parent.Parent))
+    then
+      begin
+      // both procs are defined in the same scope
+      if ProcNeedsImplProc(Proc) or (not ProcNeedsImplProc(DeclProc)) then
+        RaiseMsg(20170216151652,nDuplicateIdentifier,sDuplicateIdentifier,
+                 [ProcName,GetElementSourcePosStr(DeclProc)],Proc.ProcType);
+      CheckProcSignatureMatch(DeclProc,Proc);
+      DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
+      DeclProcScope.ImplProc:=Proc;
+      ProcScope:=Proc.CustomData as TPasProcedureScope;
+      ProcScope.DeclarationProc:=DeclProc;
+      // remove ImplProc from scope
+      ParentScope:=Scopes[ScopeCount-2];
+      (ParentScope as TPasIdentifierScope).RemoveLocalIdentifier(Proc);
+      // replace arguments with declaration arguments
+      ReplaceProcScopeImplArgsWithDeclArgs(ProcScope);
+      end
+    else
+      begin
+      // give a hint, that proc is hiding DeclProc
+      LogMsg(20170216151656,mtHint,nFunctionHidesIdentifier,sFunctionHidesIdentifier,
+        [DeclProc.Name,GetElementSourcePosStr(DeclProc)],Proc.ProcType);
+      end;
+    end
+  else if El.Name<>'' then
+    begin
+    // finished proc type, e.g. type TProcedure = procedure;
+    end
+  else
+    RaiseNotYetImplemented(20160922163411,El.Parent);
+end;
+
+procedure TPasResolver.FinishMethodDeclHeader(Proc: TPasProcedure);
+
+  procedure VisibilityLowered(Proc, OverloadProc: TPasProcedure);
+  begin
+    LogMsg(20170325004215,mtNote,nVirtualMethodXHasLowerVisibility,
+      sVirtualMethodXHasLowerVisibility,[Proc.Name,
+        VisibilityNames[Proc.Visibility],OverloadProc.Parent.Name,
+        VisibilityNames[OverloadProc.Visibility]],Proc);
+    Proc.Visibility:=OverloadProc.Visibility;
+  end;
+
+var
+  Abort: boolean;
+  ClassScope: TPasClassScope;
+  FindData: TFindOverloadProcData;
+  OverloadProc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+begin
+  Proc.ProcType.IsOfObject:=true;
+  ProcScope:=TopScope as TPasProcedureScope;
+  ClassScope:=Scopes[ScopeCount-2] as TPasClassScope;
+  ProcScope.ClassScope:=ClassScope;
+  FindData:=Default(TFindOverloadProcData);
+  FindData.Proc:=Proc;
+  FindData.Args:=Proc.ProcType.Args;
+  Abort:=false;
+  ClassScope.IterateElements(Proc.Name,ClassScope,@OnFindOverloadProc,@FindData,Abort);
+  if FindData.FoundNonProc<>nil then
+    // proc hides a non proc -> duplicate
+    RaiseMsg(20170216151659,nDuplicateIdentifier,sDuplicateIdentifier,
+      [FindData.FoundNonProc.Name,GetElementSourcePosStr(FindData.FoundNonProc)],Proc.ProcType);
+  if FindData.Found=nil then
+    begin
+    // no overload
+    if Proc.IsOverride then
+      RaiseMsg(20170216151702,nNoMethodInAncestorToOverride,
+        sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
+    end
+  else
+    begin
+    // overload found
+    OverloadProc:=FindData.Found;
+    if Proc.Parent=OverloadProc.Parent then
+      // overload in same scope -> duplicate
+      RaiseMsg(20170216151705,nDuplicateIdentifier,sDuplicateIdentifier,
+        [OverloadProc.Name,GetElementSourcePosStr(OverloadProc)],Proc.ProcType);
+    ProcScope.OverriddenProc:=OverloadProc;
+    if Proc.IsOverride then
+      begin
+      if (not OverloadProc.IsVirtual) and (not OverloadProc.IsOverride) then
+        // the OverloadProc fits the signature, but is not virtual
+        RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
+          sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
+      // override a virtual method
+      CheckProcSignatureMatch(OverloadProc,Proc);
+      // check visibility
+      if Proc.Visibility<>OverloadProc.Visibility then
+        case Proc.Visibility of
+          visPrivate,visStrictPrivate:
+            if not (OverloadProc.Visibility in [visPrivate,visStrictPrivate]) then
+              VisibilityLowered(Proc,OverloadProc);
+          visProtected,visStrictProtected:
+            if not (OverloadProc.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected]) then
+              VisibilityLowered(Proc,OverloadProc);
+          visPublic:
+            if not (OverloadProc.Visibility in [visPrivate..visPublic,visStrictPrivate,visStrictProtected]) then
+              VisibilityLowered(Proc,OverloadProc);
+          visPublished: ;
+        else
+          RaiseNotYetImplemented(20170325003315,Proc,'visibility');
+        end;
+      // check name case
+      if proFixCaseOfOverrides in Options then
+        Proc.Name:=OverloadProc.Name;
+      end
+    else if not Proc.IsReintroduced then
+      begin
+        // give a hint, that proc is hiding OverloadProc
+        LogMsg(20170216151712,mtHint,nFunctionHidesIdentifier,sFunctionHidesIdentifier,
+          [OverloadProc.Name,GetElementSourcePosStr(OverloadProc)],Proc.ProcType);
+      end;
+    end;
+end;
+
+procedure TPasResolver.FinishMethodImplHeader(ImplProc: TPasProcedure);
+var
+  ProcName: String;
+  CurClassType: TPasClassType;
+  FindData: TFindOverloadProcData;
+  Abort: boolean;
+  ImplProcScope, DeclProcScope: TPasProcedureScope;
+  DeclProc: TPasProcedure;
+  CurClassScope: TPasClassScope;
+  SelfArg: TPasArgument;
+  p: Integer;
+begin
+  if ImplProc.IsExternal then
+    RaiseMsg(20170216151715,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'external'],ImplProc);
+  if ImplProc.IsExported then
+    RaiseMsg(20170216151717,nInvalidXModifierY,sInvalidXModifierY,[ImplProc.ElementTypeName,'export'],ImplProc);
+
+  ProcName:=ImplProc.Name;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishMethodBodyHeader searching declaration "',ProcName,'" ...');
+  {$ENDIF}
+  ImplProc.ProcType.IsOfObject:=true;
+
+  repeat
+    p:=Pos('.',ProcName);
+    if p<1 then break;
+    Delete(ProcName,1,p);
+  until false;
+
+  // search ImplProc in class
+  if not IsValidIdent(ProcName) then
+    RaiseNotYetImplemented(20160922163421,ImplProc.ProcType);
+
+  // search proc in class
+  ImplProcScope:=ImplProc.CustomData as TPasProcedureScope;
+  CurClassScope:=ImplProcScope.ClassScope;
+  if CurClassScope=nil then
+    RaiseInternalError(20161013172346);
+  CurClassType:=CurClassScope.Element as TPasClassType;
+  FindData:=Default(TFindOverloadProcData);
+  FindData.Proc:=ImplProc;
+  FindData.Args:=ImplProc.ProcType.Args;
+  FindData.OnlyScope:=CurClassScope;
+  Abort:=false;
+  CurClassScope.IterateElements(ProcName,CurClassScope,@OnFindOverloadProc,@FindData,Abort);
+  if FindData.Found=nil then
+    RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
+
+  // connect method declaration and body
+  DeclProc:=FindData.Found;
+  if DeclProc.IsAbstract then
+    RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
+  if DeclProc.IsExternal then
+    RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
+  CheckProcSignatureMatch(DeclProc,ImplProc);
+  ImplProcScope.DeclarationProc:=DeclProc;
+  DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
+  DeclProcScope.ImplProc:=ImplProc;
+
+  // replace arguments in scope with declaration arguments
+  ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope);
+
+  if not DeclProc.IsStatic then
+    begin
+    // add 'Self'
+    if (DeclProc.ClassType=TPasClassConstructor)
+        or (DeclProc.ClassType=TPasClassDestructor)
+        or (DeclProc.ClassType=TPasClassProcedure)
+        or (DeclProc.ClassType=TPasClassFunction) then
+      begin
+      if not DeclProc.IsStatic then
+        begin
+        // 'Self' in a class proc is the hidden classtype argument
+        SelfArg:=TPasArgument.Create('Self',DeclProc);
+        ImplProcScope.SelfArg:=SelfArg;
+        SelfArg.Access:=argConst;
+        SelfArg.ArgType:=CurClassScope.CanonicalClassOf;
+        SelfArg.ArgType.AddRef;
+        AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
+        end;
+      end
+    else
+      begin
+      // 'Self' in a proc is the hidden instance argument
+      SelfArg:=TPasArgument.Create('Self',DeclProc);
+      ImplProcScope.SelfArg:=SelfArg;
+      SelfArg.Access:=argConst;
+      SelfArg.ArgType:=CurClassType;
+      CurClassType.AddRef;
+      AddIdentifier(ImplProcScope,'Self',SelfArg,pikSimple);
+      end;
+    end;
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.FinishMethodBodyHeader END of searching proc "',ImplProc.Name,'" ...');
+  {$ENDIF}
+end;
+
+procedure TPasResolver.FinishExceptOnExpr;
+var
+  El: TPasImplExceptOn;
+  ResolvedType: TPasResolverResult;
+begin
+  CheckTopScope(TPasExceptOnScope);
+  El:=TPasImplExceptOn(FTopScope.Element);
+  ComputeElement(El.TypeEl,ResolvedType,[rcSkipTypeAlias,rcType]);
+  CheckIsClass(El.TypeEl,ResolvedType);
+end;
+
+procedure TPasResolver.FinishExceptOnStatement;
+begin
+  //writeln('TPasResolver.FinishExceptOnStatement START');
+  CheckTopScope(TPasExceptOnScope);
+  ResolveImplElement(TPasImplExceptOn(FTopScope.Element).Body);
+  PopScope;
+end;
+
+procedure TPasResolver.FinishDeclaration(El: TPasElement);
+var
+  C: TClass;
+begin
+  C:=El.ClassType;
+  if C=TPasVariable then
+    FinishVariable(TPasVariable(El))
+  else if C=TPasProperty then
+    FinishPropertyOfClass(TPasProperty(El))
+  else if C=TPasArgument then
+    FinishArgument(TPasArgument(El))
+  else
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishDeclaration ',GetObjName(El));
+    {$ENDIF}
+    end;
+end;
+
+procedure TPasResolver.FinishVariable(El: TPasVariable);
+begin
+  if (El.Visibility=visPublished) then
+    begin
+    if [vmClass,vmStatic,vmCVar]*El.VarModifiers<>[] then
+      RaiseMsg(20170403223837,nSymbolCannotBePublished,sSymbolCannotBePublished,[],El);
+    end;
+  if El.Expr<>nil then
+    begin
+    ResolveExpr(El.Expr,rraRead);
+    CheckAssignCompatibility(El,El.Expr,true);
+    end;
+  EmitTypeHints(El,El.VarType);
+end;
+
+procedure TPasResolver.FinishPropertyOfClass(PropEl: TPasProperty);
+var
+  PropType: TPasType;
+  ClassScope: TPasClassScope;
+
+  procedure GetPropType;
+  var
+    AncEl: TPasElement;
+    AncProp: TPasProperty;
+  begin
+    if PropType<>nil then exit;
+    AncEl:=nil;
+    if ClassScope.AncestorScope<>nil then
+      AncEl:=ClassScope.AncestorScope.FindElement(PropEl.Name);
+    if AncEl is TPasProperty then
+      begin
+      // override or redeclaration property
+      AncProp:=TPasProperty(AncEl);
+      TPasPropertyScope(PropEl.CustomData).AncestorProp:=AncProp;
+      AncProp.AddRef;
+      if proFixCaseOfOverrides in Options then
+        PropEl.Name:=AncProp.Name;
+      end
+    else
+      AncProp:=nil;
+
+    if PropEl.VarType<>nil then
+      begin
+      // new property or redeclaration
+      PropType:=PropEl.VarType;
+      end
+    else
+      begin
+      // property override
+      if AncProp=nil then
+        RaiseMsg(20170216151741,nNoPropertyFoundToOverride,sNoPropertyFoundToOverride,[],PropEl);
+      // check property versus class property
+      if PropEl.ClassType<>AncProp.ClassType then
+        RaiseXExpectedButYFound(20170216151744,AncProp.ElementTypeName,PropEl.ElementTypeName,PropEl);
+      // get inherited type
+      PropType:=GetPasPropertyType(AncProp);
+      // update DefaultProperty
+      if (ClassScope.DefaultProperty=AncProp) then
+        ClassScope.DefaultProperty:=PropEl;
+      end;
+  end;
+
+  function GetAccessor(Expr: TPasExpr): TPasElement;
+  var
+    Prim: TPrimitiveExpr;
+    DeclEl: TPasElement;
+    Identifier: TPasIdentifier;
+    Scope: TPasIdentifierScope;
+  begin
+    if Expr.ClassType=TBinaryExpr then
+      begin
+      if (TBinaryExpr(Expr).left is TPrimitiveExpr) then
+        begin
+        Prim:=TPrimitiveExpr(TBinaryExpr(Expr).left);
+        if Prim.Kind<>pekIdent then
+          RaiseXExpectedButYFound(20170216151746,'class',Prim.Value,Prim);
+        Scope:=TopScope as TPasIdentifierScope;
+        // search in class and ancestors, not in unit interface
+        Identifier:=Scope.FindIdentifier(Prim.Value);
+        if Identifier=nil then
+          RaiseIdentifierNotFound(20170216151749,Prim.Value,Prim);
+        DeclEl:=Identifier.Element;
+        if DeclEl.ClassType<>TPasClassType then
+          RaiseXExpectedButYFound(20170216151752,'class',DeclEl.ElementTypeName,Prim);
+        CreateReference(DeclEl,Prim,rraRead);
+        end
+      else
+        RaiseMsg(20170216151754,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
+      if TBinaryExpr(Expr).OpCode<>eopSubIdent then
+        RaiseMsg(20170216151757,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TBinaryExpr(Expr).OpCode]],Expr);
+      PushClassDotScope(TPasClassType(DeclEl));
+      Expr:=TBinaryExpr(Expr).right;
+      Result:=GetAccessor(Expr);
+      PopScope;
+      end
+    else if Expr.ClassType=TPrimitiveExpr then
+      begin
+      Prim:=TPrimitiveExpr(Expr);
+      if Prim.Kind<>pekIdent then
+        RaiseXExpectedButYFound(20170216151800,'identifier',Prim.Value,Prim);
+      Scope:=TopScope as TPasIdentifierScope;
+      // search in class and ancestors, not in unit interface
+      Identifier:=Scope.FindIdentifier(Prim.Value);
+      if Identifier=nil then
+        RaiseIdentifierNotFound(20170216151803,Prim.Value,Prim);
+      DeclEl:=Identifier.Element;
+      CreateReference(DeclEl,Prim,rraRead);
+      Result:=DeclEl;
+      end
+    else
+      RaiseNotYetImplemented(20160922163436,Expr);
+  end;
+
+  procedure CheckArgs(Proc: TPasProcedure; ErrorEl: TPasElement);
+  var
+    ArgNo: Integer;
+    PropArg, ProcArg: TPasArgument;
+    PropArgResolved, ProcArgResolved: TPasResolverResult;
+  begin
+    ArgNo:=0;
+    while ArgNo<PropEl.Args.Count do
+      begin
+      if ArgNo>=Proc.ProcType.Args.Count then
+        RaiseMsg(20170216151805,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[Proc.Name],ErrorEl);
+      PropArg:=TPasArgument(PropEl.Args[ArgNo]);
+      ProcArg:=TPasArgument(Proc.ProcType.Args[ArgNo]);
+      inc(ArgNo);
+
+      // check access: var, const, ...
+      if PropArg.Access<>ProcArg.Access then
+        RaiseMsg(20170216151808,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+          [IntToStr(ArgNo),AccessDescriptions[ProcArg.Access],
+           AccessDescriptions[PropArg.Access]],ErrorEl);
+
+      // check typed
+      if PropArg.ArgType=nil then
+        begin
+        if ProcArg.ArgType<>nil then
+          RaiseMsg(20170216151811,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+            [IntToStr(ArgNo),ProcArg.ArgType.ElementTypeName,'untyped'],ErrorEl);
+        end
+      else if ProcArg.ArgType=nil then
+        RaiseMsg(20170216151813,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+          [IntToStr(ArgNo),'untyped',PropArg.ArgType.ElementTypeName],ErrorEl)
+      else
+        begin
+        ComputeElement(PropArg,PropArgResolved,[rcNoImplicitProc]);
+        ComputeElement(ProcArg,ProcArgResolved,[rcNoImplicitProc]);
+
+        if (PropArgResolved.BaseType<>ProcArgResolved.BaseType) then
+          RaiseMsg(20170216151816,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+            [IntToStr(ArgNo),BaseTypeNames[ProcArgResolved.BaseType],BaseTypeNames[PropArgResolved.BaseType]],ErrorEl);
+        if PropArgResolved.TypeEl=nil then
+          RaiseInternalError(20161010125255);
+        if ProcArgResolved.TypeEl=nil then
+          RaiseInternalError(20161010125304);
+        if not IsSameType(PropArgResolved.TypeEl,ProcArgResolved.TypeEl,true) then
+          RaiseIncompatibleType(20170216151819,nIncompatibleTypeArgNo,
+            [IntToStr(ArgNo)],ProcArgResolved.TypeEl,PropArgResolved.TypeEl,ErrorEl);
+        end;
+      end;
+  end;
+
+var
+  ResultType, TypeEl: TPasType;
+  CurClassType: TPasClassType;
+  AccEl: TPasElement;
+  Proc: TPasProcedure;
+  Arg: TPasArgument;
+  PropArgCount: Integer;
+  PropTypeResolved, DefaultResolved: TPasResolverResult;
+  m: TVariableModifier;
+begin
+  CheckTopScope(TPasPropertyScope);
+  PopScope;
+
+  if PropEl.Visibility=visPublished then
+    for m in PropEl.VarModifiers do
+      if not (m in [vmExternal]) then
+        RaiseMsg(20170403224112,nInvalidXModifierY,sInvalidXModifierY,
+          ['published property','"'+VariableModifierNames[m]+'"'],PropEl);
+
+  PropType:=nil;
+  CurClassType:=PropEl.Parent as TPasClassType;
+  ClassScope:=CurClassType.CustomData as TPasClassScope;
+  GetPropType;
+  if PropEl.IndexExpr<>nil then
+    begin
+    ResolveExpr(PropEl.IndexExpr,rraRead);
+    RaiseNotYetImplemented(20160922163439,PropEl.IndexExpr);
+    end;
+  if PropEl.ReadAccessor<>nil then
+    begin
+    // check compatibility
+    AccEl:=GetAccessor(PropEl.ReadAccessor);
+    if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
+      begin
+      if PropEl.Args.Count>0 then
+        RaiseXExpectedButYFound(20170216151823,'function',AccEl.ElementTypeName,PropEl.ReadAccessor);
+      if not IsSameType(TPasVariable(AccEl).VarType,PropType,true) then
+        RaiseIncompatibleType(20170216151826,nIncompatibleTypesGotExpected,
+          [],PropType,TPasVariable(AccEl).VarType,PropEl.ReadAccessor);
+      if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
+        if vmClass in PropEl.VarModifiers then
+          RaiseXExpectedButYFound(20170216151828,'class var','var',PropEl.ReadAccessor)
+        else
+          RaiseXExpectedButYFound(20170216151831,'var','class var',PropEl.ReadAccessor);
+      end
+    else if AccEl is TPasProcedure then
+      begin
+      // check function
+      Proc:=TPasProcedure(AccEl);
+      if (vmClass in PropEl.VarModifiers) then
+        begin
+        if Proc.ClassType<>TPasClassFunction then
+          RaiseXExpectedButYFound(20170216151834,'class function',Proc.ElementTypeName,PropEl.ReadAccessor);
+        if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
+          if Proc.IsStatic then
+            RaiseMsg(20170216151837,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.ReadAccessor)
+          else
+            RaiseMsg(20170216151839,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.ReadAccessor);
+        end
+      else
+        begin
+        if Proc.ClassType<>TPasFunction then
+          RaiseXExpectedButYFound(20170216151842,'function',Proc.ElementTypeName,PropEl.ReadAccessor);
+        end;
+      // check function result type
+      ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
+      if not IsSameType(ResultType,PropType,true) then
+        RaiseXExpectedButYFound(20170216151844,'function result '+GetTypeDescription(PropType,true),
+          GetTypeDescription(ResultType,true),PropEl.ReadAccessor);
+      // check args
+      CheckArgs(Proc,PropEl.ReadAccessor);
+      if Proc.ProcType.Args.Count<>PropEl.Args.Count then
+        RaiseMsg(20170216151847,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
+          [Proc.Name],PropEl.ReadAccessor);
+      end
+    else
+      RaiseXExpectedButYFound(20170216151850,'variable',AccEl.ElementTypeName,PropEl.ReadAccessor);
+    end;
+  if PropEl.WriteAccessor<>nil then
+    begin
+    // check compatibility
+    AccEl:=GetAccessor(PropEl.WriteAccessor);
+    if AccEl.ClassType=TPasVariable then
+      begin
+      if PropEl.Args.Count>0 then
+        RaiseXExpectedButYFound(20170216151852,'procedure',AccEl.ElementTypeName,PropEl.WriteAccessor);
+      if not IsSameType(TPasVariable(AccEl).VarType,PropType,true) then
+        RaiseIncompatibleType(20170216151855,nIncompatibleTypesGotExpected,
+          [],PropType,TPasVariable(AccEl).VarType,PropEl.WriteAccessor);
+      if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
+        if vmClass in PropEl.VarModifiers then
+          RaiseXExpectedButYFound(20170216151858,'class var','var',PropEl.WriteAccessor)
+        else
+          RaiseXExpectedButYFound(20170216151900,'var','class var',PropEl.WriteAccessor);
+      end
+    else if AccEl is TPasProcedure then
+      begin
+      // check procedure
+      Proc:=TPasProcedure(AccEl);
+      if (vmClass in PropEl.VarModifiers) then
+        begin
+        if Proc.ClassType<>TPasClassProcedure then
+          RaiseXExpectedButYFound(20170216151903,'class procedure',Proc.ElementTypeName,PropEl.WriteAccessor);
+          if Proc.IsStatic=(proClassPropertyNonStatic in Options) then
+            if Proc.IsStatic then
+              RaiseMsg(20170216151905,nClassPropertyAccessorMustNotBeStatic,sClassPropertyAccessorMustNotBeStatic,[],PropEl.WriteAccessor)
+            else
+              RaiseMsg(20170216151906,nClassPropertyAccessorMustBeStatic,sClassPropertyAccessorMustBeStatic,[],PropEl.WriteAccessor);
+        end
+      else
+        begin
+        if Proc.ClassType<>TPasProcedure then
+          RaiseXExpectedButYFound(20170216151910,'procedure',Proc.ElementTypeName,PropEl.WriteAccessor);
+        end;
+      // check args
+      CheckArgs(Proc,PropEl.ReadAccessor);
+      // ToDo: check index arg
+      // check write arg
+      PropArgCount:=PropEl.Args.Count;
+      if Proc.ProcType.Args.Count<>PropArgCount+1 then
+        RaiseMsg(20170216151913,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
+          [Proc.Name],PropEl.WriteAccessor);
+      Arg:=TPasArgument(Proc.ProcType.Args[PropArgCount]);
+      if not (Arg.Access in [argDefault,argConst]) then
+        RaiseMsg(20170216151917,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+          [IntToStr(PropArgCount+1),AccessDescriptions[Arg.Access],
+           AccessDescriptions[argConst]],PropEl.WriteAccessor);
+      if not IsSameType(Arg.ArgType,PropType,true) then
+        RaiseIncompatibleType(20170216151919,nIncompatibleTypeArgNo,
+          [IntToStr(PropArgCount+1)],Arg.ArgType,PropType,PropEl.WriteAccessor);
+      end
+    else
+      RaiseXExpectedButYFound(20170216151921,'variable',AccEl.ElementTypeName,PropEl.WriteAccessor);
+    end;
+  if PropEl.ImplementsFunc<>nil then
+    begin
+    ResolveExpr(PropEl.ImplementsFunc,rraRead);
+    // ToDo: check compatibility
+    RaiseNotYetImplemented(20170409213850,PropEl.ImplementsFunc);
+    end;
+  if PropEl.StoredAccessor<>nil then
+    begin
+    // check compatibility
+    AccEl:=GetAccessor(PropEl.StoredAccessor);
+    if (AccEl.ClassType=TPasVariable) or (AccEl.ClassType=TPasConst) then
+      begin
+      if PropEl.IndexExpr<>nil then
+        RaiseNotYetImplemented(20170409214006,PropEl.StoredAccessor,'stored with index');
+      TypeEl:=TPasVariable(AccEl).VarType;
+      // ToDo: TypeEl=nil  TPasConst false/true
+      TypeEl:=ResolveAliasType(TypeEl);
+      if not IsBaseType(TypeEl,btBoolean,true) then
+        RaiseIncompatibleType(20170409214300,nIncompatibleTypesGotExpected,
+          [],TypeEl,BaseTypes[btBoolean],PropEl.StoredAccessor);
+      if (vmClass in PropEl.VarModifiers)<>(vmClass in TPasVariable(AccEl).VarModifiers) then
+        if vmClass in PropEl.VarModifiers then
+          RaiseXExpectedButYFound(20170409214351,'class var','var',PropEl.StoredAccessor)
+        else
+          RaiseXExpectedButYFound(20170409214359,'var','class var',PropEl.StoredAccessor);
+      end
+    else if AccEl is TPasProcedure then
+      begin
+      // check function
+      Proc:=TPasProcedure(AccEl);
+      if Proc.ClassType<>TPasFunction then
+        RaiseXExpectedButYFound(20170216151925,'function',Proc.ElementTypeName,PropEl.StoredAccessor);
+      // check function result type
+      ResultType:=TPasFunction(Proc).FuncType.ResultEl.ResultType;
+      if not IsBaseType(ResultType,btBoolean,true) then
+        RaiseXExpectedButYFound(20170216151929,'function: boolean',
+          'function:'+GetTypeDescription(ResultType),PropEl.StoredAccessor);
+      // check arg count
+      if Proc.ProcType.Args.Count<>0 then
+        RaiseMsg(20170216151932,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
+          [Proc.Name],PropEl.StoredAccessor);
+      end
+    else
+      RaiseXExpectedButYFound(20170216151935,'function: boolean',AccEl.ElementTypeName,PropEl.StoredAccessor);
+    end;
+  if PropEl.DefaultExpr<>nil then
+    begin
+    // check compatibility with type
+    ResolveExpr(PropEl.DefaultExpr,rraRead);
+    ComputeElement(PropEl.DefaultExpr,DefaultResolved,[rcConstant]);
+    ComputeElement(PropType,PropTypeResolved,[rcType]);
+    PropTypeResolved.IdentEl:=PropEl;
+    PropTypeResolved.Flags:=[rrfReadable];
+    CheckEqualResCompatibility(PropTypeResolved,DefaultResolved,PropEl.DefaultExpr,true);
+    end;
+  if PropEl.IsDefault then
+    begin
+    // set default array property
+    if (ClassScope.DefaultProperty<>nil)
+        and (ClassScope.DefaultProperty.Parent=PropEl.Parent) then
+      RaiseMsg(20170216151938,nOnlyOneDefaultPropertyIsAllowed,sOnlyOneDefaultPropertyIsAllowed,[],PropEl);
+    ClassScope.DefaultProperty:=PropEl;
+    end;
+  EmitTypeHints(PropEl,PropEl.VarType);
+end;
+
+procedure TPasResolver.FinishArgument(El: TPasArgument);
+begin
+  if El.ValueExpr<>nil then
+    begin
+    ResolveExpr(El.ValueExpr,rraRead);
+    if El.ArgType<>nil then
+      CheckAssignCompatibility(El,El.ValueExpr,true);
+    end;
+  EmitTypeHints(El,El.ArgType);
+end;
+
+procedure TPasResolver.FinishAncestors(aClass: TPasClassType);
+// called when the ancestor and interface list of a class has been parsed,
+// before parsing the class elements
+var
+  AncestorEl: TPasClassType;
+  ClassScope, AncestorClassScope: TPasClassScope;
+  DirectAncestor, AncestorType, El: TPasType;
+  i: Integer;
+  aModifier: String;
+  IsSealed: Boolean;
+  CanonicalSelf: TPasClassOfType;
+begin
+  if aClass.IsForward then
+    exit;
+  if aClass.ObjKind<>okClass then
+    RaiseNotYetImplemented(20161010174638,aClass,'Kind='+ObjKindNames[aClass.ObjKind]);
+
+  IsSealed:=false;
+  for i:=0 to aClass.Modifiers.Count-1 do
+    begin
+    aModifier:=lowercase(aClass.Modifiers[i]);
+    case aModifier of
+    'sealed': IsSealed:=true;
+    else
+      RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
+    end;
+    end;
+
+  DirectAncestor:=aClass.AncestorType;
+  AncestorType:=ResolveAliasType(DirectAncestor);
+
+  if AncestorType=nil then
+    begin
+    if (CompareText(aClass.Name,'TObject')=0) or aClass.IsExternal then
+      begin
+        // ok, no ancestors
+        AncestorEl:=nil;
+      end else begin
+        // search default ancestor TObject
+        AncestorEl:=TPasClassType(FindElementWithoutParams('TObject',aClass,false));
+        if not (AncestorEl is TPasClassType) then
+          RaiseXExpectedButYFound(20170216151941,'class type',GetObjName(AncestorEl),aClass);
+        if DirectAncestor=nil then
+          DirectAncestor:=AncestorEl;
+      end;
+    end
+  else if AncestorType.ClassType<>TPasClassType then
+    RaiseXExpectedButYFound(20170216151944,'class type',GetTypeDescription(AncestorType),aClass)
+  else if aClass=AncestorType then
+    RaiseMsg(20170525125854,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass)
+  else
+    begin
+    AncestorEl:=TPasClassType(AncestorType);
+    EmitTypeHints(aClass,AncestorEl);
+    end;
+
+  AncestorClassScope:=nil;
+  if AncestorEl=nil then
+    begin
+    // root class e.g. TObject
+    end
+  else
+    begin
+    // inherited class
+    if AncestorEl.IsForward then
+      RaiseMsg(20170216151947,nCantUseForwardDeclarationAsAncestor,
+        sCantUseForwardDeclarationAsAncestor,[AncestorEl.Name],aClass);
+    if aClass.IsExternal and not AncestorEl.IsExternal then
+      RaiseMsg(20170321144035,nAncestorIsNotExternal,sAncestorIsNotExternal,
+        [AncestorEl.Name],aClass);
+    AncestorClassScope:=AncestorEl.CustomData as TPasClassScope;
+    if pcsfSealed in AncestorClassScope.Flags then
+      RaiseMsg(20170320191735,nCannotCreateADescendantOfTheSealedClass,
+        sCannotCreateADescendantOfTheSealedClass,[AncestorEl.Name],aClass);
+    // check for cycle
+    El:=AncestorEl;
+    repeat
+      if El=aClass then
+        RaiseMsg(20170216151949,nAncestorCycleDetected,sAncestorCycleDetected,[],aClass);
+      if (El.ClassType=TPasAliasType)
+      or (El.ClassType=TPasTypeAliasType)
+      then
+        El:=TPasAliasType(El).DestType
+      else if El.ClassType=TPasClassType then
+        El:=TPasClassType(El).AncestorType;
+    until El=nil;
+    end;
+
+  // start scope for elements
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.FinishAncestors ',GetObjName(aClass.CustomData));
+  {$ENDIF}
+  PushScope(aClass,ScopeClass_Class);
+  ClassScope:=TPasClassScope(TopScope);
+  ClassScope.VisibilityContext:=aClass;
+  Include(ClassScope.Flags,pcsfAncestorResolved);
+  if IsSealed then
+    Include(ClassScope.Flags,pcsfSealed);
+  ClassScope.DirectAncestor:=DirectAncestor;
+  if AncestorEl<>nil then
+    begin
+    ClassScope.AncestorScope:=AncestorEl.CustomData as TPasClassScope;
+    ClassScope.DefaultProperty:=ClassScope.AncestorScope.DefaultProperty;
+    end;
+  // create canonical class-of for the "Self" in class functions
+  CanonicalSelf:=TPasClassOfType.Create('Self',aClass);
+  ClassScope.CanonicalClassOf:=CanonicalSelf;
+  CanonicalSelf.DestType:=aClass;
+  aClass.AddRef;
+  CanonicalSelf.Visibility:=visStrictPrivate;
+  CanonicalSelf.SourceFilename:=aClass.SourceFilename;
+  CanonicalSelf.SourceLinenumber:=aClass.SourceLinenumber;
+end;
+
+procedure TPasResolver.FinishPropertyParamAccess(Params: TParamsExpr;
+  Prop: TPasProperty);
+var
+  i: Integer;
+  ParamAccess: TResolvedRefAccess;
+begin
+  for i:=0 to length(Params.Params)-1 do
+    begin
+    ParamAccess:=rraRead;
+    if i<Prop.Args.Count then
+      case TPasArgument(Prop.Args[i]).Access of
+      argVar: ParamAccess:=rraVarParam;
+      argOut: ParamAccess:=rraOutParam;
+      end;
+    AccessExpr(Params.Params[i],ParamAccess);
+    end;
+end;
+
+procedure TPasResolver.EmitTypeHints(PosEl: TPasElement; aType: TPasType);
+begin
+  while aType<>nil do
+    begin
+    if EmitElementHints(PosEl,aType) then
+      exit; // give only hints for the nearest
+    if aType.InheritsFrom(TPasAliasType) then
+      aType:=TPasAliasType(aType).DestType
+    else if aType.ClassType=TPasPointerType then
+      aType:=TPasPointerType(aType).DestType
+    else if (aType.ClassType=TPasClassType) and TPasClassType(aType).IsForward
+        and (aType.CustomData<>nil) then
+      aType:=TPasType((aType.CustomData as TResolvedReference).Declaration)
+    else
+      exit;
+    end;
+end;
+
+function TPasResolver.EmitElementHints(PosEl, El: TPasElement): boolean;
+begin
+  if El.Hints=[] then exit(false);
+  Result:=true;
+  if hDeprecated in El.Hints then
+    begin
+    if El.HintMessage<>'' then
+      LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
+        [El.Name,El.HintMessage],PosEl)
+    else
+      LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
+        [El.Name],PosEl);
+    end;
+  if hLibrary in El.Hints then
+    LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
+      [El.Name],PosEl);
+  if hPlatform in El.Hints then
+    LogMsg(20170419185916,mtWarning,nSymbolXIsNotPortable,sSymbolXIsNotPortable,
+      [El.Name],PosEl);
+  if hExperimental in El.Hints then
+    LogMsg(20170419190111,mtWarning,nSymbolXIsExperimental,sSymbolXIsExperimental,
+      [El.Name],PosEl);
+  if hUnimplemented in El.Hints then
+    LogMsg(20170419190317,mtWarning,nSymbolXIsNotImplemented,sSymbolXIsNotImplemented,
+      [El.Name],PosEl);
+end;
+
+procedure TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs(
+  ImplProcScope: TPasProcedureScope);
+var
+  DeclProc, ImplProc: TPasProcedure;
+  DeclArgs, ImplArgs: TFPList;
+  i: Integer;
+  DeclArg, ImplArg: TPasArgument;
+  Identifier: TPasIdentifier;
+begin
+  ImplProc:=ImplProcScope.Element as TPasProcedure;
+  ImplArgs:=ImplProc.ProcType.Args;
+  DeclProc:=ImplProcScope.DeclarationProc;
+  DeclArgs:=DeclProc.ProcType.Args;
+  for i:=0 to DeclArgs.Count-1 do
+    begin
+    DeclArg:=TPasArgument(DeclArgs[i]);
+    if i<ImplArgs.Count then
+      begin
+      ImplArg:=TPasArgument(ImplArgs[i]);
+      Identifier:=ImplProcScope.FindLocalIdentifier(DeclArg.Name);
+      //writeln('TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs i=',i,' replacing ',GetObjName(ImplArg),' with ',GetObjName(DeclArg));
+      if Identifier.Element<>ImplArg then
+        RaiseInternalError(20170203161659,GetObjName(DeclArg)+' '+GetObjName(ImplArg));
+      Identifier.Element:=DeclArg;
+      Identifier.Identifier:=DeclArg.Name;
+      end
+    else
+      RaiseNotYetImplemented(20170203161826,ImplProc);
+    end;
+  if DeclProc is TPasFunction then
+    begin
+    // replace 'Result'
+    Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
+    if Identifier.Element is TPasResultElement then
+      Identifier.Element:=TPasFunction(DeclProc).FuncType.ResultEl;
+    end;
+end;
+
+procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
+  const ResolvedEl: TPasResolverResult);
+begin
+  if ResolvedEl.BaseType<>btBoolean then
+    RaiseMsg(20170216152135,nXExpectedButYFound,sXExpectedButYFound,
+      [BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType]],El);
+end;
+
+procedure TPasResolver.CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure
+  );
+var
+  i: Integer;
+  DeclArgs, ImplArgs: TFPList;
+  DeclName, ImplName: String;
+  ImplResult, DeclResult: TPasType;
+begin
+  if ImplProc.ClassType<>DeclProc.ClassType then
+    RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
+  if ImplProc.CallingConvention<>DeclProc.CallingConvention then
+    RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
+  if ImplProc is TPasFunction then
+    begin
+    // check result type
+    ImplResult:=TPasFunction(ImplProc).FuncType.ResultEl.ResultType;
+    DeclResult:=TPasFunction(DeclProc).FuncType.ResultEl.ResultType;
+
+    if not CheckProcArgTypeCompatibility(ImplResult,DeclResult) then
+      RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
+        [],DeclResult,ImplResult,ImplProc);
+    end;
+
+  // check argument names
+  DeclArgs:=DeclProc.ProcType.Args;
+  ImplArgs:=ImplProc.ProcType.Args;
+  for i:=0 to DeclArgs.Count-1 do
+    begin
+    DeclName:=TPasArgument(DeclArgs[i]).Name;
+    ImplName:=TPasArgument(ImplArgs[i]).Name;
+    if CompareText(DeclName,ImplName)<>0 then
+      RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
+        sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
+    end;
+end;
+
+procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
+var
+  i: Integer;
+begin
+  if Block=nil then exit;
+  for i:=0 to Block.Elements.Count-1 do
+    ResolveImplElement(TPasImplElement(Block.Elements[i]));
+end;
+
+procedure TPasResolver.ResolveImplElement(El: TPasImplElement);
+var
+  C: TClass;
+begin
+  //writeln('TPasResolver.ResolveImplElement ',GetObjName(El));
+  if El=nil then exit;
+  C:=El.ClassType;
+  if C=TPasImplBeginBlock then
+    ResolveImplBlock(TPasImplBeginBlock(El))
+  else if C=TPasImplAssign then
+    ResolveImplAssign(TPasImplAssign(El))
+  else if C=TPasImplSimple then
+    ResolveImplSimple(TPasImplSimple(El))
+  else if C=TPasImplBlock then
+    ResolveImplBlock(TPasImplBlock(El))
+  else if C=TPasImplRepeatUntil then
+    begin
+    ResolveImplBlock(TPasImplBlock(El));
+    ResolveStatementConditionExpr(TPasImplRepeatUntil(El).ConditionExpr);
+    end
+  else if C=TPasImplIfElse then
+    begin
+    ResolveStatementConditionExpr(TPasImplIfElse(El).ConditionExpr);
+    ResolveImplElement(TPasImplIfElse(El).IfBranch);
+    ResolveImplElement(TPasImplIfElse(El).ElseBranch);
+    end
+  else if C=TPasImplWhileDo then
+    begin
+    ResolveStatementConditionExpr(TPasImplWhileDo(El).ConditionExpr);
+    ResolveImplElement(TPasImplWhileDo(El).Body);
+    end
+  else if C=TPasImplCaseOf then
+    ResolveImplCaseOf(TPasImplCaseOf(El))
+  else if C=TPasImplLabelMark then
+    ResolveImplLabelMark(TPasImplLabelMark(El))
+  else if C=TPasImplForLoop then
+    ResolveImplForLoop(TPasImplForLoop(El))
+  else if C=TPasImplTry then
+    begin
+    ResolveImplBlock(TPasImplTry(El));
+    ResolveImplBlock(TPasImplTry(El).FinallyExcept);
+    ResolveImplBlock(TPasImplTry(El).ElseBranch);
+    end
+  else if C=TPasImplExceptOn then
+    // handled in FinishExceptOnStatement
+  else if C=TPasImplRaise then
+    ResolveImplRaise(TPasImplRaise(El))
+  else if C=TPasImplCommand then
+    begin
+    if TPasImplCommand(El).Command<>'' then
+      RaiseNotYetImplemented(20160922163442,El,'TPasResolver.ResolveImplElement');
+    end
+  else if C=TPasImplAsmStatement then
+    ResolveImplAsm(TPasImplAsmStatement(El))
+  else if C=TPasImplWithDo then
+    ResolveImplWithDo(TPasImplWithDo(El))
+  else
+    RaiseNotYetImplemented(20160922163445,El,'TPasResolver.ResolveImplElement');
+end;
+
+procedure TPasResolver.ResolveImplCaseOf(CaseOf: TPasImplCaseOf);
+var
+  i, j: Integer;
+  El: TPasElement;
+  Stat: TPasImplCaseStatement;
+  CaseExprResolved, OfExprResolved: TPasResolverResult;
+  OfExpr: TPasExpr;
+  ok: Boolean;
+begin
+  ResolveExpr(CaseOf.CaseExpr,rraRead);
+  ComputeElement(CaseOf.CaseExpr,CaseExprResolved,[rcSetReferenceFlags]);
+  ok:=false;
+  if (rrfReadable in CaseExprResolved.Flags) then
+    begin
+    if (CaseExprResolved.BaseType in (btAllInteger+btAllBooleans+btAllStringAndChars)) then
+      ok:=true
+    else if CaseExprResolved.BaseType=btContext then
+      begin
+      if CaseExprResolved.TypeEl.ClassType=TPasEnumType then
+        ok:=true;
+      end;
+    end;
+  if not ok then
+    RaiseXExpectedButYFound(20170216151952,'ordinal expression',
+               GetTypeDescription(CaseExprResolved.TypeEl),CaseOf.CaseExpr);
+
+  for i:=0 to CaseOf.Elements.Count-1 do
+    begin
+    El:=TPasElement(CaseOf.Elements[i]);
+    if El.ClassType=TPasImplCaseStatement then
+      begin
+      Stat:=TPasImplCaseStatement(El);
+      for j:=0 to Stat.Expressions.Count-1 do
+        begin
+        //writeln('TPasResolver.ResolveImplCaseOf Stat.Expr[',j,']=',GetObjName(El));
+        OfExpr:=TPasExpr(Stat.Expressions[j]);
+        ResolveExpr(OfExpr,rraRead);
+        ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
+        if OfExprResolved.BaseType=btRange then
+          ConvertRangeToFirstValue(OfExprResolved);
+        CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
+        end;
+      ResolveImplElement(Stat.Body);
+      end
+    else if El.ClassType=TPasImplCaseElse then
+      ResolveImplBlock(TPasImplCaseElse(El))
+    else
+      RaiseNotYetImplemented(20160922163448,El);
+    end;
+  // Note: CaseOf.ElseBranch was already resolved via Elements
+end;
+
+procedure TPasResolver.ResolveImplLabelMark(Mark: TPasImplLabelMark);
+begin
+  RaiseNotYetImplemented(20161014141636,Mark);
+end;
+
+procedure TPasResolver.ResolveImplForLoop(Loop: TPasImplForLoop);
+var
+  VarResolved, StartResolved, EndResolved: TPasResolverResult;
+begin
+  // loop var
+  ResolveExpr(Loop.VariableName,rraReadAndAssign);
+  ComputeElement(Loop.VariableName,VarResolved,[rcNoImplicitProc,rcSetReferenceFlags]);
+  if ResolvedElCanBeVarParam(VarResolved)
+      and ((VarResolved.BaseType in (btAllBooleans+btAllInteger+btAllChars))
+        or ((VarResolved.BaseType=btContext) and (VarResolved.TypeEl.ClassType=TPasEnumType))) then
+  else
+    RaiseMsg(20170216151955,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Loop.VariableName);
+
+  // start value
+  ResolveExpr(Loop.StartExpr,rraRead);
+  ComputeElement(Loop.StartExpr,StartResolved,[rcSetReferenceFlags]);
+  if CheckAssignResCompatibility(VarResolved,StartResolved,Loop.StartExpr,true)=cIncompatible then
+    RaiseIncompatibleTypeRes(20170216151958,nIncompatibleTypesGotExpected,
+      [],StartResolved,VarResolved,Loop.StartExpr);
+
+  // end value
+  ResolveExpr(Loop.EndExpr,rraRead);
+  ComputeElement(Loop.EndExpr,EndResolved,[rcSetReferenceFlags]);
+  if CheckAssignResCompatibility(VarResolved,EndResolved,Loop.EndExpr,false)=cIncompatible then
+    RaiseIncompatibleTypeRes(20170216152001,nIncompatibleTypesGotExpected,
+      [],EndResolved,VarResolved,Loop.EndExpr);
+
+  ResolveImplElement(Loop.Body);
+end;
+
+procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
+var
+  i, OldScopeCount: Integer;
+  Expr, ErrorEl: TPasExpr;
+  ExprResolved: TPasResolverResult;
+  TypeEl: TPasType;
+  WithScope: TPasWithScope;
+  WithExprScope: TPasWithExprScope;
+  ExprScope: TPasScope;
+  OnlyTypeMembers: Boolean;
+  ClassEl: TPasClassType;
+begin
+  OldScopeCount:=ScopeCount;
+  WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
+  PushScope(WithScope);
+  for i:=0 to El.Expressions.Count-1 do
+    begin
+    Expr:=TPasExpr(El.Expressions[i]);
+    ResolveExpr(Expr,rraRead);
+    ComputeElement(Expr,ExprResolved,[rcSkipTypeAlias,rcSetReferenceFlags]);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.ResolveImplWithDo ExprResolved=',GetResolverResultDbg(ExprResolved));
+    {$ENDIF}
+    ErrorEl:=Expr;
+    TypeEl:=ExprResolved.TypeEl;
+    // ToDo: use last element in Expr for error position
+    if TypeEl=nil then
+      RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+        [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
+
+    OnlyTypeMembers:=false;
+    if TypeEl.ClassType=TPasRecordType then
+      begin
+      ExprScope:=TPasRecordType(TypeEl).CustomData as TPasRecordScope;
+      if ExprResolved.IdentEl is TPasType then
+        // e.g. with TPoint do PointInCircle
+        OnlyTypeMembers:=true;
+      end
+    else if TypeEl.ClassType=TPasClassType then
+      begin
+      ExprScope:=TPasClassType(TypeEl).CustomData as TPasClassScope;
+      if ExprResolved.IdentEl is TPasType then
+        // e.g. with TFPMemoryImage do FindHandlerFromExtension()
+        OnlyTypeMembers:=true;
+      end
+    else if TypeEl.ClassType=TPasClassOfType then
+      begin
+      // e.g. with ImageClass do FindHandlerFromExtension()
+      ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
+      ExprScope:=ClassEl.CustomData as TPasClassScope;
+      OnlyTypeMembers:=true;
+      end
+    else
+      RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+        [TypeEl.ElementTypeName],ErrorEl);
+    WithExprScope:=ScopeClass_WithExpr.Create;
+    WithExprScope.WithScope:=WithScope;
+    WithExprScope.Index:=i;
+    WithExprScope.Expr:=Expr;
+    WithExprScope.Scope:=ExprScope;
+    if not (ExprResolved.IdentEl is TPasType) then
+      Include(WithExprScope.Flags,wesfNeedTmpVar);
+    if OnlyTypeMembers then
+      Include(WithExprScope.Flags,wesfOnlyTypeMembers);
+    if (not (rrfWritable in ExprResolved.Flags))
+        and (ExprResolved.BaseType=btContext)
+        and (ExprResolved.TypeEl.ClassType=TPasRecordType) then
+      Include(WithExprScope.Flags,wesfConstParent);
+    WithScope.ExpressionScopes.Add(WithExprScope);
+    PushScope(WithExprScope);
+    end;
+  ResolveImplElement(El.Body);
+  CheckTopScope(ScopeClass_WithExpr);
+  if TopScope<>WithScope.ExpressionScopes[WithScope.ExpressionScopes.Count-1] then
+    RaiseInternalError(20160923102846);
+  while ScopeCount>OldScopeCount do
+    PopScope;
+end;
+
+procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
+begin
+  if El=nil then ;
+end;
+
+procedure TPasResolver.ResolveImplAssign(El: TPasImplAssign);
+var
+  LeftResolved, RightResolved: TPasResolverResult;
+  Flags: TPasResolverComputeFlags;
+  Access: TResolvedRefAccess;
+begin
+  if El.Kind=akDefault then
+    Access:=rraAssign
+  else
+    Access:=rraReadAndAssign;
+  ResolveExpr(El.left,Access);
+  ResolveExpr(El.right,rraRead);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveImplAssign Kind=',El.Kind,' left=',GetObjName(El.left),' right=',GetObjName(el.right));
+  {$ENDIF}
+  // check LHS can be assigned
+  ComputeElement(El.left,LeftResolved,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]);
+  CheckCanBeLHS(LeftResolved,true,El.left);
+  // compute RHS
+  Flags:=[rcSkipTypeAlias,rcSetReferenceFlags];
+  if IsProcedureType(LeftResolved,true) then
+    if (msDelphi in CurrentParser.CurrentModeswitches) then
+      Include(Flags,rcNoImplicitProc) // a proc type can use param less procs
+    else
+      Include(Flags,rcNoImplicitProcType); // a proc type can use a param less proc type
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveImplAssign Left=',GetResolverResultDbg(LeftResolved),' Flags=',dbgs(Flags));
+  {$ENDIF}
+  ComputeElement(El.right,RightResolved,Flags);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveImplAssign Right=',GetResolverResultDbg(RightResolved));
+  {$ENDIF}
+
+  case El.Kind of
+  akDefault:
+    begin
+    CheckAssignResCompatibility(LeftResolved,RightResolved,El.right,true);
+    {$IFDEF EnablePasResRangeCheck}
+    CheckAssignExprRange(LeftResolved,El.right);
+    {$ENDIF}
+    end;
+  akAdd, akMinus,akMul,akDivision:
+    begin
+    if (El.Kind in [akAdd,akMinus,akMul]) and (LeftResolved.BaseType in btAllInteger) then
+      begin
+      if (not (rrfReadable in RightResolved.Flags))
+          or not (RightResolved.BaseType in btAllInteger) then
+        RaiseMsg(20170216152009,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
+      end
+    else if (El.Kind=akAdd) and (LeftResolved.BaseType in btAllStrings) then
+      begin
+      if (not (rrfReadable in RightResolved.Flags))
+          or not (RightResolved.BaseType in btAllStringAndChars) then
+        RaiseMsg(20170216152012,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
+      end
+    else if (El.Kind in [akAdd,akMinus,akMul,akDivision])
+        and (LeftResolved.BaseType in btAllFloats) then
+      begin
+      if (not (rrfReadable in RightResolved.Flags))
+          or not (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
+        RaiseMsg(20170216152107,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [BaseTypes[RightResolved.BaseType],BaseTypes[LeftResolved.BaseType]],El.right);
+      end
+    else if (LeftResolved.BaseType=btSet) and (El.Kind in [akAdd,akMinus,akMul]) then
+      begin
+      if (not (rrfReadable in RightResolved.Flags))
+          or not (RightResolved.BaseType=btSet) then
+        RaiseMsg(20170216152110,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [BaseTypeNames[RightResolved.BaseType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
+      if (LeftResolved.SubType=RightResolved.SubType)
+          or ((LeftResolved.SubType in btAllInteger) and (RightResolved.SubType in btAllInteger))
+          or ((LeftResolved.SubType in btAllBooleans) and (RightResolved.SubType in btAllBooleans))
+      then
+      else
+        RaiseMsg(20170216152117,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          ['set of '+BaseTypeNames[RightResolved.SubType],'set of '+BaseTypeNames[LeftResolved.SubType]],El.right);
+      end
+    else
+      RaiseMsg(20170216152125,nIllegalQualifier,sIllegalQualifier,[AssignKindNames[El.Kind]],El);
+    // store const expression result
+    Eval(El.right,[]);
+    end;
+  else
+    RaiseNotYetImplemented(20160927143649,El,'AssignKind '+AssignKindNames[El.Kind]);
+  end;
+end;
+
+procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
+var
+  ExprResolved: TPasResolverResult;
+  Expr: TPasExpr;
+begin
+  Expr:=El.expr;
+  ResolveExpr(Expr,rraRead);
+  ComputeElement(Expr,ExprResolved,[rcSkipTypeAlias,rcSetReferenceFlags]);
+  if (rrfCanBeStatement in ExprResolved.Flags) then
+    exit;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveImplSimple El=',GetObjName(El),' El.Expr=',GetObjName(El.Expr),' ExprResolved=',GetResolverResultDbg(ExprResolved));
+  {$ENDIF}
+  RaiseMsg(20170216152127,nIllegalExpression,sIllegalExpression,[],El);
+end;
+
+procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
+var
+  ResolvedEl: TPasResolverResult;
+begin
+  if El.ExceptObject<>nil then
+    begin
+    ResolveExpr(El.ExceptObject,rraRead);
+    ComputeElement(El.ExceptObject,ResolvedEl,[rcSkipTypeAlias,rcSetReferenceFlags]);
+    CheckIsClass(El.ExceptObject,ResolvedEl);
+    if ResolvedEl.IdentEl<>nil then
+      begin
+      if (ResolvedEl.IdentEl is TPasVariable)
+          or (ResolvedEl.IdentEl is TPasArgument) then
+      else
+        RaiseMsg(20170216152133,nXExpectedButYFound,sXExpectedButYFound,
+                 ['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject);
+      end
+    else if ResolvedEl.ExprEl<>nil then
+    else
+      RaiseMsg(201702303145230,nXExpectedButYFound,sXExpectedButYFound,
+             ['variable',GetResolverResultDbg(ResolvedEl)],El.ExceptObject);
+    if not (rrfReadable in ResolvedEl.Flags) then
+      RaiseMsg(20170303145037,nNotReadable,sNotReadable,[],El.ExceptObject);
+    end;
+  if El.ExceptAddr<>nil then
+    ResolveExpr(El.ExceptAddr,rraRead);
+end;
+
+procedure TPasResolver.ResolveExpr(El: TPasExpr; Access: TResolvedRefAccess);
+var
+  Primitive: TPrimitiveExpr;
+  ElClass: TClass;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
+  {$ENDIF}
+  if El=nil then
+    RaiseNotYetImplemented(20160922163453,El);
+  ElClass:=El.ClassType;
+  if ElClass=TPrimitiveExpr then
+    begin
+    Primitive:=TPrimitiveExpr(El);
+    case Primitive.Kind of
+    pekIdent: ResolveNameExpr(El,Primitive.Value,Access);
+    pekNumber: ;
+    pekString: ;
+    pekNil,pekBoolConst: ;
+    else
+      RaiseNotYetImplemented(20160922163451,El);
+    end;
+    end
+  else if ElClass=TUnaryExpr then
+    ResolveExpr(TUnaryExpr(El).Operand,Access)
+  else if ElClass=TBinaryExpr then
+    ResolveBinaryExpr(TBinaryExpr(El),Access)
+  else if ElClass=TParamsExpr then
+    ResolveParamsExpr(TParamsExpr(El),Access)
+  else if ElClass=TBoolConstExpr then
+  else if ElClass=TNilExpr then
+  else if ElClass=TSelfExpr then
+    ResolveNameExpr(El,'Self',Access)
+  else if ElClass=TInheritedExpr then
+    ResolveInherited(TInheritedExpr(El),Access)
+  else if ElClass=TArrayValues then
+    begin
+    if Access<>rraRead then
+      RaiseMsg(20170303205743,nVariableIdentifierExpected,sVariableIdentifierExpected,
+        [],El);
+    ResolveArrayValues(TArrayValues(El));
+    end
+  else
+    RaiseNotYetImplemented(20170222184329,El);
+
+  if El.format1<>nil then
+    ResolveExpr(El.format1,rraRead);
+  if El.format2<>nil then
+    ResolveExpr(El.format2,rraRead);
+end;
+
+procedure TPasResolver.ResolveStatementConditionExpr(El: TPasExpr);
+var
+  ResolvedCond: TPasResolverResult;
+begin
+  ResolveExpr(El,rraRead);
+  ComputeElement(El,ResolvedCond,[rcSkipTypeAlias,rcSetReferenceFlags]);
+  CheckConditionExpr(El,ResolvedCond);
+end;
+
+procedure TPasResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
+  Access: TResolvedRefAccess);
+var
+  FindData: TPRFindData;
+  DeclEl: TPasElement;
+  Proc: TPasProcedure;
+  Ref: TResolvedReference;
+  BuiltInProc: TResElDataBuiltInProc;
+  p: SizeInt;
+  DottedName: String;
+  Bin: TBinaryExpr;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
+  {$ENDIF}
+  DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
+  if DeclEl.ClassType=TPasUsesUnit then
+    begin
+    // the first name of a unit matches -> find unit with longest match
+    FindLongestUnitName(DeclEl,El);
+    FindData.Found:=DeclEl;
+    end;
+
+  Ref:=CreateReference(DeclEl,El,Access,@FindData);
+  CheckFoundElement(FindData,Ref);
+
+  if DeclEl is TPasProcedure then
+    begin
+    // identifier is a proc and args brackets are missing
+    if El.Parent.ClassType=TPasProperty then
+      // a property accessor does not need args -> ok
+    else
+      begin
+      // examples: funca or @proca or a.funca or @a.funca ...
+      Proc:=TPasProcedure(DeclEl);
+      if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
+        {$ENDIF}
+        RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[Proc.Name],El);
+        end;
+      end;
+    end
+  else if DeclEl.ClassType=TPasUnresolvedSymbolRef then
+    begin
+    if DeclEl.CustomData is TResElDataBuiltInProc then
+      begin
+      BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
+      BuiltInProc.GetCallCompatibility(BuiltInProc,El,true);
+      end;
+    end
+  else if (DeclEl.ClassType=TPasUsesUnit) or (DeclEl is TPasModule) then
+    begin
+    // unit reference
+    // dotted unit names needs a ref for each expression identifier
+    // Note: El is the first TPrimitiveExpr of the dotted unit name reference
+    DottedName:=DeclEl.Name;
+    repeat
+      p:=Pos('.',DottedName);
+      if p<1 then break;
+      Delete(DottedName,1,p);
+      El:=GetNextDottedExpr(El);
+      if El=nil then
+        RaiseInternalError(20170503002012);
+      CreateReference(DeclEl,El,Access);
+      if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).right=El) then
+        begin
+        Bin:=TBinaryExpr(El.Parent);
+        while Bin.OpCode=eopSubIdent do
+          begin
+          CreateReference(DeclEl,Bin,Access);
+          if not (Bin.Parent is TBinaryExpr) then break;
+          if (TBinaryExpr(Bin.Parent).right<>Bin) then break;
+          Bin:=TBinaryExpr(Bin.Parent);
+          end;
+        end;
+    until false;
+    end;
+end;
+
+procedure TPasResolver.ResolveInherited(El: TInheritedExpr;
+  Access: TResolvedRefAccess);
+var
+  ProcScope, DeclProcScope, SelfScope: TPasProcedureScope;
+  AncestorScope, ClassScope: TPasClassScope;
+  DeclProc, AncestorProc: TPasProcedure;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveInherited El.Parent=',GetTreeDbg(El.Parent));
+  {$ENDIF}
+  if (El.Parent.ClassType=TBinaryExpr)
+  and (TBinaryExpr(El.Parent).OpCode=eopNone) then
+    begin
+    // e.g. 'inherited Proc;'
+    ResolveInheritedCall(TBinaryExpr(El.Parent),Access);
+    exit;
+    end;
+
+  // 'inherited;' without expression
+  CheckTopScope(TPasProcedureScope);
+  ProcScope:=TPasProcedureScope(TopScope);
+  SelfScope:=ProcScope.GetSelfScope;
+  if SelfScope=nil then
+    RaiseMsg(20170216152141,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
+  ClassScope:=SelfScope.ClassScope;
+
+  AncestorScope:=ClassScope.AncestorScope;
+  if AncestorScope=nil then
+    begin
+    // 'inherited;' without ancestor class is silently ignored
+    exit;
+    end;
+
+  // search ancestor in element, i.e. 'inherited' expression
+  DeclProc:=SelfScope.DeclarationProc;
+  DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
+  AncestorProc:=DeclProcScope.OverriddenProc;
+  if AncestorProc<>nil then
+    begin
+    CreateReference(AncestorProc,El,Access);
+    if AncestorProc.IsAbstract then
+      RaiseMsg(20170216152144,nAbstractMethodsCannotBeCalledDirectly,
+        sAbstractMethodsCannotBeCalledDirectly,[],El);
+    end
+  else
+    begin
+    // 'inherited;' without ancestor method is silently ignored
+    exit;
+    end;
+end;
+
+procedure TPasResolver.ResolveInheritedCall(El: TBinaryExpr;
+  Access: TResolvedRefAccess);
+// El.OpCode=eopNone
+// El.left is TInheritedExpr
+// El.right is the identifier and parameters
+var
+  ProcScope, SelfScope: TPasProcedureScope;
+  AncestorScope, ClassScope: TPasClassScope;
+  AncestorClass: TPasClassType;
+  InhScope: TPasDotClassScope;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveInheritedCall El=',GetTreeDbg(El));
+  {$ENDIF}
+
+  CheckTopScope(TPasProcedureScope);
+  ProcScope:=TPasProcedureScope(TopScope);
+  SelfScope:=ProcScope.GetSelfScope;
+  if SelfScope=nil then
+    RaiseMsg(20170216152148,nInheritedOnlyWorksInMethods,sInheritedOnlyWorksInMethods,[],El);
+  ClassScope:=SelfScope.ClassScope;
+
+  AncestorScope:=ClassScope.AncestorScope;
+  if AncestorScope=nil then
+    RaiseMsg(20170216152151,nInheritedNeedsAncestor,sInheritedNeedsAncestor,[],El.left);
+
+  // search call in ancestor
+  AncestorClass:=TPasClassType(AncestorScope.Element);
+  InhScope:=PushClassDotScope(AncestorClass);
+  InhScope.InheritedExpr:=true;
+  ResolveExpr(El.right,Access);
+  PopScope;
+end;
+
+procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
+  Access: TResolvedRefAccess);
+begin
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
+  {$ENDIF}
+  ResolveExpr(El.left,rraRead);
+  if El.right=nil then exit;
+  case El.OpCode of
+  eopNone:
+    case El.Kind of
+    pekRange:
+      ResolveExpr(El.right,rraRead);
+    else
+      if El.left.ClassType=TInheritedExpr then
+      else
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ResolveBinaryExpr El.Kind=',ExprKindNames[El.Kind],' El.Left=',GetObjName(El.left),' El.Right=',GetObjName(El.right),' parent=',GetObjName(El.Parent));
+        {$ENDIF}
+        RaiseNotYetImplemented(20160922163456,El);
+        end;
+    end;
+  eopAdd,
+  eopSubtract,
+  eopMultiply,
+  eopDivide,
+  eopDiv,
+  eopMod,
+  eopPower,
+  eopShr,
+  eopShl,
+  eopNot,
+  eopAnd,
+  eopOr,
+  eopXor,
+  eopEqual,
+  eopNotEqual,
+  eopLessThan,
+  eopGreaterThan,
+  eopLessthanEqual,
+  eopGreaterThanEqual,
+  eopIn,
+  eopIs,
+  eopAs,
+  eopSymmetricaldifference:
+    ResolveExpr(El.right,rraRead);
+  eopSubIdent:
+    ResolveSubIdent(El,Access);
+  else
+    RaiseNotYetImplemented(20160922163459,El,OpcodeStrings[El.OpCode]);
+  end;
+end;
+
+procedure TPasResolver.ResolveSubIdent(El: TBinaryExpr;
+  Access: TResolvedRefAccess);
+var
+  aModule: TPasModule;
+  ClassEl: TPasClassType;
+  ClassScope: TPasDotClassScope;
+  LeftResolved: TPasResolverResult;
+  Left: TPasExpr;
+  RecordEl: TPasRecordType;
+  RecordScope: TPasDotRecordScope;
+begin
+  if El.CustomData is TResolvedReference then
+    exit; // for example, when a.b has a dotted unit name
+
+  Left:=El.left;
+  //writeln('TPasResolver.ResolveSubIdent Left=',GetObjName(Left));
+  ComputeElement(Left,LeftResolved,[rcSetReferenceFlags]);
+
+  if LeftResolved.BaseType=btModule then
+    begin
+    // e.g. unitname.identifier
+    // => search in interface and if this is our module in the implementation
+    aModule:=LeftResolved.IdentEl as TPasModule;
+    PushModuleDotScope(aModule);
+    ResolveExpr(El.right,Access);
+    PopScope;
+    exit;
+    end
+  else if LeftResolved.TypeEl=nil then
+    begin
+    // illegal qualifier, see below
+    end
+  else if LeftResolved.TypeEl.ClassType=TPasClassType then
+    begin
+    ClassEl:=TPasClassType(LeftResolved.TypeEl);
+    ClassScope:=PushClassDotScope(ClassEl);
+    if LeftResolved.IdentEl is TPasType then
+      // e.g. TFPMemoryImage.FindHandlerFromExtension()
+      ClassScope.OnlyTypeMembers:=true
+    else
+      // e.g. Image.Width
+      ClassScope.OnlyTypeMembers:=false;
+    ResolveExpr(El.right,Access);
+    PopScope;
+    exit;
+    end
+  else if LeftResolved.TypeEl.ClassType=TPasClassOfType then
+    begin
+    // e.g. ImageClass.FindHandlerFromExtension()
+    ClassEl:=ResolveAliasType(TPasClassOfType(LeftResolved.TypeEl).DestType) as TPasClassType;
+    ClassScope:=PushClassDotScope(ClassEl);
+    ClassScope.OnlyTypeMembers:=true;
+    ResolveExpr(El.right,Access);
+    PopScope;
+    exit;
+    end
+  else if LeftResolved.TypeEl.ClassType=TPasRecordType then
+    begin
+    RecordEl:=TPasRecordType(LeftResolved.TypeEl);
+    RecordScope:=PushRecordDotScope(RecordEl);
+    RecordScope.ConstParent:=not (rrfWritable in LeftResolved.Flags);
+    if LeftResolved.IdentEl is TPasType then
+      // e.g. TPoint.PointInCircle
+      RecordScope.OnlyTypeMembers:=true
+    else
+      begin
+      // e.g. aPoint.X
+      AccessExpr(El.left,Access);
+      RecordScope.OnlyTypeMembers:=false;
+      end;
+    ResolveExpr(El.right,Access);
+    PopScope;
+    exit;
+    end
+  else if LeftResolved.TypeEl.ClassType=TPasEnumType then
+    begin
+    if LeftResolved.IdentEl is TPasType then
+      begin
+      // e.g. TShiftState.ssAlt
+      PushEnumDotScope(TPasEnumType(LeftResolved.TypeEl));
+      ResolveExpr(El.right,Access);
+      PopScope;
+      exit;
+      end;
+    end
+  else
+    RaiseMsg(20170216152541,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+      [LeftResolved.TypeEl.ElementTypeName],El);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveSubIdent left=',GetObjName(Left),' right=',GetObjName(El.right),' leftresolved=',GetResolverResultDbg(LeftResolved));
+  {$ENDIF}
+  RaiseMsg(20170216152157,nIllegalQualifier,sIllegalQualifier,['.'],El);
+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
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.ResolveParamsExpr SET literal Access=',Access);
+    {$ENDIF}
+    RaiseMsg(20170303211052,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
+    end;
+
+  // first resolve params
+  ResetSubScopes(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);
+  RestoreSubScopes(ScopeDepth);
+
+  // then resolve the call, typecast, array, set
+  if (Params.Kind=pekFuncParams) then
+    ResolveFuncParamsExpr(Params,Access)
+  else if (Params.Kind=pekArrayParams) then
+    ResolveArrayParamsExpr(Params,Access)
+  else if (Params.Kind=pekSet) then
+    ResolveSetParamsExpr(Params)
+  else
+    RaiseNotYetImplemented(20160922163501,Params);
+end;
+
+procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
+  Access: TResolvedRefAccess);
+
+  procedure FinishProcParams(ProcType: TPasProcedureType);
+  var
+    ParamAccess: TResolvedRefAccess;
+    i: Integer;
+  begin
+    if not (Access in [rraRead,rraParamToUnknownProc]) then
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.ResolveFuncParamsExpr.FinishProcParams Params=',GetObjName(Params),' Value=',GetObjName(Params.Value),' Access=',Access);
+      {$ENDIF}
+      RaiseMsg(20170306104440,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Params);
+      end;
+    for i:=0 to length(Params.Params)-1 do
+      begin
+      ParamAccess:=rraRead;
+      if i<ProcType.Args.Count then
+        case TPasArgument(ProcType.Args[i]).Access of
+        argVar: ParamAccess:=rraVarParam;
+        argOut: ParamAccess:=rraOutParam;
+        end;
+      AccessExpr(Params.Params[i],ParamAccess);
+      CheckCallProcCompatibility(ProcType,Params,false,true);
+      end;
+  end;
+
+  procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
+  var
+    i: Integer;
+    Value: TPasExpr;
+    ResolvedEl: TPasResolverResult;
+  begin
+    for i:=0 to length(Params.Params)-1 do
+      begin
+      Value:=Params.Params[i];
+      AccessExpr(Value,ParamAccess);
+      ComputeElement(Value,ResolvedEl,[rcNoImplicitProcType,rcSetReferenceFlags]);
+      end;
+  end;
+
+var
+  i: Integer;
+  ElName, Msg: String;
+  FindCallData: TFindCallElData;
+  Abort: boolean;
+  El, FoundEl: TPasElement;
+  Ref: TResolvedReference;
+  FindData: TPRFindData;
+  BuiltInProc: TResElDataBuiltInProc;
+  SubParams: TParamsExpr;
+  ResolvedEl: TPasResolverResult;
+  Value: TPasExpr;
+  TypeEl: TPasType;
+  C: TClass;
+begin
+  Value:=Params.Value;
+  if IsNameExpr(Value) then
+    begin
+    // e.g. Name() -> find compatible
+    if Value.ClassType=TPrimitiveExpr then
+      ElName:=TPrimitiveExpr(Value).Value
+    else
+      ElName:='Self';
+    FindCallData:=Default(TFindCallElData);
+    FindCallData.Params:=Params;
+    Abort:=false;
+    IterateElements(ElName,@OnFindCallElements,@FindCallData,Abort);
+    if FindCallData.Found=nil then
+      RaiseIdentifierNotFound(20170216152544,ElName,Value);
+    if FindCallData.Distance=cIncompatible then
+      begin
+      // FoundEl one element, but it was incompatible => raise error
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
+      WriteScopes;
+      {$ENDIF}
+      if FindCallData.Found is TPasProcedure then
+        CheckCallProcCompatibility(TPasProcedure(FindCallData.Found).ProcType,Params,true)
+      else if FindCallData.Found is TPasProcedureType then
+        CheckTypeCast(TPasProcedureType(FindCallData.Found),Params,true)
+      else if FindCallData.Found.ClassType=TPasUnresolvedSymbolRef then
+        begin
+        if FindCallData.Found.CustomData is TResElDataBuiltInProc then
+          begin
+          BuiltInProc:=TResElDataBuiltInProc(FindCallData.Found.CustomData);
+          BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
+          end
+        else if FindCallData.Found.CustomData is TResElDataBaseType then
+          CheckTypeCast(TPasUnresolvedSymbolRef(FindCallData.Found),Params,true)
+        else
+          RaiseNotYetImplemented(20161006132825,FindCallData.Found);
+        end
+      else if FindCallData.Found is TPasType then
+        // Note: check TPasType after TPasUnresolvedSymbolRef
+        CheckTypeCast(TPasType(FindCallData.Found),Params,true)
+      else if FindCallData.Found is TPasVariable then
+        begin
+        TypeEl:=ResolveAliasType(TPasVariable(FindCallData.Found).VarType);
+        if TypeEl is TPasProcedureType then
+          CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
+        else
+          RaiseMsg(20170405003522,nIllegalQualifier,sIllegalQualifier,['('],Params);
+        end
+      else
+        RaiseNotYetImplemented(20161003134755,FindCallData.Found);
+      end;
+    if FindCallData.Count>1 then
+      begin
+      // multiple overloads fit => search again and list the candidates
+      FindCallData:=Default(TFindCallElData);
+      FindCallData.Params:=Params;
+      FindCallData.List:=TFPList.Create;
+      try
+        IterateElements(ElName,@OnFindCallElements,@FindCallData,Abort);
+        Msg:='';
+        for i:=0 to FindCallData.List.Count-1 do
+          begin
+          El:=TPasElement(FindCallData.List[i]);
+          {$IFDEF VerbosePasResolver}
+          writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
+          {$ENDIF}
+          // emit a hint for each candidate
+          if El is TPasProcedure then
+            LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
+              [GetProcTypeDescription(TPasProcedure(El).ProcType,true,true)],El);
+          Msg:=Msg+', '+GetElementSourcePosStr(El);
+          end;
+        RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
+          sCantDetermineWhichOverloadedFunctionToCall+Msg,[ElName],Value);
+      finally
+        FindCallData.List.Free;
+      end;
+      end;
+
+    // FoundEl compatible element -> create reference
+    FoundEl:=FindCallData.Found;
+    Ref:=CreateReference(FoundEl,Value,rraRead);
+    if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
+      Ref.WithExprScope:=TPasWithExprScope(FindCallData.StartScope);
+    FindData:=Default(TPRFindData);
+    FindData.ErrorPosEl:=Value;
+    FindData.StartScope:=FindCallData.StartScope;
+    FindData.ElScope:=FindCallData.ElScope;
+    FindData.Found:=FoundEl;
+    CheckFoundElement(FindData,Ref);
+
+    // set param expression Access flags
+    if FoundEl is TPasProcedure then
+      // call proc
+      FinishProcParams(TPasProcedure(FoundEl).ProcType)
+    else if FoundEl is TPasType then
+      begin
+      TypeEl:=ResolveAliasType(TPasType(FoundEl));
+      C:=TypeEl.ClassType;
+      if (C=TPasClassType)
+          or (C=TPasClassOfType)
+          or (C=TPasRecordType)
+          or (C=TPasEnumType)
+          or (C=TPasSetType)
+          or (C=TPasPointerType)
+          or (C=TPasProcedureType)
+          or (C=TPasFunctionType)
+          or (C=TPasArrayType) then
+        begin
+        // type cast
+        FinishUntypedParams(Access);
+        end
+      else if C=TPasUnresolvedSymbolRef then
+        begin
+        if TypeEl.CustomData is TResElDataBuiltInProc then
+          begin
+          // call built-in proc
+          BuiltInProc:=TResElDataBuiltInProc(TypeEl.CustomData);
+          if Assigned(BuiltInProc.FinishParamsExpression) then
+            BuiltInProc.FinishParamsExpression(BuiltInProc,Params)
+          else
+            FinishUntypedParams(rraRead);
+          end
+        else if TypeEl.CustomData is TResElDataBaseType then
+          begin
+          // type cast to base type
+          FinishUntypedParams(Access);
+          end
+        else
+          begin
+          {$IFDEF VerbosePasResolver}
+          writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
+          {$ENDIF}
+          RaiseNotYetImplemented(20170325145720,Params);
+          end;
+        end
+      else
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData));
+        {$ENDIF}
+        RaiseMsg(20170306121908,nIllegalQualifier,sIllegalQualifier,['('],Params);
+        end;
+      end
+    else
+      begin
+      // FoundEl is not a type, maybe a var
+      ComputeElement(FoundEl,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
+      if ResolvedEl.TypeEl is TPasProcedureType then
+        begin
+        FinishProcParams(TPasProcedureType(ResolvedEl.TypeEl));
+        exit;
+        end;
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.ResolveFuncParamsExpr FoundEl=',GetObjName(FoundEl),' CustomData=',GetObjName(FoundEl.CustomData),' Resolvedel=',GetResolverResultDbg(ResolvedEl));
+      {$ENDIF}
+      RaiseMsg(20170306104301,nIllegalQualifier,sIllegalQualifier,['('],Params);
+      end;
+    end
+  else if Value.ClassType=TParamsExpr then
+    begin
+    SubParams:=TParamsExpr(Value);
+    if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
+      begin
+      // e.g. Name()() or Name[]()
+      ResolveExpr(SubParams,rraRead);
+      ComputeElement(SubParams,ResolvedEl,[rcNoImplicitProc,rcSetReferenceFlags]);
+      if IsProcedureType(ResolvedEl,true) then
+        begin
+        CheckCallProcCompatibility(TPasProcedureType(ResolvedEl.TypeEl),Params,true);
+        CreateReference(TPasProcedureType(ResolvedEl.TypeEl),Value,Access);
+        exit;
+        end
+      end;
+    RaiseMsg(20170216152202,nIllegalQualifier,sIllegalQualifier,['('],Params);
+    end
+  else
+    RaiseNotYetImplemented(20161014085118,Params.Value);
+end;
+
+procedure TPasResolver.ResolveArrayParamsExpr(Params: TParamsExpr;
+  Access: TResolvedRefAccess);
+var
+  ResolvedEl: TPasResolverResult;
+
+  procedure ResolveValueName(Value: TPasElement; ArrayName: string);
+  var
+    FindData: TPRFindData;
+    Ref: TResolvedReference;
+    DeclEl: TPasElement;
+  begin
+    // e.g. Name[]
+    DeclEl:=FindElementWithoutParams(ArrayName,FindData,Value,true);
+    Ref:=CreateReference(DeclEl,Value,Access,@FindData);
+    CheckFoundElement(FindData,Ref);
+    ComputeElement(Value,ResolvedEl,[rcSkipTypeAlias,rcSetReferenceFlags]);
+  end;
+
+var
+  Value: TPasExpr;
+  SubParams: TParamsExpr;
+begin
+  Value:=Params.Value;
+  if (Value.ClassType=TPrimitiveExpr)
+      and (TPrimitiveExpr(Value).Kind=pekIdent) then
+    // e.g. Name[]
+    ResolveValueName(Value,TPrimitiveExpr(Value).Value)
+  else if (Value.ClassType=TSelfExpr) then
+    // e.g. Self[]
+    ResolveValueName(Value,'Self')
+  else if Value.ClassType=TParamsExpr then
+    begin
+    SubParams:=TParamsExpr(Value);
+    if (SubParams.Kind in [pekArrayParams,pekFuncParams]) then
+      begin
+      // e.g. Name()[] or Name[][]
+      ResolveExpr(SubParams,rraRead);
+      ComputeElement(SubParams,ResolvedEl,[rcSkipTypeAlias,rcNoImplicitProc,rcSetReferenceFlags]);
+      CreateReference(ResolvedEl.TypeEl,Value,Access);
+      end
+    else
+      RaiseNotYetImplemented(20161010194925,Value);
+    end
+  else
+    RaiseNotYetImplemented(20160927212610,Value);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveArrayParamsExpr Value=',GetObjName(Value),' ',GetResolverResultDbg(ResolvedEl));
+  {$ENDIF}
+  ResolveArrayParamsArgs(Params,ResolvedEl,Access);
+end;
+
+procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
+  const ResolvedValue: TPasResolverResult; Access: TResolvedRefAccess);
+var
+  ArgExp: TPasExpr;
+  ResolvedArg: TPasResolverResult;
+  PropEl: TPasProperty;
+  ClassScope: TPasClassScope;
+  i: Integer;
+begin
+  if ResolvedValue.BaseType in btAllStrings then
+    begin
+    // string -> check that ResolvedValue is not merely a type, but has a value
+    if not (rrfReadable in ResolvedValue.Flags) then
+      RaiseXExpectedButYFound(20170216152548,'variable',ResolvedValue.TypeEl.ElementTypeName,Params);
+    // check single argument
+    if length(Params.Params)<1 then
+      RaiseMsg(20170216152204,nMissingParameterX,
+        sMissingParameterX,['character index'],Params)
+    else if length(Params.Params)>1 then
+      RaiseMsg(20170216152551,nIllegalQualifier,sIllegalQualifier,[','],Params.Params[1]);
+    // check argument is integer
+    ArgExp:=Params.Params[0];
+    ComputeElement(ArgExp,ResolvedArg,[rcSkipTypeAlias,rcSetReferenceFlags]);
+    if not (ResolvedArg.BaseType in btAllInteger) then
+      RaiseMsg(20170216152209,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+        [BaseTypeNames[ResolvedArg.BaseType],'integer'],ArgExp);
+    if not (rrfReadable in ResolvedArg.Flags) then
+      RaiseMsg(20170216152211,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+        ['type','value'],ArgExp);
+    AccessExpr(ArgExp,rraRead);
+    exit;
+    end
+  else if (ResolvedValue.IdentEl is TPasProperty)
+      and (TPasProperty(ResolvedValue.IdentEl).Args.Count>0) then
+    begin
+    PropEl:=TPasProperty(ResolvedValue.IdentEl);
+    CheckCallPropertyCompatibility(PropEl,Params,true);
+    FinishPropertyParamAccess(Params,PropEl);
+    exit;
+    end
+  else if ResolvedValue.BaseType=btContext then
+    begin
+    if ResolvedValue.TypeEl.ClassType=TPasClassType then
+      begin
+      ClassScope:=ResolvedValue.TypeEl.CustomData as TPasClassScope;
+      if ResolveBracketOperatorClass(Params,ResolvedValue,ClassScope,Access) then
+        exit;
+      end
+    else if ResolvedValue.TypeEl.ClassType=TPasArrayType then
+      begin
+      if ResolvedValue.IdentEl is TPasType then
+        RaiseMsg(20170216152215,nIllegalQualifier,sIllegalQualifier,['['],Params);
+      CheckCallArrayCompatibility(TPasArrayType(ResolvedValue.TypeEl),Params,true,true);
+      for i:=0 to length(Params.Params)-1 do
+        AccessExpr(Params.Params[i],rraRead);
+      exit;
+      end;
+    end;
+  RaiseMsg(20170216152217,nIllegalQualifier,sIllegalQualifier,['['],Params);
+end;
+
+function TPasResolver.ResolveBracketOperatorClass(Params: TParamsExpr;
+  const ResolvedValue: TPasResolverResult; ClassScope: TPasClassScope;
+  Access: TResolvedRefAccess): boolean;
+var
+  PropEl: TPasProperty;
+  Value: TPasExpr;
+begin
+  PropEl:=ClassScope.DefaultProperty;
+  if PropEl<>nil then
+    begin
+    // class has default property
+    if (ResolvedValue.IdentEl is TPasType) and (not PropEl.IsClass) then
+      RaiseMsg(20170216152213,nIllegalQualifier,sIllegalQualifier,['['],Params);
+    Value:=Params.Value;
+    if Value.CustomData is TResolvedReference then
+      SetResolvedRefAccess(Value,TResolvedReference(Value.CustomData),rraRead);
+    CreateReference(PropEl,Params,Access);
+    CheckCallPropertyCompatibility(PropEl,Params,true);
+    FinishPropertyParamAccess(Params,PropEl);
+    exit(true);
+    end;
+  Result:=false;
+end;
+
+procedure TPasResolver.ResolveSetParamsExpr(Params: TParamsExpr);
+// e.g. resolving '[1,2..3]'
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ResolveSetParamsExpr ',GetTreeDbg(Params));
+  {$ENDIF}
+  if Params.Value<>nil then
+    RaiseNotYetImplemented(20160930135910,Params);
+end;
+
+procedure TPasResolver.ResolveArrayValues(El: TArrayValues);
+var
+  i: Integer;
+begin
+  for i:=0 to length(El.Values)-1 do
+    ResolveExpr(El.Values[i],rraRead);
+end;
+
+procedure TPasResolver.SetResolvedRefAccess(Expr: TPasExpr;
+  Ref: TResolvedReference; Access: TResolvedRefAccess);
+begin
+  if (Ref.Access=Access) then exit;
+  if Access in [rraNone,rraParamToUnknownProc] then
+    exit;
+  if Expr=nil then ;
+
+  case Ref.Access of
+    rraNone,rraParamToUnknownProc:
+      Ref.Access:=Access;
+    rraRead:
+      if Access in [rraAssign,rraReadAndAssign,rraVarParam,rraOutParam] then
+        Ref.Access:=rraReadAndAssign
+      else
+        exit;
+    rraAssign,rraOutParam:
+      if Access in [rraRead,rraReadAndAssign,rraVarParam] then
+        Ref.Access:=rraReadAndAssign
+      else
+        exit;
+    rraReadAndAssign: exit;
+    rraVarParam: exit;
+  else
+    RaiseInternalError(20170403163727);
+  end;
+end;
+
+procedure TPasResolver.AccessExpr(Expr: TPasExpr;
+  Access: TResolvedRefAccess);
+// called after a call target was found, called for each element
+// to set the rraParamToUnknownProc to Access
+var
+  Ref: TResolvedReference;
+  Bin: TBinaryExpr;
+  Params: TParamsExpr;
+  ValueResolved: TPasResolverResult;
+  C: TClass;
+begin
+  if (Expr.CustomData is TResolvedReference) then
+    begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    SetResolvedRefAccess(Expr,Ref,Access);
+    end;
+
+  C:=Expr.ClassType;
+  if C=TBinaryExpr then
+    begin
+    Bin:=TBinaryExpr(Expr);
+    if Bin.OpCode in [eopSubIdent,eopNone] then
+      AccessExpr(Bin.right,Access);
+    end
+  else if C=TParamsExpr then
+    begin
+    Params:=TParamsExpr(Expr);
+    case Params.Kind of
+    pekFuncParams:
+      if IsTypeCast(Params) then
+        AccessExpr(Params.Params[0],Access)
+      else
+        AccessExpr(Params.Value,Access);
+    pekArrayParams:
+      begin
+      ComputeElement(Params.Value,ValueResolved,[]);
+      if not IsDynArray(ValueResolved.TypeEl) then
+        AccessExpr(Params.Value,Access);
+      end;
+    pekSet:
+      if Access<>rraRead then
+        RaiseMsg(20170306112306,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
+    else
+      RaiseNotYetImplemented(20170403173831,Params);
+    end;
+    end
+  else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
+    // ok
+  else if (Access=rraRead)
+      and ((C=TPrimitiveExpr)
+        or (C=TNilExpr)
+        or (C=TBoolConstExpr)) then
+    // ok
+  else if C=TUnaryExpr then
+    AccessExpr(TUnaryExpr(Expr).Operand,Access)
+  else
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.AccessExpr Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
+    {$ENDIF}
+    RaiseNotYetImplemented(20170306102158,Expr);
+    end;
+end;
+
+procedure TPasResolver.CheckPendingForwards(El: TPasElement);
+var
+  i: Integer;
+  DeclEl: TPasElement;
+  Proc: TPasProcedure;
+  aClassType: TPasClassType;
+begin
+  if El is TPasDeclarations then
+    begin
+    for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
+      begin
+      DeclEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
+      if DeclEl is TPasProcedure then
+        begin
+        Proc:=TPasProcedure(DeclEl);
+        if ProcNeedsImplProc(Proc)
+            and (TPasProcedureScope(Proc.CustomData).ImplProc=nil) then
+          RaiseMsg(20170216152219,nForwardProcNotResolved,sForwardProcNotResolved,
+            [Proc.ElementTypeName,Proc.Name],Proc);
+        end;
+      end;
+    end
+  else if El.ClassType=TPasClassType then
+    begin
+    aClassType:=TPasClassType(El);
+    for i:=0 to aClassType.Members.Count-1 do
+      begin
+      DeclEl:=TPasElement(aClassType.Members[i]);
+      if DeclEl is TPasProcedure then
+        begin
+        Proc:=TPasProcedure(DeclEl);
+        if Proc.IsAbstract or Proc.IsExternal then continue;
+        if TPasProcedureScope(Proc.CustomData).ImplProc=nil then
+          RaiseMsg(20170216152221,nForwardProcNotResolved,sForwardProcNotResolved,
+            [Proc.ElementTypeName,Proc.Name],Proc);
+        end;
+      end;
+    end;
+end;
+
+procedure TPasResolver.AddModule(El: TPasModule);
+var
+  C: TClass;
+  ModScope: TPasModuleScope;
+begin
+  if TopScope<>DefaultScope then
+    RaiseInvalidScopeForElement(20160922163504,El);
+  ModScope:=TPasModuleScope(PushScope(El,TPasModuleScope));
+  ModScope.VisibilityContext:=El;
+  ModScope.FirstName:=FirstDottedIdentifier(El.Name);
+  C:=El.ClassType;
+  if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
+    FDefaultNameSpace:=ChompDottedIdentifier(El.Name)
+  else
+    FDefaultNameSpace:='';
+end;
+
+procedure TPasResolver.AddSection(El: TPasSection);
+// TInterfaceSection, TImplementationSection, TProgramSection, TLibrarySection
+// Note: implementation scope is within the interface scope
+begin
+  FPendingForwards.Add(El); // check forward declarations at the end
+  PushScope(El,TPasSectionScope);
+end;
+
+procedure TPasResolver.AddType(El: TPasType);
+begin
+  if (El.Name='') then exit; // sub type
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddType El=',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160922163506,El);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+end;
+
+procedure TPasResolver.AddRecordType(El: TPasRecordType);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160922163508,El);
+  if El.Name<>'' then begin
+    AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+    FPendingForwards.Add(El); // check forward declarations at the end
+  end;
+
+  if El.Parent.ClassType<>TPasVariant then
+    PushScope(El,TPasRecordScope);
+end;
+
+procedure TPasResolver.AddClassType(El: TPasClassType);
+var
+  Duplicate: TPasIdentifier;
+  ForwardDecl: TPasClassType;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddClassType ',GetObjName(El),' Parent=',GetObjName(El.Parent),' ',GetElementSourcePosStr(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160922163510,El);
+
+  Duplicate:=TPasIdentifierScope(TopScope).FindIdentifier(El.Name);
+  //if Duplicate<>nil then
+    //writeln('  Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
+
+  if (Duplicate<>nil)
+      and (Duplicate.Kind=pikSimple)
+      and (Duplicate.Element<>nil)
+      and (Duplicate.Element.Parent=El.Parent)
+      and (Duplicate.Element is TPasClassType)
+      and TPasClassType(Duplicate.Element).IsForward
+  then
+    begin
+    // forward declaration found
+    ForwardDecl:=TPasClassType(Duplicate.Element);
+    {$IFDEF VerbosePasResolver}
+    writeln('  Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
+    {$ENDIF}
+    if ForwardDecl.CustomData<>nil then
+      RaiseInternalError(20160922163513,'forward class has already customdata');
+    // create a ref from the forward to the real declaration
+    CreateReference(El,ForwardDecl,rraRead);
+    // change the cache item
+    Duplicate.Element:=El;
+    end
+  else
+    AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+
+  FPendingForwards.Add(El); // check forward declarations at the end
+end;
+
+procedure TPasResolver.AddVariable(El: TPasVariable);
+begin
+  if (El.Name='') then exit; // anonymous var
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddVariable ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160929205730,El);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+end;
+
+procedure TPasResolver.AddEnumType(El: TPasEnumType);
+var
+  CanonicalSet: TPasSetType;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddEnumType ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160929205732,El);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+  PushScope(El,TPasEnumTypeScope);
+  // add canonical set
+  CanonicalSet:=TPasSetType.Create('',El);
+  CanonicalSet.EnumType:=El;
+  El.AddRef;
+  TPasEnumTypeScope(TopScope).CanonicalSet:=CanonicalSet;
+end;
+
+procedure TPasResolver.AddEnumValue(El: TPasEnumValue);
+var
+  i: Integer;
+  Scope: TPasScope;
+  Old: TPasIdentifier;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddEnumValue ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasEnumTypeScope) then
+    RaiseInvalidScopeForElement(20160929205736,El);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+
+  // propagate enum to parent scopes
+  for i:=ScopeCount-2 downto 0 do
+    begin
+    Scope:=Scopes[i];
+    if (Scope is TPasClassScope) or (Scope is TPasRecordScope) then
+      begin
+      // class or record: add if not duplicate
+      Old:=TPasIdentifierScope(Scope).FindIdentifier(El.Name);
+      if Old=nil then
+        TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
+      end
+    else if (Scope is TPasProcedureScope) or (Scope is TPasSectionScope) then
+      begin
+      // procedure or section: check for duplicate and add
+      Old:=TPasIdentifierScope(Scope).FindLocalIdentifier(El.Name);
+      if Old<>nil then
+        RaiseMsg(20170216152224,nDuplicateIdentifier,sDuplicateIdentifier,
+                 [El.Name,GetElementSourcePosStr(Old.Element)],El);
+      TPasIdentifierScope(Scope).AddIdentifier(El.Name,El,pikSimple);
+      break;
+      end
+    else
+      break;
+    end;
+end;
+
+procedure TPasResolver.AddProperty(El: TPasProperty);
+begin
+  if (El.Name='') then
+    RaiseNotYetImplemented(20160922163518,El);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddProperty ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasClassScope) then
+    RaiseInvalidScopeForElement(20160922163520,El);
+  AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+  PushScope(El,TPasPropertyScope);
+end;
+
+procedure TPasResolver.AddProcedure(El: TPasProcedure);
+var
+  ProcName, aClassName: String;
+  p: SizeInt;
+  CurClassType: TPasClassType;
+  ProcScope: TPasProcedureScope;
+  NeedPop, HasDot: Boolean;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddProcedure ',GetObjName(El));
+  {$ENDIF}
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160922163522,El);
+  // Note: El.ProcType is nil !
+  ProcName:=El.Name;
+  HasDot:=Pos('.',ProcName)>1;
+  if not HasDot then
+    AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
+  ProcScope:=TPasProcedureScope(PushScope(El,TPasProcedureScope));
+  if HasDot then
+    begin
+    // method implementation -> search class
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.AddProcedure searching class of "',ProcName,'" ...');
+    {$ENDIF}
+    CurClassType:=nil;
+    repeat
+      p:=Pos('.',ProcName);
+      if p<1 then
+        begin
+        if CurClassType=nil then
+          RaiseInternalError(20161013170829);
+        break;
+        end;
+      aClassName:=LeftStr(ProcName,p-1);
+      Delete(ProcName,1,p);
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.AddProcedure searching class "',aClassName,'" ProcName="',ProcName,'" ...');
+      {$ENDIF}
+      if not IsValidIdent(aClassName) then
+        RaiseNotYetImplemented(20161013170844,El);
+
+      if CurClassType<>nil then
+        begin
+        NeedPop:=true;
+        PushClassDotScope(CurClassType);
+        end
+      else
+        NeedPop:=false;
+
+      CurClassType:=TPasClassType(FindElementWithoutParams(aClassName,El,false));
+      if not (CurClassType is TPasClassType) then
+        begin
+        aClassName:=LeftStr(El.Name,length(El.Name)-length(ProcName));
+        RaiseXExpectedButYFound(20170216152557,'class',aClassname+':'+CurClassType.ElementTypeName,El);
+        end;
+
+      // restore scope
+      if NeedPop then
+        PopScope;
+    until false;
+
+    if not IsValidIdent(ProcName) then
+      RaiseNotYetImplemented(20161013170956,El);
+
+    ProcScope.VisibilityContext:=CurClassType;
+    ProcScope.ClassScope:=CurClassType.CustomData as TPasClassScope;
+    end;
+end;
+
+procedure TPasResolver.AddArgument(El: TPasArgument);
+var
+  ProcType: TPasProcedureType;
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  if (El.Name='') then
+    RaiseInternalError(20160922163526,GetObjName(El));
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.AddArgument ',GetObjName(El));
+  {$ENDIF}
+  if (TopScope=nil) then
+    RaiseInvalidScopeForElement(20160922163529,El);
+  if El.Parent.ClassType=TPasProperty then
+    begin
+    if TopScope.ClassType<>TPasPropertyScope then
+      RaiseInvalidScopeForElement(20161014124530,El);
+    AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+    end
+  else if El.Parent is TPasProcedureType then
+    begin
+    ProcType:=TPasProcedureType(El.Parent);
+    if ProcType.Parent is TPasProcedure then
+      begin
+      if TopScope.ClassType<>TPasProcedureScope then
+        RaiseInvalidScopeForElement(20160922163529,El);
+      AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
+      end
+    else
+      begin
+      for i:=0 to ProcType.Args.Count-1 do
+        begin
+        Arg:=TPasArgument(ProcType.Args[i]);
+        if (Arg<>El) and (CompareText(TPasArgument(ProcType.Args[i]).Name,El.Name)=0) then
+          RaiseMsg(20170216152225,nDuplicateIdentifier,sDuplicateIdentifier,[Arg.Name,GetElementSourcePosStr(Arg)],El);
+        end;
+      end;
+    end
+  else
+    RaiseNotYetImplemented(20161014124937,El);
+end;
+
+procedure TPasResolver.AddFunctionResult(El: TPasResultElement);
+begin
+  if TopScope.ClassType<>TPasProcedureScope then exit;
+  if not (El.Parent is TPasProcedure) then exit;
+  AddIdentifier(TPasProcedureScope(TopScope),ResolverResultVar,El,pikSimple);
+end;
+
+procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
+begin
+  PushScope(El,TPasExceptOnScope);
+end;
+
+procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
+begin
+  if El=nil then ;
+  CheckTopScope(TPasProcedureScope);
+end;
+
+procedure TPasResolver.WriteScopes;
+var
+  i: Integer;
+  Scope: TPasScope;
+begin
+  writeln('TPasResolver.WriteScopes ScopeCount=',ScopeCount);
+  for i:=ScopeCount-1 downto 0 do
+    begin
+    Scope:=Scopes[i];
+    writeln('  ',i,'/',ScopeCount,' ',GetObjName(Scope));
+    Scope.WriteIdentifiers('  ');
+    end;
+end;
+
+procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+
+  procedure SetBaseType(BaseType: TResolverBaseType);
+  begin
+    SetResolverValueExpr(ResolvedEl,BaseType,FBaseTypes[BaseType],Bin,[rrfReadable]);
+  end;
+
+var
+  LeftResolved, RightResolved: TPasResolverResult;
+  LeftTypeEl, RightTypeEl: TPasType;
+begin
+  if (Bin.OpCode=eopSubIdent)
+  or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
+    begin
+    // Note: bin.left was already resolved via ResolveSubIdent
+    ComputeElement(Bin.right,ResolvedEl,Flags,StartEl);
+    exit;
+    end;
+
+  if Bin.OpCode in [eopEqual,eopNotEqual] then
+    begin
+    if CheckEqualElCompatibility(Bin.left,Bin.right,nil,true,
+        rcSetReferenceFlags in Flags)=cIncompatible then
+      RaiseInternalError(20161007215912);
+    SetBaseType(btBoolean);
+    exit;
+    end;
+
+  ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
+  ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
+  // ToDo: check operator overloading
+
+  //writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
+
+  if LeftResolved.BaseType in btAllInteger then
+    begin
+    if (rrfReadable in LeftResolved.Flags)
+        and (rrfReadable in RightResolved.Flags) then
+      begin
+        if (RightResolved.BaseType in (btAllInteger+btAllFloats)) then
+          case Bin.OpCode of
+          eopNone:
+            if (Bin.Kind=pekRange) then
+              begin
+              if not (RightResolved.BaseType in btAllInteger) then
+                RaiseXExpectedButYFound(20170216152600,'integer',BaseTypeNames[RightResolved.BaseType],Bin.right);
+              SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+              if Bin.Parent is TPasRangeType then
+                ResolvedEl.TypeEl:=TPasRangeType(Bin.Parent);
+              exit;
+              end;
+          eopAdd, eopSubtract,
+          eopMultiply, eopDiv, eopMod,
+          eopPower,
+          eopShl, eopShr,
+          eopAnd, eopOr, eopXor:
+            begin
+            // use left type for result
+            SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+            exit;
+            end;
+          eopLessThan,
+          eopGreaterThan,
+          eopLessthanEqual,
+          eopGreaterThanEqual:
+            begin
+            SetBaseType(btBoolean);
+            exit;
+            end;
+          eopDivide:
+            begin
+            SetBaseType(BaseTypeExtended);
+            exit;
+            end;
+          end
+        else if (RightResolved.BaseType=btSet) and (RightResolved.SubType in btAllInteger)
+            and (Bin.OpCode=eopIn) then
+          begin
+          SetBaseType(btBoolean);
+          exit;
+          end;
+      end;
+    end
+  else if LeftResolved.BaseType in btAllBooleans then
+    begin
+    if (rrfReadable in LeftResolved.Flags)
+        and (RightResolved.BaseType in btAllBooleans)
+        and (rrfReadable in RightResolved.Flags) then
+      case Bin.OpCode of
+      eopNone:
+        if Bin.Kind=pekRange then
+          begin
+          SetResolverValueExpr(ResolvedEl,btRange,FBaseTypes[LeftResolved.BaseType],Bin,[rrfReadable]);
+          ResolvedEl.SubType:=LeftResolved.BaseType;
+          exit;
+          end;
+      eopAnd, eopOr, eopXor:
+        begin
+        // use left type for result
+        SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+        exit;
+        end;
+      end;
+    end
+  else if LeftResolved.BaseType in btAllStringAndChars then
+    begin
+    if (rrfReadable in LeftResolved.Flags)
+        and (rrfReadable in RightResolved.Flags) then
+      begin
+      if (RightResolved.BaseType in btAllStringAndChars) then
+        case Bin.OpCode of
+        eopNone:
+          if (Bin.Kind=pekRange) and (LeftResolved.BaseType in [btChar]) then
+            begin
+            if RightResolved.BaseType<>btChar then
+              RaiseXExpectedButYFound(20170216152603,'char',BaseTypeNames[RightResolved.BaseType],Bin.right);
+            SetResolverValueExpr(ResolvedEl,btRange,FBaseTypes[btChar],Bin,[rrfReadable]);
+            ResolvedEl.SubType:=LeftResolved.BaseType;
+            exit;
+            end;
+        eopAdd:
+          case LeftResolved.BaseType of
+          btChar:
+            begin
+            case RightResolved.BaseType of
+            btChar: SetBaseType(btString);
+            btAnsiChar:
+              if BaseTypeChar=btAnsiChar then
+                SetBaseType(btString)
+              else
+                SetBaseType(btUnicodeString);
+            btWideChar:
+              if BaseTypeChar=btWideChar then
+                SetBaseType(btString)
+              else
+                SetBaseType(btUnicodeString);
+            else
+              // use right type for result
+              SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
+            end;
+            exit;
+            end;
+          btAnsiChar:
+            begin
+            case RightResolved.BaseType of
+            btChar:
+              if BaseTypeChar=btAnsiChar then
+                SetBaseType(btString)
+              else
+                SetBaseType(btUnicodeString);
+            btAnsiChar:
+              if BaseTypeChar=btAnsiChar then
+                SetBaseType(btString)
+              else
+                SetBaseType(btAnsiString);
+            btWideChar:
+              if BaseTypeChar=btWideChar then
+                SetBaseType(btString)
+              else
+                SetBaseType(btUnicodeString);
+            else
+              // use right type for result
+              SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
+            end;
+            exit;
+            end;
+          btWideChar:
+            begin
+              case RightResolved.BaseType of
+              btChar,btAnsiChar,btWideChar:
+                if BaseTypeChar=btWideChar then
+                  SetBaseType(btString)
+                else
+                  SetBaseType(btUnicodeString);
+              else
+                // use right type for result
+                SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
+              end;
+              exit;
+            end;
+          btShortString:
+            begin
+              case RightResolved.BaseType of
+              btChar,btAnsiChar,btShortString,btWideChar:
+                // use left type for result
+                SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+              else
+                // shortstring + string => string
+                SetResolverValueExpr(ResolvedEl,RightResolved.BaseType,RightResolved.TypeEl,Bin,[rrfReadable]);
+              end;
+              exit;
+            end;
+          btString,btAnsiString,btUnicodeString:
+            begin
+              // string + x => string
+              SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+              exit;
+            end;
+          end;
+        eopLessThan,
+        eopGreaterThan,
+        eopLessthanEqual,
+        eopGreaterThanEqual:
+          begin
+          SetBaseType(btBoolean);
+          exit;
+          end;
+        end
+      else if (RightResolved.BaseType=btSet) and (RightResolved.SubType=btChar)
+          and (LeftResolved.BaseType=btChar) then
+        begin
+        case Bin.OpCode of
+        eopIn:
+          begin
+          SetBaseType(btBoolean);
+          exit;
+          end;
+        end;
+        end
+      end
+    end
+  else if LeftResolved.BaseType in btAllFloats then
+    begin
+    if (rrfReadable in LeftResolved.Flags)
+        and (RightResolved.BaseType in (btAllInteger+btAllFloats))
+        and (rrfReadable in RightResolved.Flags) then
+      case Bin.OpCode of
+      eopAdd, eopSubtract,
+      eopMultiply, eopDivide, eopMod,
+      eopPower:
+        begin
+        SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType,LeftResolved.TypeEl,Bin,[rrfReadable]);
+        exit;
+        end;
+      eopLessThan,
+      eopGreaterThan,
+      eopLessthanEqual,
+      eopGreaterThanEqual:
+        begin
+        SetBaseType(btBoolean);
+        exit;
+        end;
+      end;
+    end
+  else if LeftResolved.BaseType=btPointer then
+    begin
+    if (rrfReadable in LeftResolved.Flags)
+        and (RightResolved.BaseType in btAllInteger)
+        and (rrfReadable in RightResolved.Flags) then
+      case Bin.OpCode of
+      eopAdd,eopSubtract:
+        begin
+        SetResolverValueExpr(ResolvedEl,btPointer,LeftResolved.TypeEl,Bin,[rrfReadable]);
+        exit;
+        end;
+      end
+    else if RightResolved.BaseType=btPointer then
+      case Bin.OpCode of
+      eopLessThan,
+      eopGreaterThan,
+      eopLessthanEqual,
+      eopGreaterThanEqual:
+        begin
+        SetBaseType(btBoolean);
+        exit;
+        end;
+      end;
+    end
+  else if LeftResolved.BaseType=btContext then
+    case Bin.OpCode of
+    eopNone:
+      if Bin.Kind=pekRange then
+        begin
+        if (rrfReadable in LeftResolved.Flags)
+            and (rrfReadable in RightResolved.Flags) then
+          begin
+          CheckSetLitElCompatible(Bin.left,Bin.right,LeftResolved,RightResolved);
+          ResolvedEl:=LeftResolved;
+          ResolvedEl.SubType:=ResolvedEl.BaseType;
+          ResolvedEl.BaseType:=btRange;
+          exit;
+          end;
+        end;
+    eopIn:
+      if (rrfReadable in LeftResolved.Flags)
+      and (rrfReadable in RightResolved.Flags) then
+        begin
+        if LeftResolved.BaseType in (btAllInteger+[btChar]) then
+          begin
+          if (RightResolved.BaseType<>btSet) then
+            RaiseXExpectedButYFound(20170216152607,'set of '+BaseTypeNames[LeftResolved.BaseType],LeftResolved.TypeEl.ElementTypeName,Bin.right);
+          if LeftResolved.BaseType=btChar then
+            begin
+            if RightResolved.SubType<>btChar then
+              RaiseXExpectedButYFound(20170216152609,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
+            end
+          else if not (RightResolved.SubType in btAllInteger) then
+            RaiseXExpectedButYFound(20170216152612,'set of '+BaseTypeNames[LeftResolved.BaseType],'set of '+BaseTypeNames[RightResolved.SubType],Bin.right);
+          SetBaseType(btBoolean);
+          exit;
+          end
+        else if (LeftResolved.BaseType=btContext) and (LeftResolved.TypeEl is TPasEnumType) then
+          begin
+          if (RightResolved.BaseType<>btSet) then
+            RaiseXExpectedButYFound(20170216152615,'set of '+LeftResolved.TypeEl.Name,LeftResolved.TypeEl.ElementTypeName,Bin.right);
+          if LeftResolved.TypeEl<>RightResolved.TypeEl then
+            RaiseXExpectedButYFound(20170216152618,'set of '+LeftResolved.TypeEl.Name,'set of '+RightResolved.TypeEl.Name,Bin.right);
+          SetBaseType(btBoolean);
+          exit;
+          end
+        else
+          RaiseMsg(20170216152228,nInOperatorExpectsSetElementButGot,
+            sInOperatorExpectsSetElementButGot,[LeftResolved.TypeEl.ElementTypeName],Bin);
+        end;
+    eopIs:
+      begin
+      if (LeftResolved.TypeEl is TPasClassType) then
+        begin
+        if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
+          RaiseMsg(20170216152230,nIllegalQualifier,sIllegalQualifier,['is'],Bin);
+        // left side is a class instance
+        if RightResolved.IdentEl is TPasClassType then
+          begin
+          // e.g. if Image is TFPMemoryImage then ;
+          // Note: at compile time the check is reversed: right must inherit from left
+          if CheckSrcIsADstType(RightResolved,LeftResolved,Bin)<>cIncompatible then
+            begin
+            SetBaseType(btBoolean);
+            exit;
+            end
+          else if CheckSrcIsADstType(LeftResolved,RightResolved,Bin)<>cIncompatible then
+            begin
+            // e.g. if Image is TObject then ;
+            // This is useful after some unchecked typecast -> allow
+            SetBaseType(btBoolean);
+            exit;
+            end;
+          {$IFDEF VerbosePasResolver}
+          writeln('TPasResolver.ComputeBinaryExpr LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.TypeEl)));
+          writeln('TPasResolver.ComputeBinaryExpr RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.IdentEl)));
+          {$ENDIF}
+          end
+        else if (RightResolved.TypeEl is TPasClassOfType)
+            and (rrfReadable in RightResolved.Flags) then
+          begin
+          // e.g. if Image is ImageClass then ;
+          if (CheckClassesAreRelated(LeftResolved.TypeEl,
+              TPasClassOfType(RightResolved.TypeEl).DestType,Bin)<>cIncompatible) then
+            begin
+            SetBaseType(btBoolean);
+            exit;
+            end;
+          end
+        else
+          RaiseXExpectedButYFound(20170216152625,'class type',RightResolved.TypeEl.ElementTypeName,Bin.right);
+        end
+      else if (proClassOfIs in Options) and (LeftResolved.TypeEl is TPasClassOfType)
+          and (rrfReadable in LeftResolved.Flags) then
+        begin
+        if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType) then
+          RaiseMsg(20170322101128,nIllegalQualifier,sIllegalQualifier,['is'],Bin);
+        // left side is class-of variable
+        LeftTypeEl:=TPasClassOfType(LeftResolved.TypeEl).DestType;
+        if RightResolved.IdentEl is TPasClassType then
+          begin
+          // e.g. if ImageClass is TFPMemoryImage then ;
+          // Note: at compile time the check is reversed: right must inherit from left
+          if CheckClassIsClass(RightResolved.TypeEl,LeftTypeEl,Bin)<>cIncompatible then
+            begin
+            SetBaseType(btBoolean);
+            exit;
+            end
+          end
+        else if (RightResolved.TypeEl is TPasClassOfType) then
+          begin
+          // e.g. if ImageClassA is ImageClassB then ;
+          // or   if ImageClassA is TFPImageClass then ;
+          RightTypeEl:=TPasClassOfType(RightResolved.TypeEl).DestType;
+          if (CheckClassesAreRelated(LeftTypeEl,RightTypeEl,Bin)<>cIncompatible) then
+            begin
+            SetBaseType(btBoolean);
+            exit;
+            end
+          end
+        else
+          RaiseXExpectedButYFound(20170322105252,'class type',RightResolved.TypeEl.ElementTypeName,Bin.right);
+        end
+      else if LeftResolved.TypeEl=nil then
+        RaiseMsg(20170216152232,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
+                 [BaseTypeNames[LeftResolved.BaseType]],Bin.left)
+      else
+        RaiseMsg(20170216152234,nLeftSideOfIsOperatorExpectsAClassButGot,sLeftSideOfIsOperatorExpectsAClassButGot,
+                 [LeftResolved.TypeEl.ElementTypeName],Bin.left);
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.ComputeBinaryExpr is-operator: left=',GetResolverResultDbg(LeftResolved),' right=',GetResolverResultDbg(RightResolved));
+      {$ENDIF}
+      RaiseMsg(20170216152236,nTypesAreNotRelated,sTypesAreNotRelated,[],Bin);
+      end;
+    eopAs:
+      begin
+      if (LeftResolved.TypeEl is TPasClassType) then
+        begin
+        if (LeftResolved.IdentEl=nil) or (LeftResolved.IdentEl is TPasType)
+            or (not (rrfReadable in LeftResolved.Flags)) then
+          RaiseMsg(20170216152237,nIllegalQualifier,sIllegalQualifier,['as'],Bin);
+        if RightResolved.IdentEl=nil then
+          RaiseXExpectedButYFound(20170216152630,'class',RightResolved.TypeEl.ElementTypeName,Bin.right);
+        if not (RightResolved.IdentEl is TPasType) then
+          RaiseXExpectedButYFound(20170216152632,'class',RightResolved.IdentEl.Name,Bin.right);
+        if (CheckSrcIsADstType(RightResolved,LeftResolved,Bin)<>cIncompatible) then
+          begin
+          SetResolverValueExpr(ResolvedEl,btContext,RightResolved.TypeEl,Bin,[rrfReadable]);
+          exit;
+          end;
+        RaiseMsg(20170216152239,nTypesAreNotRelated,sTypesAreNotRelated,[],Bin);
+        end;
+      end;
+    eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
+      if (LeftResolved.TypeEl.ClassType=TPasEnumType)
+          and (rrfReadable in LeftResolved.Flags)
+          and (LeftResolved.TypeEl=RightResolved.TypeEl)
+          and (rrfReadable in RightResolved.Flags)
+      then
+        begin
+        SetBaseType(btBoolean);
+        exit;
+        end;
+    eopSubIdent:
+      begin
+      ResolvedEl:=RightResolved;
+      exit;
+      end;
+    end
+  else if LeftResolved.BaseType=btSet then
+    begin
+    if (rrfReadable in LeftResolved.Flags)
+        and (RightResolved.BaseType=btSet)
+        and (rrfReadable in RightResolved.Flags) then
+      case Bin.OpCode of
+      eopAdd,
+      eopSubtract,
+      eopMultiply,
+      eopSymmetricaldifference,
+      eopLessthanEqual,
+      eopGreaterThanEqual:
+        begin
+        if RightResolved.TypeEl=nil then
+          begin
+          // right is empty set
+          if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
+            SetBaseType(btBoolean)
+          else
+            begin
+            ResolvedEl:=LeftResolved;
+            ResolvedEl.IdentEl:=nil;
+            ResolvedEl.ExprEl:=Bin;
+            end;
+          exit;
+          end
+        else if LeftResolved.TypeEl=nil then
+          begin
+          // left is empty set
+          if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
+            SetBaseType(btBoolean)
+          else
+            begin
+            ResolvedEl:=RightResolved;
+            ResolvedEl.IdentEl:=nil;
+            ResolvedEl.ExprEl:=Bin;
+            end;
+          exit;
+          end
+        else if (LeftResolved.SubType=RightResolved.SubType)
+            or ((LeftResolved.SubType in btAllBooleans)
+              and (RightResolved.SubType in btAllBooleans))
+            or ((LeftResolved.SubType in btAllInteger)
+              and (RightResolved.SubType in btAllInteger)) then
+          begin
+          // compatible set
+          if Bin.OpCode in [eopLessthanEqual,eopGreaterThanEqual] then
+            SetBaseType(btBoolean)
+          else
+            begin
+            ResolvedEl:=LeftResolved;
+            ResolvedEl.IdentEl:=nil;
+            ResolvedEl.ExprEl:=Bin;
+            end;
+          exit;
+          end;
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ComputeBinaryExpr + - * >< Sets LeftSubType='+BaseTypeNames[LeftResolved.SubType]
+          +' RightSubType='+BaseTypeNames[RightResolved.SubType]);
+        {$ENDIF}
+        end;
+      end;
+    end
+  else if LeftResolved.BaseType=btModule then
+    begin
+    if Bin.OpCode=eopSubIdent then
+      begin
+      ResolvedEl:=RightResolved;
+      exit;
+      end;
+    end;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ComputeBinaryExpr OpCode=',OpcodeStrings[Bin.OpCode],' Kind=',Bin.Kind,' Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
+  {$ENDIF}
+  RaiseMsg(20170216152241,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[Bin.OpCode]],Bin);
+end;
+
+procedure TPasResolver.ComputeArrayParams(Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+
+  procedure ComputeIndexProperty(Prop: TPasProperty);
+  begin
+    if [rcConstant,rcType]*Flags<>[] then
+      RaiseConstantExprExp(20170216152635,Params);
+    ComputeElement(GetPasPropertyType(Prop),ResolvedEl,[rcType],StartEl);
+    ResolvedEl.IdentEl:=Prop;
+    ResolvedEl.Flags:=[];
+    if GetPasPropertyGetter(Prop)<>nil then
+      Include(ResolvedEl.Flags,rrfReadable);
+    if GetPasPropertySetter(Prop)<>nil then
+      Include(ResolvedEl.Flags,rrfWritable);
+  end;
+
+var
+  TypeEl: TPasType;
+  ClassScope: TPasClassScope;
+  ArrayEl: TPasArrayType;
+  ArgNo: Integer;
+  OrigResolved: TPasResolverResult;
+  SubParams: TParamsExpr;
+begin
+  if Params.Value.CustomData is TResolvedReference then
+    begin
+    // e.g. Name[]
+    ComputeElement(Params.Value,ResolvedEl,
+      Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
+    end
+  else if Params.Value.ClassType=TParamsExpr then
+    begin
+    SubParams:=TParamsExpr(Params.Value);
+    if SubParams.Kind in [pekArrayParams,pekFuncParams] then
+      begin
+      // e.g. Name()[] or Name[][]
+      ComputeElement(SubParams,ResolvedEl,
+        Flags-[rcNoImplicitProc,rcNoImplicitProcType],StartEl);
+      end
+    else
+      RaiseNotYetImplemented(20161010195646,SubParams);
+    end
+  else
+    RaiseNotYetImplemented(20160928174144,Params);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ComputeArrayParams ResolvedEl=',GetResolverResultDbg(ResolvedEl));
+  {$ENDIF}
+  if ResolvedEl.BaseType in btAllStrings then
+    begin
+    // stringvar[] => char
+    case GetActualBaseType(ResolvedEl.BaseType) of
+    btWideString,btUnicodeString:
+      if BaseTypeChar=btWideChar then
+        ResolvedEl.BaseType:=btChar
+      else
+        ResolvedEl.BaseType:=btWideChar;
+    btAnsiString,btRawByteString,btShortString:
+      if BaseTypeChar=btAnsiChar then
+        ResolvedEl.BaseType:=btChar
+      else
+        ResolvedEl.BaseType:=btAnsiChar;
+    else
+      RaiseNotYetImplemented(20170417202354,Params);
+    end;
+    // keep ResolvedEl.IdentEl the string var
+    ResolvedEl.TypeEl:=FBaseTypes[ResolvedEl.BaseType];
+    ResolvedEl.ExprEl:=Params;
+    ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable,rrfCanBeStatement]+[rrfAssignable];
+    end
+  else if (ResolvedEl.IdentEl is TPasProperty)
+      and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
+    // property with args
+    ComputeIndexProperty(TPasProperty(ResolvedEl.IdentEl))
+  else if ResolvedEl.BaseType=btContext then
+    begin
+    TypeEl:=ResolvedEl.TypeEl;
+    if TypeEl.ClassType=TPasClassType then
+      begin
+      ClassScope:=TypeEl.CustomData as TPasClassScope;
+      if ClassScope.DefaultProperty<>nil then
+        ComputeIndexProperty(ClassScope.DefaultProperty)
+      else
+        ComputeArrayParams_Class(Params,ResolvedEl,ClassScope,Flags,StartEl);
+      end
+    else if TypeEl.ClassType=TPasClassOfType then
+      begin
+      ClassScope:=TPasClassOfType(TypeEl).DestType.CustomData as TPasClassScope;
+      if ClassScope.DefaultProperty<>nil then
+        ComputeIndexProperty(ClassScope.DefaultProperty)
+      else
+        RaiseInternalError(20161010174916);
+      end
+    else if TypeEl.ClassType=TPasArrayType then
+      begin
+      if not (rrfReadable in ResolvedEl.Flags) then
+        RaiseMsg(20170517001140,nIllegalQualifier,sIllegalQualifier,['['],Params);
+      ArrayEl:=TPasArrayType(TypeEl);
+      ArgNo:=0;
+      repeat
+        if length(ArrayEl.Ranges)=0 then
+          begin
+          inc(ArgNo); // dynamic/open array has one dimension
+          if IsDynArray(ArrayEl) then
+            Include(ResolvedEl.Flags,rrfWritable); // dynamic array elements are writable
+          end
+        else
+          inc(ArgNo,length(ArrayEl.Ranges)); // static array has several dimensions
+        if ArgNo>length(Params.Params) then
+          RaiseInternalError(20161010185535);
+        if ArgNo=length(Params.Params) then
+          break;
+        // continue in sub array
+        ArrayEl:=ResolveAliasType(ArrayEl.ElType) as TPasArrayType;
+      until false;
+      OrigResolved:=ResolvedEl;
+      ComputeElement(ArrayEl.ElType,ResolvedEl,Flags,StartEl);
+      // identifier and value is the array itself
+      ResolvedEl.IdentEl:=OrigResolved.IdentEl;
+      ResolvedEl.ExprEl:=OrigResolved.ExprEl;
+      ResolvedEl.Flags:=OrigResolved.Flags*[rrfReadable,rrfWritable];
+      if IsDynArray(ArrayEl) then
+        // dyn array elements are writable independent of the array
+        Include(ResolvedEl.Flags,rrfWritable);
+      end
+    else
+      RaiseNotYetImplemented(20161010151727,Params,GetResolverResultDbg(ResolvedEl));
+    end
+  else
+    RaiseNotYetImplemented(20160928174212,Params,GetResolverResultDbg(ResolvedEl));
+end;
+
+procedure TPasResolver.ComputeArrayParams_Class(Params: TParamsExpr;
+  var ResolvedEl: TPasResolverResult; ClassScope: TPasClassScope;
+  Flags: TPasResolverComputeFlags; StartEl: TPasElement);
+begin
+  RaiseInternalError(20161010174916);
+  if Params=nil then ;
+  if ClassScope=nil then ;
+  if Flags=[] then ;
+  if StartEl=nil then ;
+  SetResolverIdentifier(ResolvedEl,btNone,nil,nil,[]);
+end;
+
+procedure TPasResolver.ComputeFuncParams(Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+var
+  DeclEl: TPasElement;
+  BuiltInProc: TResElDataBuiltInProc;
+  Proc: TPasProcedure;
+  aClass: TPasClassType;
+  ResolvedTypeEl: TPasResolverResult;
+  Ref: TResolvedReference;
+begin
+  if Params.Value.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(Params.Value.CustomData);
+    DeclEl:=Ref.Declaration;
+    if DeclEl.ClassType=TPasUnresolvedSymbolRef then
+      begin
+      if DeclEl.CustomData.ClassType=TResElDataBuiltInProc then
+        begin
+        BuiltInProc:=TResElDataBuiltInProc(DeclEl.CustomData);
+        if Assigned(BuiltInProc.GetCallResult) then
+          // built in function
+          BuiltInProc.GetCallResult(BuiltInProc,Params,ResolvedEl)
+        else
+          // built in procedure
+          SetResolverIdentifier(ResolvedEl,btProc,BuiltInProc.Proc,BuiltInProc.Proc,[]);
+        if bipfCanBeStatement in BuiltInProc.Flags then
+          Include(ResolvedEl.Flags,rrfCanBeStatement);
+        end
+      else if DeclEl.CustomData is TResElDataBaseType then
+        begin
+        // type cast to base type
+        if TResElDataBaseType(DeclEl.CustomData).BaseType=btCustom then
+          // custom base type
+          SetResolverValueExpr(ResolvedEl,
+            btCustom,
+            TPasUnresolvedSymbolRef(DeclEl),Params.Params[0],[rrfReadable])
+        else
+          SetResolverValueExpr(ResolvedEl,
+            TResElDataBaseType(DeclEl.CustomData).BaseType,
+            TPasUnresolvedSymbolRef(DeclEl),Params.Params[0],[rrfReadable]);
+        end
+      else
+        RaiseNotYetImplemented(20161006133040,Params,GetResolverResultDbg(ResolvedEl));
+      end
+    else
+      begin
+      // normal identifier (not built-in)
+      ComputeElement(DeclEl,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
+      if ResolvedEl.BaseType=btProc then
+        begin
+        if not (ResolvedEl.IdentEl is TPasProcedure) then
+          RaiseNotYetImplemented(20160928180201,Params,GetResolverResultDbg(ResolvedEl));
+        Proc:=TPasProcedure(ResolvedEl.IdentEl);
+        if rcConstant in Flags then
+          RaiseConstantExprExp(20170216152637,Params);
+        if Proc is TPasFunction then
+          // function call => return result
+          ComputeElement(TPasFunction(Proc).FuncType.ResultEl,ResolvedEl,
+            Flags+[rcNoImplicitProc],StartEl)
+        else if (Proc.ClassType=TPasConstructor)
+            and (rrfNewInstance in Ref.Flags) then
+          begin
+          // new instance call -> return value of type class
+          aClass:=GetReference_NewInstanceClass(Ref);
+          SetResolverValueExpr(ResolvedEl,btContext,aClass,Params.Value,[rrfReadable]);
+          end
+        else
+          // procedure call, result is neither readable nor writable
+          SetResolverIdentifier(ResolvedEl,btProc,Proc,Proc.ProcType,[]);
+        Include(ResolvedEl.Flags,rrfCanBeStatement);
+        end
+      else if ResolvedEl.TypeEl is TPasProcedureType then
+        begin
+        if Params.Value is TParamsExpr then
+          begin
+          // e.g. Name()() or Name[]()
+          Include(ResolvedEl.Flags,rrfReadable);
+          end;
+        if rrfReadable in ResolvedEl.Flags then
+          begin
+          // call procvar
+          if rcConstant in Flags then
+            RaiseConstantExprExp(20170216152639,Params);
+          if ResolvedEl.TypeEl is TPasFunctionType then
+            // function call => return result
+            ComputeElement(TPasFunctionType(ResolvedEl.TypeEl).ResultEl,
+              ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
+          else
+            // procedure call, result is neither readable nor writable
+            SetResolverTypeExpr(ResolvedEl,btProc,TPasProcedureType(ResolvedEl.TypeEl),[]);
+          Include(ResolvedEl.Flags,rrfCanBeStatement);
+          end
+        else
+          begin
+          // typecast proctype
+          if length(Params.Params)<>1 then
+            begin
+            {$IFDEF VerbosePasResolver}
+            writeln('TPasResolver.ComputeFuncParams DeclEl=',GetObjName(DeclEl),' ',GetResolverResultDbg(ResolvedEl));
+            {$ENDIF}
+            RaiseMsg(20170416185211,nWrongNumberOfParametersForTypeCast,
+              sWrongNumberOfParametersForTypeCast,[ResolvedEl.TypeEl.Name],Params);
+            end;
+          SetResolverValueExpr(ResolvedEl,btContext,TPasProcedureType(ResolvedEl.TypeEl),
+            Params.Params[0],[rrfReadable]);
+          end;
+        end
+      else if (DeclEl is TPasType) then
+        begin
+        // type cast
+        ResolvedTypeEl:=ResolvedEl;
+        ComputeElement(Params.Params[0],ResolvedEl,Flags,StartEl);
+        ResolvedEl.BaseType:=ResolvedTypeEl.BaseType;
+        ResolvedEl.TypeEl:=ResolvedTypeEl.TypeEl;
+        end
+      else
+        RaiseNotYetImplemented(20160928180048,Params,GetResolverResultDbg(ResolvedEl));
+      end;
+    end
+  else
+    RaiseNotYetImplemented(20160928174124,Params);
+end;
+
+procedure TPasResolver.ComputeSetParams(Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+// [param,param,...]
+var
+  ParamResolved, FirstResolved: TPasResolverResult;
+  i: Integer;
+  Param: TPasExpr;
+  IsRange: Boolean;
+begin
+  if length(Params.Params)=0 then
+    SetResolverValueExpr(ResolvedEl,btSet,nil,Params,[rrfReadable])
+  else
+    begin
+    FirstResolved:=Default(TPasResolverResult);
+    Flags:=Flags-[rcNoImplicitProc,rcNoImplicitProcType];
+    for i:=0 to length(Params.Params)-1 do
+      begin
+      Param:=Params.Params[i];
+      ComputeElement(Params.Params[0],ParamResolved,Flags,StartEl);
+      if ParamResolved.BaseType=btSet then
+        RaiseNotYetImplemented(20170420134325,Param,'nested array literals');
+      IsRange:=ParamResolved.BaseType=btRange;
+      if IsRange then
+        ConvertRangeToFirstValue(ParamResolved);
+      if FirstResolved.BaseType=btNone then
+        begin
+        // first value -> check type usable in a set
+        FirstResolved:=ParamResolved;
+        if IsRange then
+          CheckIsOrdinal(FirstResolved,Param,true);
+        if rrfReadable in FirstResolved.Flags then
+          begin
+          // has a value
+          end
+        else
+          begin
+          if (FirstResolved.BaseType=btContext) then
+            begin
+            if FirstResolved.IdentEl is TPasClassType then
+              // array of classtypes
+            else
+              begin
+              {$IFDEF VerbosePasResolver}
+              writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
+              {$ENDIF}
+              RaiseXExpectedButYFound(20170420002328,'array value','type',Param);
+              end;
+            end
+          else
+            begin
+            {$IFDEF VerbosePasResolver}
+            writeln('TPasResolver.ComputeSetParams ',GetResolverResultDbg(FirstResolved));
+            {$ENDIF}
+            RaiseXExpectedButYFound(20170420002332,'array value','type',Param);
+            end;
+          end;
+        end
+      else
+        begin
+        // next value
+        CombineArrayLitElTypes(Params.Params[0],Param,FirstResolved,ParamResolved);
+        end;
+      end;
+
+    FirstResolved.IdentEl:=nil;
+    if FirstResolved.ExprEl=nil then
+      FirstResolved.ExprEl:=Params;
+    FirstResolved.SubType:=FirstResolved.BaseType;
+    FirstResolved.BaseType:=btSet;
+    FirstResolved.Flags:=[rrfReadable];
+    ResolvedEl:=FirstResolved;
+    end;
+end;
+
+procedure TPasResolver.CheckIsClass(El: TPasElement;
+  const ResolvedEl: TPasResolverResult);
+begin
+  if (ResolvedEl.BaseType<>btContext) then
+    RaiseMsg(20170216152245,nXExpectedButYFound,sXExpectedButYFound,
+      ['class',BaseTypeNames[ResolvedEl.BaseType]],El);
+  if (ResolvedEl.TypeEl.ClassType<>TPasClassType) then
+    RaiseMsg(20170216152246,nXExpectedButYFound,sXExpectedButYFound,
+      ['class',ResolvedEl.TypeEl.ElementTypeName],El);
+end;
+
+function TPasResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
+  ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
+// called when type casting a class instance into an unrelated class
+begin
+  if FromClassRes.BaseType=btNone then ;
+  if ToClassRes.BaseType=btNone then ;
+  if ErrorEl=nil then ;
+  Result:=cIncompatible;
+end;
+
+procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
+  const LHS, RHS: TPasResolverResult);
+var
+  LBT, RBT: TResolverBaseType;
+begin
+  // check both are values
+  if not (rrfReadable in LHS.Flags) then
+    begin
+    if LHS.TypeEl<>nil then
+      RaiseXExpectedButYFound(20170216152645,'ordinal',LHS.TypeEl.ElementTypeName,Left)
+    else
+      RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
+    end;
+  if not (rrfReadable in RHS.Flags) then
+    begin
+    if RHS.TypeEl<>nil then
+      RaiseXExpectedButYFound(20170216152651,'ordinal',RHS.TypeEl.ElementTypeName,Right)
+    else
+      RaiseXExpectedButYFound(20170216152653,'ordinal',BaseTypeNames[RHS.BaseType],Right);
+    end;
+  // check both have the same ordinal type
+  LBT:=GetActualBaseType(LHS.BaseType);
+  RBT:=GetActualBaseType(RHS.BaseType);
+  if LBT in btAllBooleans then
+    begin
+    if RBT in btAllBooleans then
+      exit;
+    RaiseXExpectedButYFound(20170216152656,'boolean',BaseTypeNames[RHS.BaseType],Right);
+    end
+  else if LBT in btAllInteger then
+    begin
+    if RBT in btAllInteger then
+      exit;
+    RaiseXExpectedButYFound(20170216152658,'integer',BaseTypeNames[RHS.BaseType],Right);
+    end
+  else if LBT in btAllChars then
+    begin
+    if RBT in btAllChars then
+      exit;
+    RaiseXExpectedButYFound(20170216152702,'char',BaseTypeNames[RHS.BaseType],Right);
+    end
+  else if LBT=btContext then
+    begin
+    if LHS.TypeEl.ClassType=TPasEnumType then
+      begin
+      if LHS.TypeEl=RHS.TypeEl then
+        exit;
+      if RHS.TypeEl.ClassType<>TPasEnumType then
+        RaiseXExpectedButYFound(20170216152707,LHS.TypeEl.Parent.Name,RHS.TypeEl.ElementTypeName,Right);
+      if LHS.TypeEl.Parent<>RHS.TypeEl.Parent then
+        RaiseXExpectedButYFound(20170216152710,LHS.TypeEl.Parent.Name,RHS.TypeEl.Parent.Name,Right);
+      end
+    else
+      RaiseXExpectedButYFound(20170216152712,'ordinal',BaseTypeNames[LHS.BaseType],Left);
+    end
+  else
+    RaiseXExpectedButYFound(20170216152714,'ordinal',BaseTypeNames[LHS.BaseType],Left);
+end;
+
+function TPasResolver.CheckIsOrdinal(
+  const ResolvedEl: TPasResolverResult; ErrorEl: TPasElement;
+  RaiseOnError: boolean): boolean;
+begin
+  Result:=false;
+  if ResolvedEl.BaseType in (btAllInteger+btAllBooleans+[btChar]) then
+  else if (ResolvedEl.BaseType=btContext) then
+    begin
+    if ResolvedEl.TypeEl.ClassType=TPasEnumType then
+    else if RaiseOnError then
+      RaiseXExpectedButYFound(20170216152718,'ordinal value',ResolvedEl.TypeEl.ElementTypeName,ErrorEl)
+    else
+      exit;
+    end
+  else if RaiseOnError then
+    RaiseXExpectedButYFound(20170216152720,'ordinal value',BaseTypeNames[ResolvedEl.BaseType],ErrorEl)
+  else
+    exit;
+  Result:=true;
+end;
+
+procedure TPasResolver.CombineArrayLitElTypes(Left, Right: TPasExpr;
+  var LHS: TPasResolverResult; const RHS: TPasResolverResult);
+// LHS defines the array element type
+// check if RHS
+var
+  LBT, RBT: TResolverBaseType;
+  C: TClass;
+begin
+  if LHS.TypeEl=nil then
+    RaiseXExpectedButYFound(20170420004537,'array element',BaseTypeNames[LHS.BaseType],Left);
+  if RHS.TypeEl=nil then
+    RaiseXExpectedButYFound(20170420004602,'array element',BaseTypeNames[RHS.BaseType],Right);
+
+  if LHS.TypeEl=RHS.TypeEl then
+    exit; // exact same type
+
+  LBT:=GetActualBaseType(LHS.BaseType);
+  RBT:=GetActualBaseType(RHS.BaseType);
+  if rrfReadable in LHS.Flags then
+    begin
+    if not (rrfReadable in RHS.Flags) then
+      RaiseIncompatibleTypeRes(20170420004759,nIncompatibleTypesGotExpected,
+        [],RHS,LHS,Right);
+    // array of values
+    if LBT in btAllBooleans then
+      begin
+      if RBT in btAllBooleans then
+        begin
+        LHS.BaseType:=GetCombinedBoolean(LBT,RBT,Right);
+        exit;
+        end;
+      RaiseXExpectedButYFound(20170420093015,'boolean',BaseTypeNames[RHS.BaseType],Right);
+      end
+    else if LBT in btAllInteger then
+      begin
+      if RBT in btAllInteger then
+        begin
+        LHS.BaseType:=GetCombinedInt(LHS,RHS,Right);
+        exit;
+        end;
+      RaiseXExpectedButYFound(20170420093019,'integer',BaseTypeNames[RHS.BaseType],Right);
+      end
+    else if LBT in btAllChars then
+      begin
+      if RBT in btAllChars then
+        begin
+        LHS.BaseType:=GetCombinedChar(LHS,RHS,Right);
+        exit;
+        end;
+      RaiseXExpectedButYFound(20170420093024,'char',BaseTypeNames[RHS.BaseType],Right);
+      end
+    else if LBT in btAllStrings then
+      begin
+      if RBT in btAllStringAndChars then
+        begin
+        LHS.BaseType:=GetCombinedString(LHS,RHS,Right);
+        exit;
+        end;
+      RaiseXExpectedButYFound(20170420102832,'string',BaseTypeNames[RHS.BaseType],Right);
+      end
+    else if LBT=btNil then
+      begin
+      if RBT=btNil then
+        exit
+      else if RBT=btPointer then
+        begin
+        LHS:=RHS;
+        exit;
+        end
+      else if RBT=btContext then
+       begin
+       C:=RHS.TypeEl.ClassType;
+       if (C=TPasClassType)
+           or (C=TPasClassOfType)
+           or (C=TPasPointerType)
+           or ((C=TPasArrayType) and IsDynArray(RHS.TypeEl))
+           or (C=TPasProcedureType)
+           or (C=TPasFunctionType) then
+         begin
+         LHS:=RHS;
+         exit;
+         end;
+       end;
+      end
+    else if LBT=btContext then
+      begin
+      C:=LHS.TypeEl.ClassType;
+      if C=TPasEnumType then
+        begin
+        if LHS.TypeEl=RHS.TypeEl then
+          exit;
+        end
+      else if C=TPasClassType then
+        begin
+        // array of class instances
+        if RHS.TypeEl.ClassType<>TPasClassType then
+          RaiseIncompatibleTypeRes(20170420135637,nIncompatibleTypesGotExpected,
+            [],RHS,LHS,Right);
+        if CheckClassIsClass(LHS.TypeEl,RHS.TypeEl,Right)<cIncompatible then
+          begin
+          // right class type is a left class type -> ok
+          exit;
+          end
+        else if CheckClassIsClass(RHS.TypeEl,LHS.TypeEl,Right)<cIncompatible then
+          begin
+          // left class type is a right class type -> right is the new base class type
+          LHS:=RHS;
+          exit;
+          end;
+        end;
+      end;
+    end
+  else
+    begin
+    // array of types
+    if rrfReadable in RHS.Flags then
+      RaiseIncompatibleTypeRes(20170420004925,nIncompatibleTypesGotExpected,
+        [],RHS,LHS,Right);
+    if LBT=btContext then
+      begin
+      if LHS.TypeEl.ClassType=TPasClassType then
+        begin
+        // array of class type
+        if RHS.TypeEl.ClassType<>TPasClassType then
+          RaiseIncompatibleTypeRes(20170420091839,nIncompatibleTypesGotExpected,
+            [],RHS,LHS,Right);
+        if CheckClassIsClass(LHS.TypeEl,RHS.TypeEl,Right)<cIncompatible then
+          begin
+          // right class type is a left class type -> ok
+          exit;
+          end
+        else if CheckClassIsClass(RHS.TypeEl,LHS.TypeEl,Right)<cIncompatible then
+          begin
+          // left class type is a right class type -> right is the new base class type
+          LHS:=RHS;
+          exit;
+          end;
+        end;
+      end;
+    end;
+  RaiseIncompatibleTypeRes(20170420092625,nIncompatibleTypesGotExpected,
+    [],RHS,LHS,Right);
+end;
+
+procedure TPasResolver.ConvertRangeToFirstValue(
+  var ResolvedEl: TPasResolverResult);
+begin
+  if ResolvedEl.BaseType<>btRange then
+    RaiseInternalError(20161001155732);
+  if ResolvedEl.TypeEl=nil then
+    if ResolvedEl.IdentEl<>nil then
+      RaiseNotYetImplemented(20161001155747,ResolvedEl.IdentEl)
+    else
+      RaiseNotYetImplemented(20161001155834,ResolvedEl.ExprEl);
+  ResolvedEl.BaseType:=ResolvedEl.SubType;
+  ResolvedEl.SubType:=btNone;
+end;
+
+function TPasResolver.IsCharLiteral(const Value: string): boolean;
+var
+  p: PChar;
+begin
+  Result:=false;
+  p:=PChar(Value);
+  if (p^='''') then
+    begin
+    inc(p);
+    if p^ in [#32..#196] then
+      begin
+      inc(p);
+      if p^='''' then
+        exit(true);
+      end;
+    end;
+end;
+
+function TPasResolver.CheckBuiltInMinParamCount(Proc: TResElDataBuiltInProc;
+  Expr: TPasExpr; MinCount: integer; RaiseOnError: boolean): boolean;
+begin
+  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)<MinCount) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170216152248,nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[Proc.Signature],Expr);
+    exit(false);
+    end;
+  Result:=true;
+end;
+
+function TPasResolver.CheckBuiltInMaxParamCount(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; MaxCount: integer; RaiseOnError: boolean): integer;
+begin
+  if length(Params.Params)>MaxCount then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170329154348,nWrongNumberOfParametersForCallTo,
+        sWrongNumberOfParametersForCallTo,[Proc.Signature],Params.Params[MaxCount]);
+    exit(cIncompatible);
+    end;
+
+  Result:=cExact;
+end;
+
+function TPasResolver.CheckRaiseTypeArgNo(id: int64; ArgNo: integer;
+  Param: TPasExpr; const ParamResolved: TPasResolverResult; Expected: string;
+  RaiseOnError: boolean): integer;
+begin
+  if RaiseOnError then
+    RaiseMsg(id,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+      [IntToStr(ArgNo),GetResolverResultDescription(ParamResolved,true),Expected],Param);
+  Result:=cIncompatible;
+end;
+
+procedure TPasResolver.OnExprEvalLog(Sender: TResExprEvaluator;
+  const id: int64; MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const; PosEl: TPasElement);
+begin
+  if MsgType<=mtError then
+    RaiseMsg(id,MsgNumber,Fmt,Args,PosEl)
+  else
+    LogMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
+  if Sender=nil then ;
+end;
+
+function TPasResolver.OnExprEvalIdentifier(Sender: TResExprEvaluator;
+  Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue;
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+  C: TClass;
+  BaseTypeData: TResElDataBaseType;
+begin
+  Result:=nil;
+  if not (Expr.CustomData is TResolvedReference) then
+    RaiseNotYetImplemented(20170518203134,Expr);
+  Ref:=TResolvedReference(Expr.CustomData);
+  Decl:=Ref.Declaration;
+  C:=Decl.ClassType;
+  if C=TPasConst then
+    begin
+    if (TPasConst(Decl).Expr<>nil)
+        and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
+      begin
+      Result:=fExprEvaluator.Eval(TPasConst(Decl).Expr,Flags);
+      if Result<>nil then
+        begin
+        Result.IdentEl:=Decl;
+        exit;
+        end;
+      end;
+    if refConst in Flags then
+      RaiseConstantExprExp(20170518214928,Expr);
+    end
+  else if C.InheritsFrom(TPasType) then
+    begin
+    Decl:=ResolveAliasType(TPasType(Decl));
+    C:=Decl.ClassType;
+    if C=TPasRangeType then
+      begin
+      Result:=fExprEvaluator.Eval(TPasRangeType(Decl).RangeExpr,Flags);
+      if Result<>nil then
+        begin
+        Result.IdentEl:=Ref.Declaration;
+        exit;
+        end;
+      end
+    else if C=TPasUnresolvedSymbolRef then
+      begin
+      if (Decl.CustomData is TResElDataBaseType) then
+        begin
+        BaseTypeData:=TResElDataBaseType(Decl.CustomData);
+        case BaseTypeData.BaseType of
+        btChar:
+          begin
+          Result:=TResEvalRangeInt.Create;
+          TResEvalRangeInt(Result).ElKind:=revrikChar;
+          TResEvalRangeInt(Result).RangeStart:=0;
+          if BaseTypeChar=btChar then
+            TResEvalRangeInt(Result).RangeEnd:=$ff
+          else
+            TResEvalRangeInt(Result).RangeEnd:=$ffff;
+          end;
+        btAnsiChar:
+          Result:=TResEvalRangeInt.CreateValue(revrikChar,0,$ff);
+        btWideChar:
+          Result:=TResEvalRangeInt.CreateValue(revrikChar,0,$ffff);
+        btBoolean,btByteBool,btWordBool,btQWordBool:
+          Result:=TResEvalRangeInt.CreateValue(revrikBool,0,1);
+        btByte,
+        btShortInt,
+        btWord,
+        btSmallInt,
+        btLongWord,
+        btLongint,
+        btInt64,
+        btComp,
+        btIntSingle,
+        btUIntSingle,
+        btIntDouble,
+        btUIntDouble:
+          begin
+          Result:=TResEvalRangeInt.Create;
+          TResEvalRangeInt(Result).ElKind:=revrikInt;
+          GetIntegerRange(BaseTypeData.BaseType,
+            TResEvalRangeInt(Result).RangeStart,TResEvalRangeInt(Result).RangeEnd);
+          end;
+        end;
+        end;
+      end;
+    end;
+  if refConst in Flags then
+    RaiseConstantExprExp(20170518213616,Expr);
+end;
+
+function TPasResolver.OnExprEvalParams(Sender: TResExprEvaluator;
+  Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+  C: TClass;
+  BuiltInProc: TResElDataBuiltInProc;
+begin
+  Result:=nil;
+  if Params.Value.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(Params.Value.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl is TPasType then
+      Decl:=ResolveAliasType(TPasType(Decl));
+    C:=Decl.ClassType;
+
+    if C=TPasUnresolvedSymbolRef then
+      begin
+      if Decl.CustomData is TResElDataBuiltInProc then
+        begin
+        BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasResolver.OnExprEvalParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+        {$ENDIF}
+        case BuiltInProc.BuiltIn of
+          bfLength: BI_Length_OnEval(BuiltInProc,Params,Result);
+          bfLow,bfHigh: BI_LowHigh_OnEval(BuiltInProc,Params,Result);
+        end;
+        end;
+      end;
+    end;
+  if Flags=[] then ;
+end;
+
+function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
+  Store: boolean): TResEvalValue;
+// Important: Caller must free result if (Result<>nil) and (Result.Element=nil)
+//            use utility function ReleaseEvalValue(Result)
+begin
+  {$IFNDEF EnablePasResRangeCheck}
+  exit(nil);
+  {$ENDIF}
+  Result:=fExprEvaluator.Eval(Expr,Flags);
+  if Result=nil then exit;
+
+  if Store
+      and (Expr.CustomData=nil)
+      and (Result.Element=nil)
+      and (not fExprEvaluator.IsSimpleExpr(Expr)) then
+    AddResolveData(Expr,Result,lkModule);
+end;
+
+function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
+  var Handled: boolean): integer;
+// called when LHS or RHS BaseType is btCustom
+// if RaiseOnIncompatible=true you can raise an useful error.
+begin
+  Result:=cIncompatible;
+  if LHS.BaseType=btNone then ;
+  if RHS.BaseType=btNone then ;
+  if ErrorEl=nil then ;
+  if RaiseOnIncompatible then ;
+  if Handled then ;
+end;
+
+function TPasResolver.CheckEqualCompatibilityCustomType(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+begin
+  Result:=cIncompatible;
+  if LHS.BaseType=RHS.BaseType then;
+  if ErrorEl=nil then;
+  if RaiseOnIncompatible then ;
+end;
+
+function TPasResolver.BI_Length_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'length'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: string or dynamic array
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if rrfReadable in ParamResolved.Flags then
+    begin
+    if ParamResolved.BaseType in btAllStringAndChars then
+      Result:=cExact
+    else if ParamResolved.BaseType=btContext then
+      begin
+      if (ParamResolved.TypeEl.ClassType=TPasArrayType) then
+        Result:=cExact;
+      end;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170329160335,1,Param,ParamResolved,
+      'string or array',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_Length_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  if Params=nil then ;
+  SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
+    FBaseTypes[BaseTypeLength],[rrfReadable]);
+end;
+
+procedure TPasResolver.BI_Length_OnEval(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out Evaluated: TResEvalValue);
+var
+  Value: TResEvalValue;
+begin
+  Evaluated:=nil;
+  Value:=Eval(Params.Params[0],[refAutoConst]);
+  if Value=nil then exit;
+  if Value.Kind=revkString then
+    begin
+    Evaluated:=TResEvalInt.Create;
+    TResEvalInt(Evaluated).Int:=length(TResEvalString(Value).S);
+    end
+  else if Value.Kind=revkUnicodeString then
+    begin
+    Evaluated:=TResEvalInt.Create;
+    TResEvalInt(Evaluated).Int:=length(TResEvalUTF16(Value).S);
+    end;
+  ReleaseEvalValue(Value);
+  if Proc=nil then ;
+end;
+
+function TPasResolver.BI_SetLength_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'setlength'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: string or array variable
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  Result:=cIncompatible;
+  if ResolvedElCanBeVarParam(ParamResolved) then
+    begin
+    if ParamResolved.BaseType in btAllStrings then
+      Result:=cExact
+    else if ParamResolved.BaseType=btContext then
+      begin
+      if IsDynArray(ParamResolved.TypeEl) then
+        Result:=cExact;
+      end;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152250,1,Param,ParamResolved,
+      'string or dynamic array variable',RaiseOnError));
+
+  // second param: new length
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if (rrfReadable in ParamResolved.Flags)
+      and (ParamResolved.BaseType in btAllInteger) then
+    Result:=cExact;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170329160338,2,Param,ParamResolved,
+      'integer',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_SetLength_OnFinishParamsExpr(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  AccessExpr(P[0],rraVarParam);
+  AccessExpr(P[1],rraRead);
+end;
+
+function TPasResolver.BI_InExclude_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'include'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  EnumType: TPasEnumType;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: variable of set of enumtype
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  EnumType:=nil;
+  if ([rrfReadable,rrfWritable]*ParamResolved.Flags=[rrfReadable,rrfWritable])
+      and ((ParamResolved.IdentEl is TPasVariable)
+        or (ParamResolved.IdentEl is TPasArgument)) then
+    begin
+    if (ParamResolved.BaseType=btSet)
+        and (ParamResolved.TypeEl is TPasEnumType) then
+      EnumType:=TPasEnumType(ParamResolved.TypeEl);
+    end;
+  if EnumType=nil then
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.OnGetCallCompatibility_InExclude ',GetResolverResultDbg(ParamResolved));
+    {$ENDIF}
+    exit(CheckRaiseTypeArgNo(20170216152301,1,Param,ParamResolved,
+      'variable of set of enumtype',RaiseOnError));
+    end;
+
+  // second param: enum
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  if (not (rrfReadable in ParamResolved.Flags))
+      or (ParamResolved.TypeEl<>EnumType) then
+    begin
+    if RaiseOnError then
+      RaiseIncompatibleType(20170216152302,nIncompatibleTypeArgNo,
+        ['2'],ParamResolved.TypeEl,EnumType,Param);
+    exit(cIncompatible);
+    end;
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_InExclude_OnFinishParamsExpr(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  AccessExpr(P[0],rraVarParam);
+  AccessExpr(P[1],rraRead);
+end;
+
+function TPasResolver.BI_Break_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+  Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+begin
+  if GetLoop(Expr)=nil then
+    RaiseMsg(20170216152306,nMustBeInsideALoop,sMustBeInsideALoop,['Break'],Expr);
+  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
+    exit(cExact);
+  Params:=TParamsExpr(Expr);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnGetCallCompatibility_Break Params=',length(Params.Params));
+  {$ENDIF}
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
+end;
+
+function TPasResolver.BI_Continue_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+begin
+  if GetLoop(Expr)=nil then
+    RaiseMsg(20170216152309,nMustBeInsideALoop,sMustBeInsideALoop,['Continue'],Expr);
+  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
+    exit(cExact);
+  Params:=TParamsExpr(Expr);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnGetCallCompatibility_Continue Params=',length(Params.Params));
+  {$ENDIF}
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,0,RaiseOnError);
+end;
+
+function TPasResolver.BI_Exit_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+  Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved, ResultResolved: TPasResolverResult;
+  i: Integer;
+  ProcScope: TPasProcedureScope;
+  ResultEl: TPasResultElement;
+  Flags: TPasResolverComputeFlags;
+begin
+  if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
+    exit(cExact);
+  Params:=TParamsExpr(Expr);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnGetCallCompatibility_Exit Params=',length(Params.Params));
+  {$ENDIF}
+
+  // first param: result
+  Param:=Params.Params[0];
+  Result:=cIncompatible;
+  i:=ScopeCount-1;
+  while (i>0) and (not (Scopes[i] is TPasProcedureScope)) do dec(i);
+  if i>0 then
+    begin
+    // first param is function result
+    ProcScope:=TPasProcedureScope(Scopes[i]);
+    if not (ProcScope.Element is TPasFunction) then
+      begin
+      if RaiseOnError then
+        RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
+      exit(cIncompatible);
+      end;
+    ResultEl:=(ProcScope.Element as TPasFunction).FuncType.ResultEl;
+    ComputeElement(ResultEl,ResultResolved,[rcType]);
+    end
+  else
+    begin
+    // default: main program, param is an integer
+    SetResolverTypeExpr(ResultResolved,btLongint,FBaseTypes[btLongint],[rrfReadable,rrfWritable]);
+    end;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnGetCallCompatibility_Exit ResultResolved=',GetResolverResultDbg(ResultResolved));
+  {$ENDIF}
+
+  Flags:=[];
+  if IsProcedureType(ResultResolved,true) then
+    Include(Flags,rcNoImplicitProc);
+  ComputeElement(Param,ParamResolved,Flags);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnGetCallCompatibility_Exit ParamResolved=',GetResolverResultDbg(ParamResolved));
+  {$ENDIF}
+
+  if rrfReadable in ParamResolved.Flags then
+    Result:=CheckAssignResCompatibility(ResultResolved,ParamResolved,Param,false);
+  if Result=cIncompatible then
+    begin
+    if RaiseOnError then
+      RaiseIncompatibleTypeRes(20170216152314,nIncompatibleTypeArgNo,
+        ['1'],ParamResolved,ResultResolved,Param);
+    exit;
+    end;
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+function TPasResolver.BI_IncDec_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved, IncrResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: var Integer
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.OnGetCallCompatibility_IncDec ParamResolved=',GetResolverResultDbg(ParamResolved));
+  {$ENDIF}
+  Result:=cIncompatible;
+  // Expr must be a variable
+  if not ResolvedElCanBeVarParam(ParamResolved) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170216152319,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
+    exit;
+    end;
+  if ParamResolved.BaseType in btAllInteger then
+    Result:=cExact;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152320,1,Param,ParamResolved,'integer',RaiseOnError));
+
+  if length(Params.Params)=1 then
+    exit;
+
+  // second param: increment/decrement
+  Param:=Params.Params[1];
+  ComputeElement(Param,IncrResolved,[]);
+  Result:=cIncompatible;
+  if rrfReadable in IncrResolved.Flags then
+    begin
+    if IncrResolved.BaseType in btAllInteger then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152322,2,Param,IncrResolved,'integer',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_IncDec_OnFinishParamsExpr(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  AccessExpr(P[0],rraVarParam);
+  if Length(P)>1 then
+    AccessExpr(P[1],rraRead);
+end;
+
+function TPasResolver.BI_Assigned_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'Assigned'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  C: TClass;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: pointer, class, class instance, proc type or array
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
+  Result:=cIncompatible;
+  if ParamResolved.BaseType in [btNil,btPointer] then
+    Result:=cExact
+  else if (ParamResolved.BaseType=btContext) then
+    begin
+    C:=ParamResolved.TypeEl.ClassType;
+    if (C=TPasClassType)
+        or (C=TPasClassOfType)
+        or C.InheritsFrom(TPasProcedureType)
+        or ((C=TPasArrayType) and (length(TPasArrayType(ParamResolved.TypeEl).Ranges)=0)) then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152329,1,Param,ParamResolved,'class or array',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_Assigned_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  SetResolverIdentifier(ResolvedEl,btBoolean,Proc.Proc,FBaseTypes[btBoolean],[rrfReadable]);
+end;
+
+function TPasResolver.BI_Chr_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: integer
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if rrfReadable in ParamResolved.Flags then
+    begin
+    if ParamResolved.BaseType in btAllInteger then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170325185321,1,Param,ParamResolved,'integer',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_Chr_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  SetResolverIdentifier(ResolvedEl,btChar,Proc.Proc,FBaseTypes[btChar],[rrfReadable]);
+end;
+
+function TPasResolver.BI_Ord_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+  Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: enum or char
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if rrfReadable in ParamResolved.Flags then
+    begin
+    if ParamResolved.BaseType=btChar then
+      Result:=cExact
+    else if (ParamResolved.BaseType=btContext) and (ParamResolved.TypeEl is TPasEnumType) then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152334,1,Param,ParamResolved,'enum or char',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_Ord_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  SetResolverIdentifier(ResolvedEl,btSmallInt,Proc.Proc,FBaseTypes[btSmallInt],[rrfReadable]);
+end;
+
+function TPasResolver.BI_LowHigh_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'Low' or 'High'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  TypeEl: TPasType;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: enum, range or char
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if CheckIsOrdinal(ParamResolved,Param,false) then
+    Result:=cExact
+  else if ParamResolved.BaseType=btSet then
+    Result:=cExact
+  else if (ParamResolved.BaseType=btContext) then
+    begin
+    TypeEl:=ParamResolved.TypeEl;
+    if (TypeEl.ClassType=TPasArrayType)
+        or (TypeEl.ClassType=TPasSetType) then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152338,1,Param,ParamResolved,'enum or char',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_LowHigh_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+var
+  ArrayEl: TPasArrayType;
+  Param: TPasExpr;
+  TypeEl: TPasType;
+begin
+  Param:=Params.Params[0];
+  ComputeElement(Param,ResolvedEl,[]);
+  if ResolvedEl.BaseType=btContext then
+    begin
+    TypeEl:=ResolvedEl.TypeEl;
+    if TypeEl.ClassType=TPasArrayType then
+      begin
+      // array: result type is type of first dimension
+      ArrayEl:=TPasArrayType(TypeEl);
+      if length(ArrayEl.Ranges)=0 then
+        SetResolverIdentifier(ResolvedEl,BaseTypeLength,Proc.Proc,
+          FBaseTypes[BaseTypeLength],[rrfReadable])
+      else
+        begin
+        ComputeElement(ArrayEl.Ranges[0],ResolvedEl,[rcConstant]);
+        if ResolvedEl.BaseType=btRange then
+          ConvertRangeToFirstValue(ResolvedEl);
+        end;
+      end
+    else if TypeEl.ClassType=TPasSetType then
+      begin
+      ResolvedEl.TypeEl:=TPasSetType(TypeEl).EnumType;
+      end;
+    end
+  else if ResolvedEl.BaseType=btSet then
+    begin
+    ResolvedEl.BaseType:=ResolvedEl.SubType;
+    ResolvedEl.SubType:=btNone;
+    end
+  else
+    ;// ordinal: result type is argument type
+  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
+end;
+
+procedure TPasResolver.BI_LowHigh_OnEval(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out Evaluated: TResEvalValue);
+var
+  Param: TPasExpr;
+  ResolvedEl: TPasResolverResult;
+
+  procedure EvalRange(RangeExpr: TPasExpr);
+  var
+    Range: TResEvalValue;
+    EnumType: TPasEnumType;
+  begin
+    Range:=Eval(RangeExpr,[refConst]);
+    if Range=nil then
+      RaiseNotYetImplemented(20170601191258,RangeExpr);
+    case Range.Kind of
+    revkRangeInt:
+      case TResEvalRangeInt(Range).ElKind of
+        revrikBool:
+          if Proc.BuiltIn=bfLow then
+            Evaluated:=TResEvalBool.CreateValue(low(Boolean))
+          else
+            Evaluated:=TResEvalBool.CreateValue(high(Boolean));
+        revrikEnum:
+          begin
+          EnumType:=TResEvalRangeInt(Range).IdentEl as TPasEnumType;
+          if Proc.BuiltIn=bfLow then
+            Evaluated:=TResEvalEnum.CreateValue(
+              TResEvalRangeInt(Range).RangeStart,TPasEnumValue(EnumType.Values[0]))
+          else
+            Evaluated:=TResEvalEnum.CreateValue(
+              TResEvalRangeInt(Range).RangeEnd,
+              TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
+          end;
+        revrikInt:
+          if Proc.BuiltIn=bfLow then
+            Evaluated:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeStart)
+          else
+            Evaluated:=TResEvalInt.CreateValue(TResEvalRangeInt(Range).RangeEnd);
+        revrikChar:
+          if Proc.BuiltIn=bfLow then
+            Evaluated:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeStart))
+          else if TResEvalRangeInt(Range).RangeEnd<256 then
+            Evaluated:=TResEvalString.CreateValue(chr(TResEvalRangeInt(Range).RangeEnd))
+          else
+            Evaluated:=TResEvalUTF16.CreateValue(widechar(TResEvalRangeInt(Range).RangeEnd));
+      else
+        RaiseNotYetImplemented(20170601195240,Param);
+      end;
+    revkRangeUInt:
+      if Proc.BuiltIn=bfLow then
+        Evaluated:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeStart)
+      else
+        Evaluated:=TResEvalUInt.CreateValue(TResEvalRangeUInt(Range).RangeEnd);
+    else
+      RaiseNotYetImplemented(20170601195336,Params);
+    end;
+  end;
+
+var
+  TypeEl: TPasType;
+  ArrayEl: TPasArrayType;
+  Value: TResEvalValue;
+  EnumType: TPasEnumType;
+  aSet: TResEvalSetInt;
+  Int: MaxPrecInt;
+  bt: TResolverBaseType;
+  MinInt, MaxInt: int64;
+begin
+  Evaluated:=nil;
+  Param:=Params.Params[0];
+  ComputeElement(Param,ResolvedEl,[]);
+  TypeEl:=ResolvedEl.TypeEl;
+  if ResolvedEl.BaseType=btContext then
+    begin
+    if TypeEl.ClassType=TPasArrayType then
+      begin
+      // array: result is first dimension
+      ArrayEl:=TPasArrayType(TypeEl);
+      if length(ArrayEl.Ranges)=0 then
+        begin
+        // dyn or open array
+        if Proc.BuiltIn=bfLow then
+          Evaluated:=TResEvalInt.CreateValue(0)
+        else if (ResolvedEl.IdentEl is TPasVariable)
+            and (TPasVariable(ResolvedEl.IdentEl).Expr is TPasExpr) then
+          begin
+          RaiseNotYetImplemented(20170601191003,Params);
+          end
+        else
+          exit;
+        end
+      else
+        begin
+        // static array
+        EvalRange(ArrayEl.Ranges[0]);
+        end;
+      end
+    else if TypeEl.ClassType=TPasSetType then
+      begin
+      TypeEl:=TPasSetType(TypeEl).EnumType;
+      if TypeEl.ClassType=TPasEnumType then
+        begin
+        EnumType:=TPasEnumType(TPasSetType(TypeEl).EnumType);
+        if Proc.BuiltIn=bfLow then
+          Evaluated:=TResEvalEnum.CreateValue(0,TPasEnumValue(EnumType.Values[0]))
+        else
+          Evaluated:=TResEvalEnum.CreateValue(EnumType.Values.Count-1,
+            TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]));
+        end
+      else
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ResolvedEl),' TypeEl=',TypeEl.ClassName);
+        {$ENDIF}
+        RaiseNotYetImplemented(20170601203026,Params);
+        end;
+      end;
+    end
+  else if ResolvedEl.BaseType=btSet then
+    begin
+    Value:=Eval(Param,[refAutoConst]);
+    if Value=nil then exit;
+    case Value.Kind of
+    revkSetOfInt:
+      begin
+      aSet:=TResEvalSetInt(Value);
+      if length(aSet.Ranges)=0 then
+        RaiseXExpectedButYFound(20170601201637,'ordinal value',Value.AsString,Param);
+      if Proc.BuiltIn=bfLow then
+        Int:=aSet.Ranges[0].RangeStart
+      else
+        Int:=aSet.Ranges[length(aSet.Ranges)-1].RangeEnd;
+      case aSet.ElKind of
+        revsikEnum:
+          begin
+          EnumType:=aSet.IdentEl as TPasEnumType;
+          Evaluated:=TResEvalEnum.CreateValue(Int,TPasEnumValue(EnumType.Values[Int]));
+          end;
+        revsikInt:
+          Evaluated:=TResEvalInt.CreateValue(Int);
+        revsikChar:
+          if Int<256 then
+            Evaluated:=TResEvalString.CreateValue(chr(Int))
+          else
+            Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
+        revsikWChar:
+          Evaluated:=TResEvalUTF16.CreateValue(widechar(Int));
+      end;
+      end;
+    else
+      RaiseXExpectedButYFound(20170601201237,'ordinal value',Value.AsString,Param);
+    end;
+    end
+  else if (TypeEl is TPasUnresolvedSymbolRef)
+      and (TypeEl.CustomData is TResElDataBaseType) then
+    begin
+    // low,high(base type)
+    bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
+    bt:=GetActualBaseType(bt);
+    if bt in btAllBooleans then
+      Evaluated:=TResEvalBool.CreateValue(Proc.BuiltIn=bfHigh)
+    else if bt=btQWord then
+      begin
+      if Proc.BuiltIn=bfLow then
+        Evaluated:=TResEvalInt.CreateValue(0)
+      else
+        Evaluated:=TResEvalUInt.CreateValue(High(QWord));
+      end
+    else if (bt in (btAllInteger-[btQWord])) and GetIntegerRange(bt,MinInt,MaxInt) then
+      begin
+      if Proc.BuiltIn=bfLow then
+        Evaluated:=TResEvalInt.CreateValue(MinInt)
+      else
+        Evaluated:=TResEvalInt.CreateValue(MaxInt);
+      end
+    else if bt in [btChar,btAnsiChar] then
+      begin
+      if Proc.BuiltIn=bfLow then
+        Evaluated:=TResEvalString.CreateValue(#0)
+      else
+        Evaluated:=TResEvalString.CreateValue(#255);
+      end
+    else if bt=btWideChar then
+      begin
+      if Proc.BuiltIn=bfLow then
+        Evaluated:=TResEvalUTF16.CreateValue(#0)
+      else
+        Evaluated:=TResEvalUTF16.CreateValue(#$ffff);
+      end
+    else
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ResolvedEl));
+      {$ENDIF}
+      RaiseNotYetImplemented(20170602070738,Params);
+      end;
+    end
+  else if ResolvedEl.TypeEl is TPasRangeType then
+    begin
+    // e.g. type t = 2..10;
+    EvalRange(TPasRangeType(TypeEl).RangeExpr);
+    end
+  else
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.BI_LowHigh_OnEval ',GetResolverResultDbg(ResolvedEl));
+    {$ENDIF}
+    RaiseNotYetImplemented(20170601202353,Params);
+    end;
+  {$IFDEF VerbosePasResEval}
+  if Evaluated=nil then
+    writeln('TPasResolver.BI_LowHigh_OnEval ResolvedEl=',GetResolverResultDbg(ResolvedEl),' Evaluated NO SET')
+  else
+    writeln('TPasResolver.BI_LowHigh_OnEval ResolvedEl=',GetResolverResultDbg(ResolvedEl),' Evaluated=',Evaluated.AsDebugString);
+  {$ENDIF}
+end;
+
+function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built in proc 'Pred' or 'Succ'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+
+  // first param: enum, range, set, char or integer
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if CheckIsOrdinal(ParamResolved,Param,false) then
+    Result:=cExact;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170216152343,1,Param,ParamResolved,'ordinal',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_PredSucc_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  ComputeElement(Params.Params[0],ResolvedEl,[]);
+  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
+end;
+
+procedure TPasResolver.BI_PredSucc_OnEval(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out Evaluated: TResEvalValue);
+begin
+
+end;
+
+function TPasResolver.BI_Str_CheckParam(IsFunc: boolean; Param: TPasExpr;
+  const ParamResolved: TPasResolverResult; ArgNo: integer; RaiseOnError: boolean
+  ): integer;
+
+  function CheckFormat(FormatExpr: TPasExpr; Index: integer;
+    const ParamResolved: TPasResolverResult): boolean;
+  var
+    ResolvedEl: TPasResolverResult;
+    Ok: Boolean;
+  begin
+    if FormatExpr=nil then exit(true);
+    Result:=false;
+    Ok:=false;
+    if ParamResolved.BaseType in btAllFloats then
+      // floats supports value:Width:Precision
+      Ok:=true
+    else
+      // all other only support value:Width
+      Ok:=Index<2;
+    if not Ok then
+      begin
+      if RaiseOnError then
+        RaiseMsg(20170319222319,nIllegalExpression,sIllegalExpression,[],FormatExpr);
+      exit;
+      end;
+    ComputeElement(FormatExpr,ResolvedEl,[]);
+    if not (ResolvedEl.BaseType in btAllInteger) then
+      begin
+      if RaiseOnError then
+        RaiseMsg(20170319221515,nXExpectedButYFound,sXExpectedButYFound,
+          ['integer',GetResolverResultDescription(ResolvedEl,true)],FormatExpr);
+      exit;
+      end;
+    if not (rrfReadable in ResolvedEl.Flags) then
+      begin
+      if RaiseOnError then
+        RaiseMsg(20170319221755,nNotReadable,sNotReadable,[],FormatExpr);
+      exit;
+      end;
+    Result:=true;
+  end;
+
+var
+  TypeEl: TPasType;
+begin
+  Result:=cIncompatible;
+  if ParamResolved.BaseType in (btAllInteger+btAllBooleans+btAllFloats) then
+    Result:=cExact
+  else if IsFunc and (ParamResolved.BaseType in btAllStringAndChars) then
+    Result:=cExact
+  else if ParamResolved.BaseType=btContext then
+    begin
+      TypeEl:=ParamResolved.TypeEl;
+      if TypeEl.ClassType=TPasEnumType then
+        Result:=cExact
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170319220517,ArgNo,Param,ParamResolved,'boolean, integer, enum value',RaiseOnError));
+  if not CheckFormat(Param.format1,1,ParamResolved) then
+    exit(cIncompatible);
+  if not CheckFormat(Param.format2,2,ParamResolved) then
+    exit(cIncompatible);
+end;
+
+function TPasResolver.BI_StrProc_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// check params of built-in procedure 'Str'
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,2,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+  if ParentNeedsExprResult(Params) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170326084331,nIncompatibleTypesGotExpected,
+        sIncompatibleTypesGotExpected,['procedure str','function str'],Params);
+    exit(cIncompatible);
+    end;
+
+  // first param: boolean, integer, enum, class instance
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=BI_Str_CheckParam(false,Param,ParamResolved,1,RaiseOnError);
+  if Result=cIncompatible then
+    exit;
+
+  // second parameter: string variable
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  Result:=cIncompatible;
+  if ResolvedElCanBeVarParam(ParamResolved) then
+    begin
+    if ParamResolved.BaseType in btAllStrings then
+      Result:=cExact;
+    end;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170319220806,1,Param,ParamResolved,'string variable',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,2,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_StrProc_OnFinishParamsExpr(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  AccessExpr(P[0],rraRead);
+  AccessExpr(P[1],rraVarParam);
+end;
+
+function TPasResolver.BI_StrFunc_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  i: Integer;
+begin
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit(cIncompatible);
+  Params:=TParamsExpr(Expr);
+  if not ParentNeedsExprResult(Params) then
+    begin
+    // not in an expression -> the 'procedure str' is needed, not the 'function str'
+    if RaiseOnError then
+      RaiseMsg(20170326084622,nIncompatibleTypesGotExpected,
+        sIncompatibleTypesGotExpected,['function str','procedure str'],Params);
+    exit(cIncompatible);
+    end;
+
+  // param: string, boolean, integer, enum, class instance
+  for i:=0 to length(Params.Params)-1 do
+    begin
+    Param:=Params.Params[i];
+    ComputeElement(Param,ParamResolved,[]);
+    Result:=BI_Str_CheckParam(true,Param,ParamResolved,i+1,RaiseOnError);
+    if Result=cIncompatible then
+    exit;
+    end;
+
+  Result:=cExact;
+end;
+
+procedure TPasResolver.BI_StrFunc_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  if Params=nil then ;
+  SetResolverIdentifier(ResolvedEl,btString,Proc.Proc,FBaseTypes[btString],[rrfReadable]);
+end;
+
+function TPasResolver.BI_ConcatArray_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved, ElTypeResolved, FirstElTypeResolved: TPasResolverResult;
+  i: Integer;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  FirstElTypeResolved:=Default(TPasResolverResult);
+  for i:=0 to length(Params.Params)-1 do
+    begin
+    // all params: array
+    Param:=Params.Params[i];
+    ComputeElement(Param,ParamResolved,[]);
+    if not (rrfReadable in ParamResolved.Flags)
+        or (ParamResolved.BaseType<>btContext)
+        or not IsDynArray(ParamResolved.TypeEl) then
+      exit(CheckRaiseTypeArgNo(20170329181206,i+1,Param,ParamResolved,'dynamic array',RaiseOnError));
+    ComputeElement(TPasArrayType(ParamResolved.TypeEl).ElType,ElTypeResolved,[rcType]);
+    Include(ElTypeResolved.Flags,rrfReadable);
+    if i=0 then
+      begin
+      FirstElTypeResolved:=ElTypeResolved;
+      Include(ElTypeResolved.Flags,rrfWritable);
+      end
+    else if CheckAssignResCompatibility(FirstElTypeResolved,ElTypeResolved,Param,RaiseOnError)=cIncompatible then
+      exit(cIncompatible);
+    end;
+end;
+
+procedure TPasResolver.BI_ConcatArray_OnGetCallResult(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult);
+begin
+  ComputeElement(Params.Params[0],ResolvedEl,[]);
+  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
+end;
+
+function TPasResolver.BI_CopyArray_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  // first param: array
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  if (rrfReadable in ParamResolved.Flags)
+      and (ParamResolved.BaseType=btContext)
+      and IsDynArray(ParamResolved.TypeEl) then
+    Result:=cExact;
+  if Result=cIncompatible then
+    exit(CheckRaiseTypeArgNo(20170329153951,1,Param,ParamResolved,'dynamic array',RaiseOnError));
+  if length(Params.Params)=1 then
+    exit(cExact);
+
+  // check optional Start index
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  if not (rrfReadable in ParamResolved.Flags)
+      or not (ParamResolved.BaseType in btAllInteger) then
+    exit(CheckRaiseTypeArgNo(20170329164210,2,Param,ParamResolved,'integer',RaiseOnError));
+  if length(Params.Params)=2 then
+    exit(cExact);
+
+  // check optional Count
+  Param:=Params.Params[2];
+  ComputeElement(Param,ParamResolved,[]);
+  if not (rrfReadable in ParamResolved.Flags)
+      or not (ParamResolved.BaseType in btAllInteger) then
+    exit(CheckRaiseTypeArgNo(20170329164329,3,Param,ParamResolved,'integer',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_CopyArray_OnGetCallResult(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult);
+begin
+  ComputeElement(Params.Params[0],ResolvedEl,[]);
+  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
+end;
+
+function TPasResolver.BI_InsertArray_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// Insert(Item,var Array,Index)
+var
+  Params: TParamsExpr;
+  Param, ItemParam: TPasExpr;
+  ItemResolved, ParamResolved, ElTypeResolved: TPasResolverResult;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  // check Item
+  ItemParam:=Params.Params[0];
+  ComputeElement(ItemParam,ItemResolved,[]);
+  if not (rrfReadable in ItemResolved.Flags) then
+    exit(CheckRaiseTypeArgNo(20170329171400,1,ItemParam,ItemResolved,'value',RaiseOnError));
+
+  // check Array
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  if not ResolvedElCanBeVarParam(ParamResolved) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170329171514,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
+    exit;
+    end;
+  if (ParamResolved.BaseType<>btContext)
+      or not IsDynArray(ParamResolved.TypeEl) then
+    exit(CheckRaiseTypeArgNo(20170329172024,2,Param,ParamResolved,'dynamic array',RaiseOnError));
+  ComputeElement(TPasArrayType(ParamResolved.TypeEl).ElType,ElTypeResolved,[rcType]);
+  if CheckAssignResCompatibility(ElTypeResolved,ItemResolved,ItemParam,RaiseOnError)=cIncompatible then
+    exit(cIncompatible);
+
+  // check insert Index
+  Param:=Params.Params[2];
+  ComputeElement(Param,ParamResolved,[]);
+  if not (rrfReadable in ParamResolved.Flags)
+      or not (ParamResolved.BaseType in btAllInteger) then
+    exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_InsertArray_OnFinishParamsExpr(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  AccessExpr(P[0],rraRead);
+  AccessExpr(P[1],rraVarParam);
+  AccessExpr(P[2],rraRead);
+end;
+
+function TPasResolver.BI_DeleteArray_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// Delete(var Array; Start, Count: integer)
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,3,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  // check Array
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[]);
+  if not ResolvedElCanBeVarParam(ParamResolved) then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170329173421,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Param);
+    exit;
+    end;
+  if (ParamResolved.BaseType<>btContext)
+      or not IsDynArray(ParamResolved.TypeEl) then
+    exit(CheckRaiseTypeArgNo(20170329173434,1,Param,ParamResolved,'dynamic array',RaiseOnError));
+
+  // check param Start
+  Param:=Params.Params[1];
+  ComputeElement(Param,ParamResolved,[]);
+  if not (rrfReadable in ParamResolved.Flags)
+     or not (ParamResolved.BaseType in btAllInteger) then
+    exit(CheckRaiseTypeArgNo(20170329173613,2,Param,ParamResolved,'integer',RaiseOnError));
+
+  // check param Count
+  Param:=Params.Params[2];
+  ComputeElement(Param,ParamResolved,[]);
+  if not (rrfReadable in ParamResolved.Flags)
+      or not (ParamResolved.BaseType in btAllInteger) then
+    exit(CheckRaiseTypeArgNo(20170329172348,3,Param,ParamResolved,'integer',RaiseOnError));
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,3,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_DeleteArray_OnFinishParamsExpr(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr);
+var
+  P: TPasExprArray;
+begin
+  if Proc=nil then ;
+  P:=Params.Params;
+  AccessExpr(P[0],rraVarParam);
+  AccessExpr(P[1],rraRead);
+  AccessExpr(P[2],rraRead);
+end;
+
+function TPasResolver.BI_TypeInfo_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+var
+  Params: TParamsExpr;
+  Param: TPasExpr;
+  Decl: TPasElement;
+  ParamResolved: TPasResolverResult;
+  aType: TPasType;
+begin
+  Result:=cIncompatible;
+  if not CheckBuiltInMinParamCount(Proc,Expr,1,RaiseOnError) then
+    exit;
+  Params:=TParamsExpr(Expr);
+
+  // check type or var
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  Decl:=ParamResolved.IdentEl;
+  aType:=nil;
+  if (Decl<>nil) then
+    begin
+    if Decl is TPasType then
+      aType:=TPasType(Decl)
+    else if Decl is TPasVariable then
+      aType:=TPasVariable(Decl).VarType
+    else if Decl.ClassType=TPasArgument then
+      aType:=TPasArgument(Decl).ArgType
+    else if Decl.ClassType=TPasResultElement then
+      aType:=TPasResultElement(Decl).ResultType
+    else if Decl is TPasFunction then
+      aType:=TPasFunction(Decl).FuncType.ResultEl.ResultType;
+    {$IFDEF VerbosePasResolver}
+    if aType=nil then
+      writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility Decl=',GetObjName(Decl));
+    {$ENDIF}
+    end;
+  if aType=nil then
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.BI_TypeInfo_OnGetCallCompatibility ',GetResolverResultDbg(ParamResolved));
+    {$ENDIF}
+    RaiseMsg(20170411100259,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
+    end;
+  aType:=ResolveAliasType(aType);
+  if not HasTypeInfo(aType) then
+    RaiseMsg(20170413200118,nSymbolCannotBePublished,sSymbolCannotBePublished,[],Param);
+
+  Result:=CheckBuiltInMaxParamCount(Proc,Params,1,RaiseOnError);
+end;
+
+procedure TPasResolver.BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
+  Params: TParamsExpr; out ResolvedEl: TPasResolverResult);
+begin
+  if Proc=nil then;
+  if Params=nil then ;
+  SetResolverTypeExpr(ResolvedEl,btPointer,FBaseTypes[btPointer],[rrfReadable]);
+end;
+
+constructor TPasResolver.Create;
+begin
+  inherited Create;
+  FDefaultScope:=TPasDefaultScope.Create;
+  FPendingForwards:=TFPList.Create;
+  FBaseTypeChar:=btAnsiChar;
+  FBaseTypeString:=btAnsiString;
+  FBaseTypeExtended:=btDouble;
+  FBaseTypeLength:=btInt64;
+  FDynArrayMinIndex:=0;
+  FDynArrayMaxIndex:=High(int64);
+  FScopeClass_Class:=TPasClassScope;
+  FScopeClass_WithExpr:=TPasWithExprScope;
+  fExprEvaluator:=TResExprEvaluator.Create;
+  fExprEvaluator.OnLog:=@OnExprEvalLog;
+  fExprEvaluator.OnEvalIdentifier:=@OnExprEvalIdentifier;
+  fExprEvaluator.OnEvalParams:=@OnExprEvalParams;
+  PushScope(FDefaultScope);
+end;
+
+function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+var
+  aScanner: TPascalScanner;
+  SrcPos: TPasSourcePos;
+begin
+  // get source position for good error messages
+  aScanner:=CurrentParser.Scanner;
+  if (ASourceFilename='') or StoreSrcColumns then
+    begin
+    SrcPos.FileName:=aScanner.CurFilename;
+    SrcPos.Row:=aScanner.CurRow;
+    SrcPos.Column:=aScanner.CurColumn;
+    end
+  else
+    begin
+    SrcPos.FileName:=ASourceFilename;
+    SrcPos.Row:=ASourceLinenumber;
+    SrcPos.Column:=0;
+    end;
+  Result:=CreateElement(AClass,AName,AParent,AVisibility,SrcPos);
+end;
+
+function TPasResolver.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASrcPos: TPasSourcePos): TPasElement;
+var
+  El: TPasElement;
+  SrcY: integer;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateElement ',AClass.ClassName,' Name=',AName,' Parent=',GetObjName(AParent),' (',ASrcPos.Row,',',ASrcPos.Column,')');
+  {$ENDIF}
+  if (AParent=nil) and (FRootElement<>nil) then
+    RaiseInternalError(20160922163535,'more than one root element Class="'+AClass.ClassName+'" Root='+GetObjName(FRootElement));
+
+  if ASrcPos.FileName='' then
+    RaiseInternalError(20160922163541,'missing filename');
+  SrcY:=ASrcPos.Row;
+  if StoreSrcColumns then
+    begin
+    if (ASrcPos.Column<ParserMaxEmbeddedColumn)
+        and (SrcY<ParserMaxEmbeddedRow) then
+      SrcY:=-(SrcY*ParserMaxEmbeddedColumn+integer(ASrcPos.Column));
+    end;
+
+  // create element
+  El:=AClass.Create(AName,AParent);
+  FLastElement:=El;
+  Result:=FLastElement;
+  El.Visibility:=AVisibility;
+  El.SourceFilename:=ASrcPos.FileName;
+  El.SourceLinenumber:=SrcY;
+  if FRootElement=nil then
+    FRootElement:=Result as TPasModule;
+
+  // create scope
+  if (AClass=TPasVariable)
+      or (AClass=TPasConst) then
+    AddVariable(TPasVariable(El))
+  else if (AClass=TPasProperty) then
+    AddProperty(TPasProperty(El))
+  else if AClass=TPasArgument then
+    AddArgument(TPasArgument(El))
+  else if AClass=TPasEnumType then
+    AddEnumType(TPasEnumType(El))
+  else if AClass=TPasEnumValue then
+    AddEnumValue(TPasEnumValue(El))
+  else if (AClass=TUnresolvedPendingRef) then
+  else if (AClass=TPasAliasType)
+      or (AClass=TPasTypeAliasType)
+      or (AClass=TPasClassOfType)
+      or (AClass=TPasArrayType)
+      or (AClass=TPasProcedureType)
+      or (AClass=TPasFunctionType)
+      or (AClass=TPasSetType)
+      or (AClass=TPasRangeType) then
+    AddType(TPasType(El))
+  else if AClass=TPasStringType then
+    begin
+    AddType(TPasType(El));
+    if BaseTypes[btShortString]=nil then
+      RaiseMsg(20170419203043,nIllegalQualifier,sIllegalQualifier,['['],El);
+    end
+  else if AClass=TPasRecordType then
+    AddRecordType(TPasRecordType(El))
+  else if AClass=TPasClassType then
+    AddClassType(TPasClassType(El))
+  else if AClass=TPasVariant then
+  else if AClass.InheritsFrom(TPasProcedure) then
+    AddProcedure(TPasProcedure(El))
+  else if AClass=TPasResultElement then
+    AddFunctionResult(TPasResultElement(El))
+  else if AClass=TProcedureBody then
+    AddProcedureBody(TProcedureBody(El))
+  else if AClass=TPasImplExceptOn then
+    AddExceptOn(TPasImplExceptOn(El))
+  else if AClass=TPasImplLabelMark then
+  else if AClass=TPasOverloadedProc then
+  else if (AClass=TInterfaceSection)
+      or (AClass=TImplementationSection)
+      or (AClass=TProgramSection)
+      or (AClass=TLibrarySection) then
+    AddSection(TPasSection(El))
+  else if (AClass=TPasModule)
+      or (AClass=TPasProgram)
+      or (AClass=TPasLibrary) then
+    AddModule(TPasModule(El))
+  else if AClass=TPasUsesUnit then
+  else if AClass.InheritsFrom(TPasExpr) then
+    // resolved when finished
+  else if AClass.InheritsFrom(TPasImplBlock) then
+    // resolved finished
+  else
+    RaiseNotYetImplemented(20160922163544,El);
+end;
+
+function TPasResolver.FindElement(const aName: String): TPasElement;
+// called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
+var
+  p: SizeInt;
+  RightPath, CurName: String;
+  NeedPop: Boolean;
+  CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
+  CurSection: TPasSection;
+  i: Integer;
+  UsesUnit: TPasUsesUnit;
+begin
+  //writeln('TPasResolver.FindElement Name="',aName,'"');
+  ErrorEl:=nil; // use nil to use scanner position as error position
+
+  RightPath:=aName;
+  p:=1;
+  CurScopeEl:=nil;
+  repeat
+    p:=Pos('.',RightPath);
+    if p<1 then
+      begin
+      CurName:=RightPath;
+      RightPath:='';
+      end
+    else
+      begin
+      CurName:=LeftStr(RightPath,p-1);
+      Delete(RightPath,1,p);
+      if RightPath='' then
+        RaiseMsg(20170328003146,nIllegalExpression,sIllegalExpression,[],ErrorEl);
+      end;
+    {$IFDEF VerbosePasResolver}
+    if RightPath<>'' then
+      writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ...');
+    {$ENDIF}
+    if not IsValidIdent(CurName) then
+      RaiseNotYetImplemented(20170328000033,ErrorEl);
+    if CurScopeEl<>nil then
+      begin
+      NeedPop:=true;
+      if CurScopeEl.ClassType=TPasClassType then
+        // check visibility
+        PushClassDotScope(TPasClassType(CurScopeEl))
+      else if CurScopeEl is TPasModule then
+        PushModuleDotScope(TPasModule(CurScopeEl))
+      else
+        RaiseInternalError(20170504174021);
+      end
+    else
+      NeedPop:=false;
+
+    NextEl:=FindElementWithoutParams(CurName,ErrorEl,true);
+    if NextEl is TPasModule then
+      begin
+      if CurScopeEl is TPasModule then
+        RaiseXExpectedButYFound(20170328001619,'class',NextEl.ElementTypeName+' '+NextEl.Name,ErrorEl);
+      if Pos('.',NextEl.Name)>0 then
+        begin
+        // dotted module name -> check if the full module name is in aName
+        if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then
+          begin
+          if CompareText(NextEl.Name,aName)=0 then
+            RaiseXExpectedButYFound(20170504165825,'type',NextEl.ElementTypeName,ErrorEl)
+          else
+            RaiseIdentifierNotFound(20170504165412,aName,ErrorEl);
+          end;
+        RightPath:=copy(aName,length(NextEl.Name)+2,length(aName));
+        end;
+      CurScopeEl:=NextEl;
+      end
+    else if NextEl.ClassType=TPasUsesUnit then
+      begin
+      // the first name of a used unit matches -> find longest match
+      CurSection:=NextEl.Parent as TPasSection;
+      i:=length(CurSection.UsesClause)-1;
+      BestEl:=nil;
+      while i>=0 do
+        begin
+        UsesUnit:=CurSection.UsesClause[i];
+        CurName:=UsesUnit.Name;
+        if IsDottedIdentifierPrefix(CurName,aName)
+            and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
+          BestEl:=UsesUnit;
+        dec(i);
+        if (i<0) and (CurSection.ClassType=TImplementationSection) then
+          begin
+          CurSection:=(CurSection.Parent as TPasModule).InterfaceSection;
+          if CurSection=nil then break;
+          i:=length(CurSection.UsesClause)-1;
+          end;
+        end;
+      // check module name too
+      CurName:=RootElement.Name;
+      if IsDottedIdentifierPrefix(CurName,aName)
+          and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
+        BestEl:=RootElement;
+
+      if BestEl=nil then
+        RaiseIdentifierNotFound(20170504172440,aName,ErrorEl);
+      RightPath:=copy(aName,length(BestEl.Name)+2,length(aName));
+      if BestEl.ClassType=TPasUsesUnit then
+        CurScopeEl:=TPasUsesUnit(BestEl).Module
+      else
+        CurScopeEl:=BestEl;
+      end
+    else if RightPath<>'' then
+      begin
+      if (CurScopeEl is TPasClassType) then
+        CurScopeEl:=NextEl
+      else
+        RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
+      end;
+
+    // restore scope
+    if NeedPop then
+      PopScope;
+
+    if RightPath='' then
+      exit(NextEl);
+  until false;
+end;
+
+function TPasResolver.FindElementWithoutParams(const AName: String;
+  ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement;
+var
+  Data: TPRFindData;
+begin
+  Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs);
+  if Data.Found=nil then exit; // forward type: class-of or ^
+  CheckFoundElement(Data,nil);
+  if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
+      and (wesfNeedTmpVar in TPasWithExprScope(Data.StartScope).Flags) then
+    RaiseInternalError(20160923111727); // caller forgot to handle "With", use the other FindElementWithoutParams instead
+end;
+
+function TPasResolver.FindElementWithoutParams(const AName: String; out
+  Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs: boolean
+  ): TPasElement;
+var
+  Abort: boolean;
+begin
+  //writeln('TPasResolver.FindIdentifier Name="',AName,'"');
+  Result:=Nil;
+  Abort:=false;
+  Data:=Default(TPRFindData);
+  Data.ErrorPosEl:=ErrorPosEl;
+  IterateElements(AName,@OnFindFirstElement,@Data,Abort);
+  Result:=Data.Found;
+  if Result=nil then
+    begin
+    if (ErrorPosEl=nil) and (LastElement<>nil)
+        and (LastElement.ClassType=TPasClassOfType)
+        and (TPasClassOfType(LastElement).DestType=nil) then
+      begin
+      // 'class of' of a not yet defined class
+      Result:=CreateElement(TUnresolvedPendingRef,AName,LastElement,visDefault,
+                            CurrentParser.CurSourcePos);
+      exit;
+      end;
+    RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
+    end;
+  if NoProcsWithArgs and (Result is TPasProcedure)
+      and ProcNeedsParams(TPasProcedure(Result).ProcType)
+  then
+    // proc needs parameters
+    RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
+      sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(TPasProcedure(Result).ProcType)],ErrorPosEl);
+end;
+
+procedure TPasResolver.FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
+// Input: El is TPasUsesUnit
+// Output: El is either a TPasUsesUnit or the root module
+var
+  CurUsesUnit: TPasUsesUnit;
+  BestEl: TPasElement;
+  aName, CurName: String;
+  Clause: TPasUsesClause;
+  i: Integer;
+  Section: TPasSection;
+begin
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.FindLongestUnitName El=',GetObjName(El),' Expr=',GetObjName(Expr));
+  {$ENDIF}
+  if not (El is TPasUsesUnit) then
+    RaiseInternalError(20170503000945);
+  aName:=GetNameExprValue(Expr);
+  if aName='' then
+    RaiseNotYetImplemented(20170503110217,Expr);
+  repeat
+    Expr:=GetNextDottedExpr(Expr);
+    if Expr=nil then break;
+    CurName:=GetNameExprValue(Expr);
+    if CurName='' then
+      RaiseNotYetImplemented(20170502164242,Expr);
+    aName:=aName+'.'+CurName;
+  until false;
+
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.FindLongestUnitName Dotted="',aName,'"');
+  {$ENDIF}
+  // search in uses clause
+  BestEl:=nil;
+  Section:=TPasUsesUnit(El).Parent as TPasSection;
+  repeat
+    Clause:=Section.UsesClause;
+    for i:=0 to length(Clause)-1 do
+      begin
+      CurUsesUnit:=Clause[i];
+      CurName:=CurUsesUnit.Name;
+      if IsDottedIdentifierPrefix(CurName,aName)
+          and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
+        BestEl:=CurUsesUnit; // a better match
+      end;
+    if Section is TImplementationSection then
+      begin
+      // search in interface uses clause too
+      Section:=(Section.Parent as TPasModule).InterfaceSection;
+      end
+    else
+      break;
+  until Section=nil;
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.FindLongestUnitName LongestUnit="',GetObjName(BestEl),'"');
+  {$ENDIF}
+
+  // check module name
+  CurName:=El.GetModule.Name;
+  if IsDottedIdentifierPrefix(CurName,aName)
+      and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then
+    BestEl:=El.GetModule; // a better match
+  if BestEl=nil then
+    begin
+    // no dotted module name fits the expression
+    RaiseIdentifierNotFound(20170503140643,GetNameExprValue(Expr),Expr);
+    end;
+  El:=BestEl;
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.FindLongestUnitName END Best="',GetObjName(El),'"');
+  {$ENDIF}
+end;
+
+procedure TPasResolver.IterateElements(const aName: string;
+  const OnIterateElement: TIterateScopeElement; Data: Pointer;
+  var Abort: boolean);
+var
+  i: Integer;
+  Scope: TPasScope;
+begin
+  for i:=FScopeCount-1 downto 0 do
+    begin
+    Scope:=Scopes[i];
+    Scope.IterateElements(AName,Scope,OnIterateElement,Data,Abort);
+    if Abort then
+      exit;
+    if Scope is TPasSubScope then break;
+    end;
+end;
+
+procedure TPasResolver.CheckFoundElement(
+  const FindData: TPRFindData; Ref: TResolvedReference);
+// check visibility rules
+// Call this method after finding an element by searching the scopes.
+var
+  Proc: TPasProcedure;
+  Context: TPasElement;
+  FoundContext: TPasClassType;
+  StartScope: TPasScope;
+  OnlyTypeMembers: Boolean;
+  TypeEl: TPasType;
+  C: TClass;
+begin
+  StartScope:=FindData.StartScope;
+  OnlyTypeMembers:=false;
+  if StartScope is TPasDotIdentifierScope then
+    begin
+    OnlyTypeMembers:=TPasDotIdentifierScope(StartScope).OnlyTypeMembers;
+    Include(Ref.Flags,rrfDotScope);
+    if TPasDotIdentifierScope(StartScope).ConstParent then
+      Include(Ref.Flags,rrfConstInherited);
+    end
+  else if StartScope.ClassType=ScopeClass_WithExpr then
+    begin
+    OnlyTypeMembers:=wesfOnlyTypeMembers in TPasWithExprScope(StartScope).Flags;
+    Include(Ref.Flags,rrfDotScope);
+    if wesfConstParent in TPasWithExprScope(StartScope).Flags then
+      Include(Ref.Flags,rrfConstInherited);
+    end
+  else if StartScope.ClassType=TPasProcedureScope then
+    begin
+    Proc:=TPasProcedureScope(StartScope).Element as TPasProcedure;
+    //writeln('TPasResolver.CheckFoundElement ',GetObjName(Proc),' ',IsClassMethod(Proc),' ElScope=',GetObjName(FindData.ElScope));
+    if (FindData.ElScope<>StartScope) and IsClassMethod(Proc) then
+      OnlyTypeMembers:=true;
+    end;
+
+  //writeln('TPasResolver.CheckFoundElOnStartScope StartScope=',StartScope.ClassName,
+  //    ' StartIsDot=',StartScope is TPasDotIdentifierScope,
+  //    ' OnlyTypeMembers=',(StartScope is TPasDotIdentifierScope)
+  //       and TPasDotIdentifierScope(StartScope).OnlyTypeMembers,
+  //    ' FindData.Found=',GetObjName(FindData.Found));
+  if OnlyTypeMembers then
+    begin
+    //writeln('TPasResolver.CheckFoundElOnStartScope ',GetObjName(FindData.Found),' ',(FindData.Found is TPasVariable)
+    //    and (vmClass in TPasVariable(FindData.Found).VarModifiers));
+    // only class vars/procs allowed
+    if (FindData.Found.ClassType=TPasConstructor) then
+      // constructor: ok
+    else if IsClassMethod(FindData.Found)
+    then
+      // class proc: ok
+    else if (FindData.Found is TPasVariable)
+        and (vmClass in TPasVariable(FindData.Found).VarModifiers) then
+      // class var/const/property: ok
+    else
+      begin
+      RaiseMsg(20170216152348,nCannotAccessThisMemberFromAX,
+        sCannotAccessThisMemberFromAX,[FindData.Found.Parent.ElementTypeName],FindData.ErrorPosEl);
+      end;
+    end
+  else if (proExtClassInstanceNoTypeMembers in Options)
+      and (StartScope.ClassType=TPasDotClassScope)
+      and TPasClassType(TPasDotClassScope(StartScope).ClassScope.Element).IsExternal then
+    begin
+    // found member in external class instance
+      C:=FindData.Found.ClassType;
+      if (C=TPasProcedure) or (C=TPasFunction) then
+        // ok
+      else if C.InheritsFrom(TPasVariable)
+          and (not (vmClass in TPasVariable(FindData.Found).VarModifiers)) then
+        // ok
+      else
+        begin
+        RaiseMsg(20170331184224,nExternalClassInstanceCannotAccessStaticX,
+          sExternalClassInstanceCannotAccessStaticX,
+          [FindData.Found.ElementTypeName+' '+FindData.Found.Name],
+          FindData.ErrorPosEl);
+        end;
+    end;
+
+  if (FindData.Found is TPasProcedure) then
+    begin
+    Proc:=TPasProcedure(FindData.Found);
+    if Proc.IsVirtual or Proc.IsOverride then
+      begin
+      if (StartScope.ClassType=TPasDotClassScope)
+      and TPasDotClassScope(StartScope).InheritedExpr then
+        begin
+        // call directly
+        if Proc.IsAbstract then
+          RaiseMsg(20170216152352,nAbstractMethodsCannotBeCalledDirectly,
+            sAbstractMethodsCannotBeCalledDirectly,[],FindData.ErrorPosEl);
+        end
+      else
+        begin
+        // call via virtual method table
+        if Ref<>nil then
+          Ref.Flags:=Ref.Flags+[rrfVMT];
+        end;
+      end;
+
+    // constructor: NewInstance or normal call
+    //  it is a NewInstance iff the scope is a class, e.g. TObject.Create
+    if (Proc.ClassType=TPasConstructor)
+        and OnlyTypeMembers
+        and (Ref<>nil) then
+      begin
+      Ref.Flags:=Ref.Flags+[rrfNewInstance]-[rrfConstInherited];
+      // store the class in Ref.Context
+      if Ref.Context<>nil then
+        RaiseInternalError(20170131141936);
+      Ref.Context:=TResolvedRefCtxConstructor.Create;
+      if StartScope is TPasDotClassScope then
+        TypeEl:=TPasDotClassScope(StartScope).ClassScope.Element as TPasType
+      else if (StartScope is TPasWithExprScope)
+          and (TPasWithExprScope(StartScope).Scope is TPasClassScope) then
+        TypeEl:=TPasClassScope(TPasWithExprScope(StartScope).Scope).Element as TPasType
+      else if (StartScope is TPasProcedureScope) then
+        TypeEl:=TPasProcedureScope(StartScope).ClassScope.Element as TPasType
+      else
+        RaiseInternalError(20170131150855,GetObjName(StartScope));
+      TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
+      end;
+    {$IFDEF VerbosePasResolver}
+    if (Proc.ClassType=TPasConstructor) then
+      begin
+      write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
+      if Ref=nil then
+        write(' no ref!')
+      else
+        begin
+        write(' rrfNewInstance=',rrfNewInstance in Ref.Flags,
+          ' StartScope=',GetObjName(StartScope),
+          ' OnlyTypeMembers=',OnlyTypeMembers);
+        end;
+      writeln;
+      end;
+    {$ENDIF}
+
+    // destructor: FreeInstance or normal call
+    // it is a normal call if 'inherited'
+    if (Proc.ClassType=TPasDestructor) and (Ref<>nil) then
+      if ((StartScope.ClassType<>TPasDotClassScope)
+          or (not TPasDotClassScope(StartScope).InheritedExpr)) then
+        Ref.Flags:=Ref.Flags+[rrfFreeInstance];
+    {$IFDEF VerbosePasResolver}
+    if (Proc.ClassType=TPasDestructor) then
+      begin
+      write('TPasResolver.CheckFoundElement ',GetObjName(Proc));
+      if Ref=nil then
+        write(' no ref!')
+      else
+        begin
+        write(' rrfFreeInstance=',rrfFreeInstance in Ref.Flags,
+          ' StartScope=',GetObjName(StartScope));
+        if StartScope.ClassType=TPasDotClassScope then
+          write(' InheritedExpr=',TPasDotClassScope(StartScope).InheritedExpr);
+        end;
+      writeln;
+      end;
+    {$ENDIF}
+    end;
+
+  // check class visibility
+  if FindData.Found.Visibility in [visPrivate,visProtected,visStrictPrivate,visStrictProtected] then
+    begin
+    Context:=GetVisibilityContext;
+    FoundContext:=FindData.Found.Parent as TPasClassType;
+    case FindData.Found.Visibility of
+      visPrivate:
+        // private members can only be accessed in same module
+        if FoundContext.GetModule<>Context.GetModule then
+          RaiseMsg(20170216152354,nCantAccessPrivateMember,sCantAccessPrivateMember,
+            ['private',FindData.Found.Name],FindData.ErrorPosEl);
+      visProtected:
+        // protected members can only be accessed in same module or descendant classes
+        if FoundContext.GetModule=Context.GetModule then
+          // same module -> ok
+        else if (Context is TPasType)
+            and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
+          // context in class or descendant
+        else
+          RaiseMsg(20170216152356,nCantAccessPrivateMember,sCantAccessPrivateMember,
+            ['protected',FindData.Found.Name],FindData.ErrorPosEl);
+      visStrictPrivate:
+        // strict private members can only be accessed in their class
+        if Context<>FoundContext then
+          RaiseMsg(20170216152357,nCantAccessPrivateMember,sCantAccessPrivateMember,
+            ['strict private',FindData.Found.Name],FindData.ErrorPosEl);
+      visStrictProtected:
+        // strict protected members can only be access in their and descendant classes
+        if (Context is TPasType)
+            and (CheckClassIsClass(TPasType(Context),FoundContext,FindData.ErrorPosEl)<>cIncompatible) then
+          // context in class or descendant
+        else
+          RaiseMsg(20170216152400,nCantAccessPrivateMember,sCantAccessPrivateMember,
+            ['strict protected',FindData.Found.Name],FindData.ErrorPosEl);
+    end;
+    end;
+end;
+
+function TPasResolver.GetVisibilityContext: TPasElement;
+var
+  i: Integer;
+begin
+  for i:=ScopeCount-1 downto 0 do
+    begin
+    Result:=Scopes[i].VisibilityContext;
+    if Result<>nil then exit;
+    end;
+  Result:=nil;
+end;
+
+procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
+begin
+  case ScopeType of
+  stModule: FinishModule(El as TPasModule);
+  stUsesClause: FinishUsesClause;
+  stTypeSection: FinishTypeSection(El as TPasDeclarations);
+  stTypeDef: FinishTypeDef(El as TPasType);
+  stConstDef: FinishConstDef(El as TPasConst);
+  stProcedure: FinishProcedure(El as TPasProcedure);
+  stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
+  stExceptOnExpr: FinishExceptOnExpr;
+  stExceptOnStatement: FinishExceptOnStatement;
+  stDeclaration: FinishDeclaration(El);
+  stAncestors: FinishAncestors(El as TPasClassType);
+  else
+    RaiseMsg(20170216152401,nNotYetImplemented,sNotYetImplemented+' FinishScope',[IntToStr(ord(ScopeType))],nil);
+  end;
+end;
+
+function TPasResolver.NeedArrayValues(El: TPasElement): boolean;
+// called by the parser when reading DoParseConstValueExpression
+var
+  C: TClass;
+  V: TPasVariable;
+  TypeEl: TPasType;
+begin
+  Result:=false;
+  if El=nil then exit;
+  C:=El.ClassType;
+  if (C=TPasConst) or (C=TPasVariable) then
+    begin
+    V:=TPasVariable(El);
+    if V.VarType=nil then exit;
+    TypeEl:=ResolveAliasType(V.VarType);
+    Result:=TypeEl.ClassType=TPasArrayType;
+    end;
+  //writeln('TPasResolver.NeedArrayValues ',GetObjName(El));
+end;
+
+class procedure TPasResolver.UnmangleSourceLineNumber(LineNumber: integer; out
+  Line, Column: integer);
+begin
+  Line:=Linenumber;
+  Column:=0;
+  if Line<0 then begin
+    Line:=-Line;
+    Column:=Line mod ParserMaxEmbeddedColumn;
+    Line:=Line div ParserMaxEmbeddedColumn;
+  end;
+end;
+
+class function TPasResolver.GetElementSourcePosStr(El: TPasElement): string;
+var
+  Line, Column: integer;
+begin
+  if El=nil then exit('nil');
+  UnmangleSourceLineNumber(El.SourceLinenumber,Line,Column);
+  Result:=El.SourceFilename+'('+IntToStr(Line);
+  if Column>0 then
+    Result:=Result+','+IntToStr(Column);
+  Result:=Result+')';
+end;
+
+destructor TPasResolver.Destroy;
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasResolver.Destroy START ',ClassName);
+  {$ENDIF}
+  Clear;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasResolver.Destroy PopScope...');
+  {$ENDIF}
+  PopScope; // free default scope
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasResolver.Destroy FPendingForwards...');
+  {$ENDIF}
+  FreeAndNil(FPendingForwards);
+  FreeAndNil(fExprEvaluator);
+  inherited Destroy;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasResolver.Destroy END ',ClassName);
+  {$ENDIF}
+end;
+
+procedure TPasResolver.Clear;
+begin
+  RestoreSubScopes(0);
+  // clear stack, keep DefaultScope
+  while (FScopeCount>0) and (FTopScope<>DefaultScope) do
+    PopScope;
+  ClearResolveDataList(lkModule);
+end;
+
+procedure TPasResolver.ClearBuiltInIdentifiers;
+var
+  bt: TResolverBaseType;
+begin
+  ClearResolveDataList(lkBuiltIn);
+  for bt in TResolverBaseType do
+    FBaseTypes[bt]:=nil;
+end;
+
+procedure TPasResolver.AddObjFPCBuiltInIdentifiers(
+  const TheBaseTypes: TResolveBaseTypes;
+  const TheBaseProcs: TResolverBuiltInProcs);
+var
+  bt: TResolverBaseType;
+begin
+  for bt in TheBaseTypes do
+    AddBaseType(BaseTypeNames[bt],bt);
+  if bfLength in TheBaseProcs then
+    AddBuiltInProc('Length','function Length(const String or Array): sizeint',
+        @BI_Length_OnGetCallCompatibility,@BI_Length_OnGetCallResult,
+        @BI_Length_OnEval,nil,bfLength);
+  if bfSetLength in TheBaseProcs then
+    AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
+        @BI_SetLength_OnGetCallCompatibility,nil,nil,
+        @BI_SetLength_OnFinishParamsExpr,bfSetLength,[bipfCanBeStatement]);
+  if bfInclude in TheBaseProcs then
+    AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
+        @BI_InExclude_OnGetCallCompatibility,nil,nil,
+        @BI_InExclude_OnFinishParamsExpr,bfInclude,[bipfCanBeStatement]);
+  if bfExclude in TheBaseProcs then
+    AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
+        @BI_InExclude_OnGetCallCompatibility,nil,nil,
+        @BI_InExclude_OnFinishParamsExpr,bfExclude,[bipfCanBeStatement]);
+  if bfBreak in TheBaseProcs then
+    AddBuiltInProc('Break','procedure Break',
+        @BI_Break_OnGetCallCompatibility,nil,nil,nil,bfBreak,[bipfCanBeStatement]);
+  if bfContinue in TheBaseProcs then
+    AddBuiltInProc('Continue','procedure Continue',
+        @BI_Continue_OnGetCallCompatibility,nil,nil,nil,bfContinue,[bipfCanBeStatement]);
+  if bfExit in TheBaseProcs then
+    AddBuiltInProc('Exit','procedure Exit(result)',
+        @BI_Exit_OnGetCallCompatibility,nil,nil,nil,bfExit,[bipfCanBeStatement]);
+  if bfInc in TheBaseProcs then
+    AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
+        @BI_IncDec_OnGetCallCompatibility,nil,nil,
+        @BI_IncDec_OnFinishParamsExpr,bfInc,[bipfCanBeStatement]);
+  if bfDec in TheBaseProcs then
+    AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
+        @BI_IncDec_OnGetCallCompatibility,nil,nil,
+        @BI_IncDec_OnFinishParamsExpr,bfDec,[bipfCanBeStatement]);
+  if bfAssigned in TheBaseProcs then
+    AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
+        @BI_Assigned_OnGetCallCompatibility,@BI_Assigned_OnGetCallResult,
+        nil,nil,bfAssigned);
+  if bfChr in TheBaseProcs then
+    AddBuiltInProc('Chr','function Chr(const Integer): char',
+        @BI_Chr_OnGetCallCompatibility,@BI_Chr_OnGetCallResult,nil,nil,bfChr);
+  if bfOrd in TheBaseProcs then
+    AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
+        @BI_Ord_OnGetCallCompatibility,@BI_Ord_OnGetCallResult,nil,nil,bfOrd);
+  if bfLow in TheBaseProcs then
+    AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
+        @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
+        @BI_LowHigh_OnEval,nil,bfLow);
+  if bfHigh in TheBaseProcs then
+    AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
+        @BI_LowHigh_OnGetCallCompatibility,@BI_LowHigh_OnGetCallResult,
+        @BI_LowHigh_OnEval,nil,bfHigh);
+  if bfPred in TheBaseProcs then
+    AddBuiltInProc('Pred','function Pred(const ordinal): ordinal',
+        @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
+        nil,nil,bfPred);
+  if bfSucc in TheBaseProcs then
+    AddBuiltInProc('Succ','function Succ(const ordinal): ordinal',
+        @BI_PredSucc_OnGetCallCompatibility,@BI_PredSucc_OnGetCallResult,
+        nil,nil,bfSucc);
+  if bfStrProc in TheBaseProcs then
+    AddBuiltInProc('Str','procedure Str(const var; var String)',
+        @BI_StrProc_OnGetCallCompatibility,nil,nil,
+        @BI_StrProc_OnFinishParamsExpr,bfStrProc,[bipfCanBeStatement]);
+  if bfStrFunc in TheBaseProcs then
+    AddBuiltInProc('Str','function Str(const var): String',
+        @BI_StrFunc_OnGetCallCompatibility,@BI_StrFunc_OnGetCallResult,
+        nil,nil,bfStrFunc);
+  if bfConcatArray in TheBaseProcs then
+    AddBuiltInProc('Concat','function Concat(const Array1, Array2, ...): Array',
+        @BI_ConcatArray_OnGetCallCompatibility,@BI_ConcatArray_OnGetCallResult,
+        nil,nil,bfConcatArray);
+  if bfCopyArray in TheBaseProcs then
+    AddBuiltInProc('Copy','function Copy(const Array; Start: integer = 0; Count: integer = all): Array',
+        @BI_CopyArray_OnGetCallCompatibility,@BI_CopyArray_OnGetCallResult,
+        nil,nil,bfCopyArray);
+  if bfInsertArray in TheBaseProcs then
+    AddBuiltInProc('Insert','procedure Insert(const Element; var Array; Index: integer)',
+        @BI_InsertArray_OnGetCallCompatibility,nil,nil,
+        @BI_InsertArray_OnFinishParamsExpr,bfInsertArray,[bipfCanBeStatement]);
+  if bfDeleteArray in TheBaseProcs then
+    AddBuiltInProc('Delete','procedure Delete(var Array; Start, Count: integer)',
+        @BI_DeleteArray_OnGetCallCompatibility,nil,nil,
+        @BI_DeleteArray_OnFinishParamsExpr,bfDeleteArray,[bipfCanBeStatement]);
+  if bfTypeInfo in TheBaseProcs then
+    AddBuiltInProc('TypeInfo','function TypeInfo(type or var identifier): Pointer',
+        @BI_TypeInfo_OnGetCallCompatibility,@BI_TypeInfo_OnGetCallResult,
+        nil,nil,bfTypeInfo);
+end;
+
+function TPasResolver.AddBaseType(const aName: string; Typ: TResolverBaseType
+  ): TResElDataBaseType;
+var
+  El: TPasUnresolvedSymbolRef;
+begin
+  El:=TPasUnresolvedSymbolRef.Create(aName,nil);
+  if not (Typ in [btNone,btCustom]) then
+    FBaseTypes[Typ]:=El;
+  Result:=TResElDataBaseType.Create;
+  Result.BaseType:=Typ;
+  AddResolveData(El,Result,lkBuiltIn);
+  FDefaultScope.AddIdentifier(aName,El,pikBaseType);
+end;
+
+function TPasResolver.AddCustomBaseType(const aName: string;
+  aClass: TResElDataBaseTypeClass): TPasUnresolvedSymbolRef;
+var
+  CustomData: TResElDataBaseType;
+begin
+  Result:=TPasUnresolvedSymbolRef.Create(aName,nil);
+  CustomData:=aClass.Create;
+  CustomData.BaseType:=btCustom;
+  AddResolveData(Result,CustomData,lkBuiltIn);
+  FDefaultScope.AddIdentifier(aName,Result,pikBaseType);
+end;
+
+function TPasResolver.IsBaseType(aType: TPasType; BaseType: TResolverBaseType;
+  ResolveAlias: boolean): boolean;
+begin
+  Result:=false;
+  if aType=nil then exit;
+  if ResolveAlias then
+    aType:=ResolveAliasType(aType);
+  if aType.ClassType<>TPasUnresolvedSymbolRef then exit;
+  Result:=CompareText(aType.Name,BaseTypeNames[BaseType])=0;
+end;
+
+function TPasResolver.AddBuiltInProc(const aName: string; Signature: string;
+  const GetCallCompatibility: TOnGetCallCompatibility;
+  const GetCallResult: TOnGetCallResult; const EvalConst: TOnEvalBIFunction;
+  const FinishParamsExpr: TOnFinishParamsExpr;
+  const BuiltIn: TResolverBuiltInProc; const Flags: TBuiltInProcFlags
+  ): TResElDataBuiltInProc;
+var
+  El: TPasUnresolvedSymbolRef;
+begin
+  El:=TPasUnresolvedSymbolRef.Create(aName,nil);
+  Result:=TResElDataBuiltInProc.Create;
+  Result.Proc:=El;
+  Result.Signature:=Signature;
+  Result.BuiltIn:=BuiltIn;
+  Result.GetCallCompatibility:=GetCallCompatibility;
+  Result.GetCallResult:=GetCallResult;
+  Result.Eval:=EvalConst;
+  Result.FinishParamsExpression:=FinishParamsExpr;
+  Result.Flags:=Flags;
+  AddResolveData(El,Result,lkBuiltIn);
+  FDefaultScope.AddIdentifier(aName,El,pikBuiltInProc);
+end;
+
+procedure TPasResolver.AddResolveData(El: TPasElement; Data: TResolveData;
+  Kind: TResolveDataListKind);
+begin
+  Data.Element:=El;
+  Data.Owner:=Self;
+  Data.Next:=FLastCreatedData[Kind];
+  FLastCreatedData[Kind]:=Data;
+  El.CustomData:=Data;
+end;
+
+function TPasResolver.CreateReference(DeclEl, RefEl: TPasElement;
+  Access: TResolvedRefAccess; FindData: PPRFindData): TResolvedReference;
+
+  procedure RaiseAlreadySet;
+  var
+    FormerDeclEl: TPasElement;
+  begin
+    writeln('RaiseAlreadySet RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
+    writeln('  RefEl at ',GetElementSourcePosStr(RefEl));
+    writeln('  RefEl.CustomData=',GetObjName(RefEl.CustomData));
+    if RefEl.CustomData is TResolvedReference then
+      begin
+        FormerDeclEl:=TResolvedReference(RefEl.CustomData).Declaration;
+      writeln('  TResolvedReference(RefEl.CustomData).Declaration=',GetObjName(FormerDeclEl),
+       ' IsSame=',FormerDeclEl=DeclEl);
+      end;
+    RaiseInternalError(20160922163554,'customdata<>nil');
+  end;
+
+begin
+  if RefEl.CustomData<>nil then
+    RaiseAlreadySet;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateReference RefEl=',GetObjName(RefEl),' DeclEl=',GetObjName(DeclEl));
+  {$ENDIF}
+  Result:=TResolvedReference.Create;
+  if FindData<>nil then
+    begin
+    if FindData^.StartScope.ClassType=ScopeClass_WithExpr then
+      Result.WithExprScope:=TPasWithExprScope(FindData^.StartScope);
+    end;
+  AddResolveData(RefEl,Result,lkModule);
+  Result.Declaration:=DeclEl;
+  if RefEl is TPasExpr then
+    SetResolvedRefAccess(TPasExpr(RefEl),Result,Access);
+  EmitElementHints(RefEl,DeclEl);
+end;
+
+function TPasResolver.CreateScope(El: TPasElement; ScopeClass: TPasScopeClass
+  ): TPasScope;
+begin
+  if not ScopeClass.IsStoredInElement then
+    RaiseInternalError(20160923121858);
+  if El.CustomData<>nil then
+    RaiseInternalError(20160923121849);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CreateScope El=',GetObjName(El),' ScopeClass=',ScopeClass.ClassName);
+  {$ENDIF}
+  Result:=ScopeClass.Create;
+  if Result.FreeOnPop then
+    begin
+    Result.Element:=El;
+    El.CustomData:=Result;
+    Result.Owner:=Self;
+    end
+  else
+    // add to free list
+    AddResolveData(El,Result,lkModule);
+end;
+
+procedure TPasResolver.PopScope;
+var
+  Scope: TPasScope;
+begin
+  if FScopeCount=0 then
+    RaiseInternalError(20160922163557);
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.PopScope ',FScopeCount,' ',FTopScope<>nil,' IsDefault=',FTopScope=FDefaultScope);
+  writeln('TPasResolver.PopScope ',FTopScope.ClassName,' IsStoredInElement=',FTopScope.IsStoredInElement,' Element=',GetObjName(FTopScope.Element),' FreeOnPop=',FTopScope.FreeOnPop);
+  {$ENDIF}
+  dec(FScopeCount);
+  if FTopScope.FreeOnPop then
+    begin
+    Scope:=FScopes[FScopeCount];
+    if (Scope.Element<>nil) and (Scope.Element.CustomData=Scope) then
+      Scope.Element.CustomData:=nil;
+    if Scope=FDefaultScope then
+      FDefaultScope:=nil;
+    FScopes[FScopeCount]:=nil;
+    Scope.Free;
+    end;
+  if FScopeCount>0 then
+    FTopScope:=FScopes[FScopeCount-1]
+  else
+    FTopScope:=nil;
+end;
+
+procedure TPasResolver.PushScope(Scope: TPasScope);
+begin
+  if Scope=nil then
+    RaiseInternalError(20160922163601);
+  if length(FScopes)=FScopeCount then
+    SetLength(FScopes,FScopeCount*2+10);
+  FScopes[FScopeCount]:=Scope;
+  inc(FScopeCount);
+  FTopScope:=Scope;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.PushScope ScopeCount=',ScopeCount,' ',GetObjName(FTopScope));
+  {$ENDIF}
+end;
+
+function TPasResolver.PushScope(El: TPasElement; ScopeClass: TPasScopeClass
+  ): TPasScope;
+begin
+  Result:=CreateScope(El,ScopeClass);
+  PushScope(Result);
+end;
+
+function TPasResolver.PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
+begin
+  Result:=TPasModuleDotScope.Create;
+  Result.Owner:=Self;
+  Result.Module:=aModule;
+  if aModule is TPasProgram then
+    begin // program
+    if TPasProgram(aModule).ProgramSection<>nil then
+      Result.InterfaceScope:=
+        TPasProgram(aModule).ProgramSection.CustomData as TPasSectionScope;
+    end
+  else if aModule is TPasLibrary then
+    begin // library
+    if TPasLibrary(aModule).LibrarySection<>nil then
+      Result.InterfaceScope:=
+        TPasLibrary(aModule).LibrarySection.CustomData as TPasSectionScope;
+    end
+  else
+    begin // unit
+    if aModule.InterfaceSection<>nil then
+      Result.InterfaceScope:=
+        aModule.InterfaceSection.CustomData as TPasSectionScope;
+    if (aModule=CurrentParser.CurModule)
+        and (aModule.ImplementationSection<>nil)
+        and (aModule.ImplementationSection.CustomData<>nil)
+    then
+      Result.ImplementationScope:=aModule.ImplementationSection.CustomData as TPasSectionScope;
+    end;
+
+  PushScope(Result);
+end;
+
+function TPasResolver.PushClassDotScope(var CurClassType: TPasClassType
+  ): TPasDotClassScope;
+var
+  ClassScope: TPasClassScope;
+  Ref: TResolvedReference;
+begin
+  if CurClassType.IsForward then
+    begin
+    Ref:=CurClassType.CustomData as TResolvedReference;
+    CurClassType:=Ref.Declaration as TPasClassType;
+    end;
+  if CurClassType.CustomData=nil then
+    RaiseInternalError(20160922163611);
+  ClassScope:=CurClassType.CustomData as TPasClassScope;
+  Result:=TPasDotClassScope.Create;
+  Result.Owner:=Self;
+  Result.ClassScope:=ClassScope;
+  PushScope(Result);
+end;
+
+function TPasResolver.PushRecordDotScope(CurRecordType: TPasRecordType
+  ): TPasDotRecordScope;
+var
+  RecScope: TPasRecordScope;
+begin
+  RecScope:=CurRecordType.CustomData as TPasRecordScope;
+  Result:=TPasDotRecordScope.Create;
+  Result.Owner:=Self;
+  Result.IdentifierScope:=RecScope;
+  PushScope(Result);
+end;
+
+function TPasResolver.PushEnumDotScope(CurEnumType: TPasEnumType
+  ): TPasDotEnumTypeScope;
+var
+  EnumScope: TPasEnumTypeScope;
+begin
+  EnumScope:=CurEnumType.CustomData as TPasEnumTypeScope;
+  Result:=TPasDotEnumTypeScope.Create;
+  Result.Owner:=Self;
+  Result.IdentifierScope:=EnumScope;
+  PushScope(Result);
+end;
+
+procedure TPasResolver.ResetSubScopes(out Depth: integer);
+// move all sub scopes from Scopes to SubScopes
+begin
+  Depth:=FSubScopeCount;
+  while TopScope is TPasSubScope do
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.ResetSubScopes moving ',TopScope.ClassName,' ScopeCount=',ScopeCount,' SubScopeCount=',FSubScopeCount);
+    {$ENDIF}
+    if FSubScopeCount=length(FSubScopes) then
+      SetLength(FSubScopes,FSubScopeCount+4);
+    FSubScopes[FSubScopeCount]:=TopScope;
+    inc(FSubScopeCount);
+    dec(FScopeCount);
+    FScopes[FScopeCount]:=nil;
+    if FScopeCount>0 then
+      FTopScope:=FScopes[FScopeCount-1]
+    else
+      FTopScope:=nil;
+    end;
+end;
+
+procedure TPasResolver.RestoreSubScopes(Depth: integer);
+// restore sub scopes
+begin
+  while FSubScopeCount>Depth do
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.RestoreSubScopes moving ',FSubScopes[FSubScopeCount-1].ClassName,' ScopeCount=',ScopeCount,' SubScopeCount=',FSubScopeCount);
+    {$ENDIF}
+    if FScopeCount=length(FScopes) then
+      SetLength(FScopes,FScopeCount+4);
+    dec(FSubScopeCount);
+    FScopes[FScopeCount]:=FSubScopes[FSubScopeCount];
+    FTopScope:=FScopes[FScopeCount];
+    FSubScopes[FSubScopeCount]:=nil;
+    inc(FScopeCount);
+    end;
+end;
+
+procedure TPasResolver.SetLastMsg(const id: int64; MsgType: TMessageType;
+  MsgNumber: integer; const Fmt: String; Args: array of const;
+  PosEl: TPasElement);
+var
+{$IFDEF VerbosePasResolver}
+  s: string;
+{$ENDIF}
+  Column, Row: integer;
+begin
+  FLastMsgId := id;
+  FLastMsgType := MsgType;
+  FLastMsgNumber := MsgNumber;
+  FLastMsgPattern := Fmt;
+  FLastMsg := SafeFormat(Fmt,Args);
+  FLastElement := PosEl;
+  if PosEl=nil then
+    FLastSourcePos:=CurrentParser.CurSourcePos
+  else
+    begin
+    FLastSourcePos.FileName:=PosEl.SourceFilename;
+    UnmangleSourceLineNumber(PosEl.SourceLinenumber,Row,Column);
+    if Row>=0 then
+      FLastSourcePos.Row:=Row
+    else
+      FLastSourcePos.Row:=0;
+    if Column>=0 then
+      FLastSourcePos.Column:=Column
+    else
+      FLastSourcePos.Column:=0;
+    end;
+  CreateMsgArgs(FLastMsgArgs,Args);
+  {$IFDEF VerbosePasResolver}
+  write('TPasResolver.SetLastMsg ',id,' ',GetElementSourcePosStr(PosEl),' ');
+  s:='';
+  str(MsgType,s);
+  write(s);
+  writeln(': [',MsgNumber,'] ',FLastMsg);
+  {$ENDIF}
+end;
+
+procedure TPasResolver.RaiseMsg(const Id: int64; MsgNumber: integer;
+  const Fmt: String; Args: array of const; ErrorPosEl: TPasElement);
+var
+  E: EPasResolve;
+begin
+  SetLastMsg(Id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
+  E:=EPasResolve.Create(FLastMsg);
+  E.Id:=Id;
+  E.MsgType:=mtError;
+  E.MsgNumber:=MsgNumber;
+  E.MsgPattern:=Fmt;
+  E.PasElement:=ErrorPosEl;
+  E.Args:=FLastMsgArgs;
+  E.SourcePos:=FLastSourcePos;
+  raise E;
+end;
+
+procedure TPasResolver.RaiseNotYetImplemented(id: int64; El: TPasElement;
+  Msg: string);
+var
+  s: String;
+begin
+  s:=sNotYetImplemented+' ['+IntToStr(id)+']';
+  if Msg<>'' then
+    s:=s+' '+Msg;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
+  {$ENDIF}
+  RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
+end;
+
+procedure TPasResolver.RaiseInternalError(id: int64; const Msg: string);
+begin
+  raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
+end;
+
+procedure TPasResolver.RaiseInvalidScopeForElement(id: int64; El: TPasElement;
+  const Msg: string);
+var
+  i: Integer;
+  s: String;
+begin
+  s:='['+IntToStr(id)+'] invalid scope for "'+GetObjName(El)+'": ';
+  for i:=0 to ScopeCount-1 do
+    begin
+    if i>0 then s:=s+',';
+    s:=s+Scopes[i].ClassName;
+    end;
+  if Msg<>'' then
+    s:=s+': '+Msg;
+  RaiseInternalError(id,s);
+end;
+
+procedure TPasResolver.RaiseIdentifierNotFound(id: int64; Identifier: string;
+  El: TPasElement);
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.RaiseIdentifierNotFound START "',Identifier,'" ErrorEl=',GetObjName(El));
+  WriteScopes;
+  {$ENDIF}
+  RaiseMsg(id,nIdentifierNotFound,sIdentifierNotFound,[Identifier],El);
+end;
+
+procedure TPasResolver.RaiseXExpectedButYFound(id: int64; const X, Y: string;
+  El: TPasElement);
+begin
+  RaiseMsg(id,nXExpectedButYFound,sXExpectedButYFound,[X,Y],El);
+end;
+
+procedure TPasResolver.RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
+end;
+
+procedure TPasResolver.RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
+end;
+
+procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
+  const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
+
+  function GetString(ArgNo: integer): string;
+  begin
+    if ArgNo>High(Args) then
+      exit('invalid param '+IntToStr(ArgNo));
+    case Args[ArgNo].VType of
+    vtAnsiString: Result:=AnsiString(Args[ArgNo].VAnsiString);
+    else
+      Result:='invalid param '+IntToStr(Ord(Args[ArgNo].VType));
+    end;
+  end;
+
+begin
+  case MsgNumber of
+    nIllegalTypeConversionTo:
+      RaiseMsg(id,MsgNumber,sIllegalTypeConversionTo,[GotDesc,ExpDesc],ErrorEl);
+    nIncompatibleTypesGotExpected:
+      RaiseMsg(id,MsgNumber,sIncompatibleTypesGotExpected,[GotDesc,ExpDesc],ErrorEl);
+    nIncompatibleTypeArgNo:
+      RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNo,[GetString(0),GotDesc,ExpDesc],ErrorEl);
+    nIncompatibleTypeArgNoVarParamMustMatchExactly:
+      RaiseMsg(id,MsgNumber,sIncompatibleTypeArgNoVarParamMustMatchExactly,
+               [GetString(0),GotDesc,ExpDesc],ErrorEl);
+    nResultTypeMismatchExpectedButFound:
+      RaiseMsg(id,MsgNumber,sResultTypeMismatchExpectedButFound,[GotDesc,ExpDesc],ErrorEl);
+    nXExpectedButYFound:
+      RaiseMsg(id,MsgNumber,sXExpectedButYFound,[GotDesc,ExpDesc],ErrorEl);
+  else
+    RaiseInternalError(20170329112911);
+  end;
+end;
+
+procedure TPasResolver.RaiseIncompatibleType(id: int64; MsgNumber: integer;
+  const Args: array of const; GotType, ExpType: TPasType; ErrorEl: TPasElement);
+var
+  DescA, DescB: String;
+begin
+  DescA:=GetTypeDescription(GotType);
+  DescB:=GetTypeDescription(ExpType);
+  if DescA=DescB then
+    begin
+    DescA:=GetTypeDescription(GotType,true);
+    DescB:=GetTypeDescription(ExpType,true);
+    end;
+  RaiseIncompatibleTypeDesc(id,MsgNumber,Args,DescA,DescB,ErrorEl);
+end;
+
+procedure TPasResolver.RaiseIncompatibleTypeRes(id: int64; MsgNumber: integer;
+  const Args: array of const; const GotType, ExpType: TPasResolverResult;
+  ErrorEl: TPasElement);
+var
+  GotDesc, ExpDesc: String;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.RaiseIncompatibleTypeRes Got={',GetResolverResultDbg(GotType),'} Expected={',GetResolverResultDbg(ExpType),'}');
+  {$ENDIF}
+  if GotType.BaseType<>ExpType.BaseType then
+    begin
+    GotDesc:=GetBaseDescription(GotType);
+    if ExpType.BaseType=btNil then
+      ExpDesc:=BaseTypeNames[btPointer]
+    else
+      ExpDesc:=GetBaseDescription(ExpType);
+    if GotDesc=ExpDesc then
+      begin
+      GotDesc:=GetBaseDescription(GotType,true);
+      ExpDesc:=GetBaseDescription(ExpType,true);
+      end;
+    end
+  else if (GotType.TypeEl<>nil) and (ExpType.TypeEl<>nil) then
+    begin
+    GotDesc:=GetTypeDescription(GotType);
+    ExpDesc:=GetTypeDescription(ExpType);
+    if GotDesc=ExpDesc then
+      begin
+      GotDesc:=GetTypeDescription(GotType,true);
+      ExpDesc:=GetTypeDescription(ExpType,true);
+      end;
+    end
+  else
+    begin
+    GotDesc:=GetResolverResultDescription(GotType,true);
+    ExpDesc:=GetResolverResultDescription(ExpType,true);
+    if GotDesc=ExpDesc then
+      begin
+      GotDesc:=GetResolverResultDescription(GotType,false);
+      ExpDesc:=GetResolverResultDescription(ExpType,false);
+      end;
+    end;
+  RaiseIncompatibleTypeDesc(id,MsgNumber,Args,GotDesc,ExpDesc,ErrorEl);
+end;
+
+procedure TPasResolver.RaiseInvalidProcTypeModifier(id: int64;
+  ProcType: TPasProcedureType; ptm: TProcTypeModifier; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[ProcType.ElementTypeName,
+    ProcTypeModifiers[ptm]],ErrorEl);
+end;
+
+procedure TPasResolver.RaiseInvalidProcModifier(id: int64; Proc: TPasProcedure;
+  pm: TProcedureModifier; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nInvalidXModifierY,sInvalidXModifierY,[Proc.ElementTypeName,
+    ModifierNames[pm]],ErrorEl);
+end;
+
+procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
+  MsgNumber: integer; const Fmt: String; Args: array of const;
+  PosEl: TPasElement);
+begin
+  SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
+  if Assigned(OnLog) then
+    OnLog(Self,FLastMsg)
+  else if Assigned(CurrentParser.OnLog) then
+    CurrentParser.OnLog(Self,FLastMsg);
+end;
+
+function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
+  Params: TParamsExpr; RaiseOnError: boolean; SetReferenceFlags: boolean
+  ): integer;
+var
+  ProcArgs: TFPList;
+  i, ParamCnt, ParamCompatibility: Integer;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  IsVarArgs: Boolean;
+  Flags: TPasResolverComputeFlags;
+begin
+  Result:=cExact;
+  ProcArgs:=ProcType.Args;
+  // check args
+  ParamCnt:=length(Params.Params);
+  IsVarArgs:=false;
+  i:=0;
+  while i<ParamCnt do
+    begin
+    Param:=Params.Params[i];
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
+    {$ENDIF}
+    if i<ProcArgs.Count then
+      begin
+      ParamCompatibility:=CheckParamCompatibility(Param,
+        TPasArgument(ProcArgs[i]),i,RaiseOnError,SetReferenceFlags);
+      if ParamCompatibility=cIncompatible then
+        exit(cIncompatible);
+      end
+    else
+      begin
+      IsVarArgs:=IsVarArgs or (ptmVarargs in ProcType.Modifiers);
+      if IsVarArgs then
+        begin
+        Flags:=[rcNoImplicitProcType];
+        if SetReferenceFlags then
+          Flags:=[rcNoImplicitProcType]
+        else
+          Flags:=[rcNoImplicitProcType,rcSetReferenceFlags];
+        ComputeElement(Param,ParamResolved,Flags,Param);
+        if not (rrfReadable in ParamResolved.Flags) then
+          begin
+          if RaiseOnError then
+            RaiseMsg(20170318234957,nVariableIdentifierExpected,
+              sVariableIdentifierExpected,[],Param);
+          exit(cIncompatible);
+          end;
+        ParamCompatibility:=cExact;
+        end
+      else
+        begin
+        // too many arguments
+        if RaiseOnError then
+          RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
+            sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Param);
+        exit(cIncompatible);
+        end;
+      end;
+    inc(Result,ParamCompatibility);
+    inc(i);
+    end;
+  if (i<ProcArgs.Count) then
+    if (TPasArgument(ProcArgs[i]).ValueExpr=nil) then
+      begin
+      // not enough arguments
+      if RaiseOnError then
+        // ToDo: position cursor on identifier
+        RaiseMsg(20170216152410,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[GetProcTypeDescription(ProcType)],Params.Value);
+      exit(cIncompatible);
+      end
+    else
+      begin
+      // the rest are default params
+      Result:=cCompatibleWithDefaultParams;
+      end;
+end;
+
+function TPasResolver.CheckCallPropertyCompatibility(PropEl: TPasProperty;
+  Params: TParamsExpr; RaiseOnError: boolean): integer;
+var
+  PropArg: TPasArgument;
+  ArgNo, ParamComp: Integer;
+  Param: TPasExpr;
+begin
+  Result:=cExact;
+  if PropEl.Args.Count<length(Params.Params) then
+    begin
+    if not RaiseOnError then exit(cIncompatible);
+    RaiseMsg(20170216152412,nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
+      [PropEl.Name],Params)
+    end
+  else if PropEl.Args.Count>length(Params.Params) then
+    begin
+    if not RaiseOnError then exit(cIncompatible);
+    RaiseMsg(20170216152413,nMissingParameterX,sMissingParameterX,
+      [TPasArgument(PropEl.Args[length(Params.Params)]).Name],Params);
+    end;
+  for ArgNo:=0 to PropEl.Args.Count-1 do
+    begin
+    PropArg:=TPasArgument(PropEl.Args[ArgNo]);
+    Param:=Params.Params[ArgNo];
+    ParamComp:=CheckParamCompatibility(Param,PropArg,ArgNo,RaiseOnError);
+    if ParamComp=cIncompatible then
+      exit(cIncompatible);
+    inc(Result,ParamComp);
+    end;
+end;
+
+function TPasResolver.CheckCallArrayCompatibility(ArrayEl: TPasArrayType;
+  Params: TParamsExpr; RaiseOnError: boolean; EmitHints: boolean): integer;
+var
+  ArgNo: Integer;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+
+  procedure GetNextParam;
+  begin
+    if ArgNo>=length(Params.Params) then
+      RaiseMsg(20170216152415,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
+        [],Params);
+    Param:=Params.Params[ArgNo];
+    ComputeElement(Param,ParamResolved,[]);
+    inc(ArgNo);
+  end;
+
+var
+  DimNo: integer;
+  RangeResolved: TPasResolverResult;
+  bt: TResolverBaseType;
+  NextType: TPasType;
+  ParamValue: TResEvalValue;
+  RangeExpr: TPasExpr;
+  TypeFits: Boolean;
+begin
+  ArgNo:=0;
+  repeat
+    if length(ArrayEl.Ranges)=0 then
+      begin
+      // dynamic/open array -> needs exactly one integer
+      GetNextParam;
+      if (not (rrfReadable in ParamResolved.Flags))
+          or not (ParamResolved.BaseType in btAllInteger) then
+        exit(CheckRaiseTypeArgNo(20170216152417,ArgNo,Param,ParamResolved,'integer',RaiseOnError));
+      if EmitHints then
+        begin
+        ParamValue:=Eval(Param,[refAutoConst]);
+        if ParamValue<>nil then
+          try // has const value -> check range
+            if (ParamValue.Kind<>revkInt)
+                or (TResEvalInt(ParamValue).Int<DynArrayMinIndex)
+                or (TResEvalInt(ParamValue).Int>DynArrayMaxIndex) then
+              fExprEvaluator.EmitRangeCheckConst(20170520202212,ParamValue.AsString,
+                                  DynArrayMinIndex,DynArrayMaxIndex,Param);
+          finally
+            ReleaseEvalValue(ParamValue);
+          end;
+        end;
+      end
+    else
+      begin
+      // static array
+      for DimNo:=0 to length(ArrayEl.Ranges)-1 do
+        begin
+        GetNextParam;
+        RangeExpr:=ArrayEl.Ranges[DimNo];
+        ComputeElement(RangeExpr,RangeResolved,[]);
+        bt:=RangeResolved.BaseType;
+        if bt=btRange then
+          bt:=RangeResolved.SubType;
+        if not (rrfReadable in ParamResolved.Flags) then
+          begin
+          if not RaiseOnError then exit(cIncompatible);
+          RaiseIncompatibleTypeRes(20170216152421,nIncompatibleTypeArgNo,
+            [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
+          end;
+        TypeFits:=false;
+        if (bt in btAllBooleans) and (ParamResolved.BaseType in btAllBooleans) then
+          TypeFits:=true
+        else if (bt in btAllInteger) and (ParamResolved.BaseType in btAllInteger) then
+          TypeFits:=true
+        else if (bt in btAllChars) and (ParamResolved.BaseType in btAllChars) then
+          TypeFits:=true
+        else if (bt=btContext) and (ParamResolved.BaseType=btContext) then
+          begin
+          if (RangeResolved.TypeEl.ClassType=TPasEnumType)
+              and (RangeResolved.TypeEl=ParamResolved.TypeEl) then
+            TypeFits:=true
+          end;
+        if not TypeFits then
+          begin
+          // incompatible
+          if not RaiseOnError then exit(cIncompatible);
+          RaiseIncompatibleTypeRes(20170216152422,nIncompatibleTypeArgNo,
+            [IntToStr(ArgNo)],ParamResolved,RangeResolved,Param);
+          end;
+        if EmitHints then
+          fExprEvaluator.IsInRange(Param,RangeExpr,true);
+        end;
+      end;
+    if ArgNo=length(Params.Params) then exit(cExact);
+
+    // there are more parameters -> continue in sub array
+    NextType:=ResolveAliasType(ArrayEl.ElType);
+    if NextType.ClassType<>TPasArrayType then
+      RaiseMsg(20170216152424,nWrongNumberOfParametersForArray,sWrongNumberOfParametersForArray,
+        [],Params);
+    ArrayEl:=TPasArrayType(NextType);
+  until false;
+end;
+
+function TPasResolver.CheckOverloadProcCompatibility(Proc1, Proc2: TPasProcedure
+  ): boolean;
+// returns if number and type of arguments fit
+// does not check calling convention
+var
+  ProcArgs1, ProcArgs2: TFPList;
+  i: Integer;
+begin
+  Result:=false;
+  ProcArgs1:=Proc1.ProcType.Args;
+  ProcArgs2:=Proc2.ProcType.Args;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckOverloadProcCompatibility START Count=',ProcArgs1.Count,' ',ProcArgs2.Count);
+  {$ENDIF}
+  // check args
+  if ProcArgs1.Count<>ProcArgs2.Count then
+    exit;
+  for i:=0 to ProcArgs1.Count-1 do
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckOverloadProcCompatibility ',i,'/',ProcArgs1.Count);
+    {$ENDIF}
+    if not CheckProcArgCompatibility(TPasArgument(ProcArgs1[i]),TPasArgument(ProcArgs2[i])) then
+      exit;
+    end;
+  Result:=true;
+end;
+
+function TPasResolver.CheckProcTypeCompatibility(Proc1,
+  Proc2: TPasProcedureType; IsAssign: boolean; ErrorEl: TPasElement;
+  RaiseOnIncompatible: boolean): boolean;
+// if RaiseOnIncompatible=true, then Expected=Proc1 Actual=Proc2
+
+  function ModifierError(Modifier: TProcTypeModifier): boolean;
+  begin
+    Result:=false;
+    if not RaiseOnIncompatible then exit;
+    RaiseMsg(20170402112049,nXModifierMismatchY,sXModifierMismatchY,
+      [Proc1.ElementTypeName,ProcTypeModifiers[Modifier]],ErrorEl);
+  end;
+
+var
+  ProcArgs1, ProcArgs2: TFPList;
+  i: Integer;
+  Result1Resolved, Result2Resolved: TPasResolverResult;
+  ExpectedArg, ActualArg: TPasArgument;
+begin
+  Result:=false;
+  if Proc1.ClassType<>Proc2.ClassType then
+    begin
+    if RaiseOnIncompatible then
+      RaiseXExpectedButYFound(20170402112353,Proc1.ElementTypeName,Proc2.ElementTypeName,ErrorEl);
+    exit;
+    end;
+  if Proc1.IsReferenceTo then
+    begin
+    if IsAssign then
+      // aRefTo:=aproc -> any IsNested/OfObject is allowed
+    else
+      ; // aRefTo = AnyProc -> ok
+    end
+  else if Proc2.IsReferenceTo then
+    begin
+    if IsAssign then
+      // NonRefTo := aRefTo  -> not possible
+      exit(ModifierError(ptmReferenceTo))
+    else
+      ; // AnyProc = aRefTo -> ok
+    end
+  else
+    begin
+    // neither Proc1 nor Proc2 is a reference-to  -> check isNested and OfObject
+    if Proc1.IsNested<>Proc2.IsNested then
+      exit(ModifierError(ptmIsNested));
+    if Proc1.IsOfObject<>Proc2.IsOfObject then
+      begin
+      if (proProcTypeWithoutIsNested in Options) then
+        exit(ModifierError(ptmOfObject))
+      else if Proc1.IsNested then
+        // "is nested" can handle both, proc and method.
+      else
+        exit(ModifierError(ptmOfObject))
+      end;
+    end;
+  if Proc1.CallingConvention<>Proc2.CallingConvention then
+    begin
+    if RaiseOnIncompatible then
+      RaiseMsg(20170402112253,nCallingConventionMismatch,sCallingConventionMismatch,
+        [],ErrorEl);
+    exit;
+    end;
+  ProcArgs1:=Proc1.Args;
+  ProcArgs2:=Proc2.Args;
+  if ProcArgs1.Count<>ProcArgs2.Count then exit;
+  for i:=0 to ProcArgs1.Count-1 do
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckProcAssignCompatibility ',i,'/',ProcArgs1.Count);
+    {$ENDIF}
+    ExpectedArg:=TPasArgument(ProcArgs1[i]);
+    ActualArg:=TPasArgument(ProcArgs2[i]);
+    if not CheckProcArgCompatibility(ExpectedArg,ActualArg) then
+      begin
+      if RaiseOnIncompatible then
+        begin
+        if ExpectedArg.Access<>ActualArg.Access then
+          RaiseMsg(20170404151541,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+            [IntToStr(i+1),'access modifier '+AccessDescriptions[ActualArg.Access],
+             AccessDescriptions[ExpectedArg.Access]],
+            ErrorEl);
+        RaiseIncompatibleType(20170404151538,nIncompatibleTypeArgNo,
+          [IntToStr(i+1)],ExpectedArg.ArgType,ActualArg.ArgType,ErrorEl);
+        end;
+      exit;
+      end;
+    end;
+  if Proc1 is TPasFunctionType then
+    begin
+    ComputeElement(TPasFunctionType(Proc1).ResultEl.ResultType,Result1Resolved,[rcType]);
+    ComputeElement(TPasFunctionType(Proc2).ResultEl.ResultType,Result2Resolved,[rcType]);
+    if (Result1Resolved.BaseType<>Result2Resolved.BaseType)
+        or not IsSameType(Result1Resolved.TypeEl,Result2Resolved.TypeEl) then
+      begin
+      if RaiseOnIncompatible then
+        RaiseIncompatibleTypeRes(20170402112648,nResultTypeMismatchExpectedButFound,
+          [],Result1Resolved,Result2Resolved,ErrorEl);
+      exit;
+      end;
+    end;
+  Result:=true;
+end;
+
+function TPasResolver.CheckProcArgCompatibility(Arg1, Arg2: TPasArgument): boolean;
+begin
+  Result:=false;
+
+  // check access: var, const, ...
+  if Arg1.Access<>Arg2.Access then exit;
+
+  // check untyped
+  if Arg1.ArgType=nil then
+    exit(Arg2.ArgType=nil);
+  if Arg2.ArgType=nil then exit;
+
+  Result:=CheckProcArgTypeCompatibility(Arg1.ArgType,Arg2.ArgType);
+end;
+
+function TPasResolver.CheckProcArgTypeCompatibility(Arg1, Arg2: TPasType
+  ): boolean;
+var
+  Arg1Resolved, Arg2Resolved: TPasResolverResult;
+  C: TClass;
+  Arr1, Arr2: TPasArrayType;
+begin
+  ComputeElement(Arg1,Arg1Resolved,[rcType]);
+  ComputeElement(Arg2,Arg2Resolved,[rcType]);
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.CheckProcArgTypeCompatibility Arg1=',GetResolverResultDbg(Arg1Resolved),' Arg2=',GetResolverResultDbg(Arg2Resolved));
+  {$ENDIF}
+
+  if (Arg1Resolved.BaseType<>Arg2Resolved.BaseType)
+      or (Arg1Resolved.TypeEl=nil)
+      or (Arg2Resolved.TypeEl=nil) then
+    exit(false);
+  if (Arg1Resolved.BaseType=Arg2Resolved.BaseType)
+      and IsSameType(Arg1Resolved.TypeEl,Arg2Resolved.TypeEl) then
+    exit(true);
+  C:=Arg1Resolved.TypeEl.ClassType;
+  if (C=TPasArrayType) and (Arg2Resolved.TypeEl.ClassType=TPasArrayType) then
+    begin
+    Arr1:=TPasArrayType(Arg1Resolved.TypeEl);
+    Arr2:=TPasArrayType(Arg2Resolved.TypeEl);
+    if length(Arr1.Ranges)<>length(Arr2.Ranges) then
+      exit(false);
+    if length(Arr1.Ranges)>0 then
+      RaiseNotYetImplemented(20170328093733,Arr1.Ranges[0],'anonymous static array');
+    Result:=CheckProcArgTypeCompatibility(Arr1.ElType,Arr2.ElType);
+    exit;
+    end;
+
+  Result:=false;
+end;
+
+function TPasResolver.CheckCanBeLHS(const ResolvedEl: TPasResolverResult;
+  ErrorOnFalse: boolean; ErrorEl: TPasElement): boolean;
+var
+  El: TPasElement;
+begin
+  Result:=false;
+  El:=ResolvedEl.IdentEl;
+  if El=nil then
+    begin
+    if ErrorOnFalse then
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.CheckCanBeLHS ',GetResolverResultDbg(ResolvedEl));
+      {$ENDIF}
+      if (ResolvedEl.TypeEl<>nil) and (ResolvedEl.ExprEl<>nil) then
+        RaiseXExpectedButYFound(20170216152727,'identifier',ResolvedEl.TypeEl.ElementTypeName,ResolvedEl.ExprEl)
+      else
+        RaiseMsg(20170216152426,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
+      end;
+    exit;
+    end;
+  if [rrfWritable,rrfAssignable]*ResolvedEl.Flags<>[] then
+    exit(true);
+  // not writable
+  if not ErrorOnFalse then exit;
+  if ResolvedEl.IdentEl is TPasProperty then
+    RaiseMsg(20170216152427,nPropertyNotWritable,sPropertyNotWritable,[],ErrorEl)
+  else
+    RaiseMsg(20170216152429,nVariableIdentifierExpected,sVariableIdentifierExpected,[],ErrorEl);
+end;
+
+function TPasResolver.CheckAssignCompatibility(const LHS, RHS: TPasElement;
+  RaiseOnIncompatible: boolean): integer;
+var
+  LeftResolved, RightResolved: TPasResolverResult;
+  Flags: TPasResolverComputeFlags;
+  IsProcType: Boolean;
+begin
+  ComputeElement(LHS,LeftResolved,[rcNoImplicitProc]);
+  Flags:=[];
+  IsProcType:=IsProcedureType(LeftResolved,true);
+  if IsProcType then
+    if msDelphi in CurrentParser.CurrentModeswitches then
+      Include(Flags,rcNoImplicitProc)
+    else
+      Include(Flags,rcNoImplicitProcType);
+  ComputeElement(RHS,RightResolved,Flags);
+  Result:=CheckAssignResCompatibility(LeftResolved,RightResolved,RHS,RaiseOnIncompatible);
+  if RHS is TPasExpr then
+    begin
+    {$IFDEF EnablePasResRangeCheck}
+    CheckAssignExprRange(LeftResolved,TPasExpr(RHS));
+    {$ENDIF}
+    end;
+end;
+
+procedure TPasResolver.CheckAssignExprRange(
+  const LeftResolved: TPasResolverResult; RHS: TPasExpr);
+var
+  RValue: TResEvalValue;
+  MinVal, MaxVal: int64;
+  RgExpr: TBinaryExpr;
+begin
+  RValue:=Eval(RHS,[refAutoConst]);
+  if RValue=nil then
+    exit; // not a const expression
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
+  {$ENDIF}
+  try
+    if LeftResolved.TypeEl is TPasRangeType then
+      begin
+      RgExpr:=TPasRangeType(LeftResolved.TypeEl).RangeExpr;
+      fExprEvaluator.IsInRange(RHS,RgExpr,true);
+      end
+    else if (LeftResolved.BaseType in (btAllInteger-[btQWord]))
+        and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
+      case RValue.Kind of
+      revkInt:
+        if (MinVal>TResEvalInt(RValue).Int)
+            or (MaxVal<TResEvalInt(RValue).Int) then
+          fExprEvaluator.EmitRangeCheckConst(20170530093126,
+            IntToStr(TResEvalInt(RValue).Int),MinVal,MaxVal,RHS);
+      revkUInt:
+        if (TResEvalUInt(RValue).UInt>High(MaxPrecInt))
+            or (MinVal>MaxPrecInt(TResEvalUInt(RValue).UInt))
+            or (MaxVal<MaxPrecInt(TResEvalUInt(RValue).UInt)) then
+          fExprEvaluator.EmitRangeCheckConst(20170530093616,
+            IntToStr(TResEvalUInt(RValue).UInt),IntToStr(MinVal),IntToStr(MaxVal),RHS);
+      else
+        RaiseNotYetImplemented(20170530092731,RHS);
+      end
+    else if LeftResolved.BaseType=btQWord then
+      case RValue.Kind of
+      revkInt:
+        if (TResEvalInt(RValue).Int<0) then
+          fExprEvaluator.EmitRangeCheckConst(20170530094316,
+            IntToStr(TResEvalUInt(RValue).UInt),'0',IntToStr(High(QWord)),RHS);
+      revkUInt: ;
+      else
+        RaiseNotYetImplemented(20170530094311,RHS);
+      end
+    else if RValue.Kind=revkNil then
+      // simple type check is enough
+    else if RValue.Kind=revkBool then
+      // simple type check is enough
+    else
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.CheckAssignExprRange LeftResolved=',GetResolverResultDbg(LeftResolved));
+      {$ENDIF}
+      RaiseNotYetImplemented(20170530095243,RHS);
+      end;
+  finally
+    ReleaseEvalValue(RValue);
+  end;
+end;
+
+function TPasResolver.CheckAssignResCompatibility(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+var
+  TypeEl: TPasType;
+  Handled: Boolean;
+  C: TClass;
+  LBT, RBT: TResolverBaseType;
+begin
+  // check if the RHS can be converted to LHS
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
+  {$ENDIF}
+  Result:=-1;
+
+  Handled:=false;
+  Result:=CheckAssignCompatibilityCustom(LHS,RHS,ErrorEl,RaiseOnIncompatible,Handled);
+  if Handled and (Result>=cExact) and (Result<cIncompatible) then
+    exit;
+
+  if not Handled then
+    begin
+    LBT:=GetActualBaseType(LHS.BaseType);
+    RBT:=GetActualBaseType(RHS.BaseType);
+    if LHS.TypeEl=nil then
+      begin
+      if LBT=btUntyped then
+        begin
+        // untyped parameter
+        Result:=cTypeConversion;
+        end
+      else
+        RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
+      end
+    else if LBT=RBT then
+      begin
+      if LBT=btContext then
+        exit(CheckAssignCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
+      else
+        Result:=cExact; // same base type, maybe not same type name (e.g. longint and integer)
+      end
+    else if (LBT in btAllBooleans)
+        and (RBT in btAllBooleans) then
+      Result:=cCompatible
+    else if (LBT in btAllStringAndChars)
+        and (RBT in btAllStringAndChars) then
+      case LBT of
+      btAnsiChar:
+        Result:=cLossyConversion;
+      btWideChar:
+        if RBT=btAnsiChar then
+          Result:=cCompatible
+        else
+          Result:=cLossyConversion;
+      btAnsiString:
+        if RBT in [btAnsiChar,btShortString,btRawByteString] then
+          Result:=cCompatible
+        else
+          Result:=cLossyConversion;
+      btShortString:
+        if RBT=btAnsiChar then
+          Result:=cCompatible
+        else
+          Result:=cLossyConversion;
+      btWideString,btUnicodeString:
+        Result:=cCompatible;
+      btRawByteString:
+        if RBT in [btAnsiChar,btAnsiString,btShortString] then
+          Result:=cCompatible
+        else
+          Result:=cLossyConversion;
+      else
+        RaiseNotYetImplemented(20170417195208,ErrorEl,BaseTypeNames[LBT]);
+      end
+    else if (LBT in btAllInteger)
+        and (RBT in btAllInteger) then
+      begin
+      Result:=cIntToIntConversion+ord(LBT)-ord(RBT);
+      case LBT of
+      btByte,
+      btShortInt: inc(Result,cLossyConversion);
+      btWord,
+      btSmallInt:
+        if not (RBT in [btByte,btShortInt]) then
+          inc(Result,cLossyConversion);
+      btUIntSingle:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt]) then
+          inc(Result,cLossyConversion);
+      btIntSingle:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle]) then
+          inc(Result,cLossyConversion);
+      btLongWord,
+      btLongint:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle]) then
+          inc(Result,cLossyConversion);
+      btUIntDouble:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint]) then
+          inc(Result,cLossyConversion);
+      btIntDouble:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,btUIntDouble]) then
+          inc(Result,cLossyConversion);
+      btQWord,
+      btInt64,btComp:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,btUIntSingle,btIntSingle,
+            btLongWord,btLongint,btUIntDouble,btIntDouble]) then
+          inc(Result,cLossyConversion);
+      else
+        RaiseNotYetImplemented(20170417205301,ErrorEl,BaseTypeNames[LBT]);
+      end;
+      end
+    else if (LBT in btAllFloats)
+        and (RBT in (btAllFloats+btAllInteger)) then
+      begin
+      Result:=cToFloatConversion+ord(LBT)-ord(RBT);
+      case LBT of
+      btSingle:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
+            btIntSingle,btUIntSingle]) then
+          inc(Result,cLossyConversion);
+      btDouble:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
+            btIntSingle,btUIntSingle,btSingle,
+            btLongWord,btLongint,
+            btIntDouble,btUIntDouble]) then
+          inc(Result,cLossyConversion);
+      btExtended,btCExtended:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
+            btIntSingle,btUIntSingle,btSingle,
+            btLongWord,btLongint,
+            btInt64,btComp,
+            btIntDouble,btUIntDouble,btDouble]) then
+          inc(Result,cLossyConversion);
+      btCurrency:
+        if not (RBT in [btByte,btShortInt,btWord,btSmallInt,
+            btIntSingle,btUIntSingle,
+            btLongWord,btLongint]) then
+          inc(Result,cLossyConversion);
+      else
+        RaiseNotYetImplemented(20170417205910,ErrorEl,BaseTypeNames[LBT]);
+      end;
+      end
+    else if LBT=btNil then
+      begin
+      if RaiseOnIncompatible then
+        RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
+          [],ErrorEl);
+      exit(cIncompatible);
+      end
+    else if LBT in [btRange,btSet,btModule,btProc] then
+      begin
+      if RaiseOnIncompatible then
+        RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
+      exit(cIncompatible);
+      end
+    else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
+      begin
+      if RaiseOnIncompatible then
+        RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
+      exit(cIncompatible);
+      end
+    else if RBT=btNil then
+      begin
+      if LBT=btPointer then
+        Result:=cExact
+      else if LBT=btContext then
+        begin
+        TypeEl:=LHS.TypeEl;
+        C:=TypeEl.ClassType;
+        if (C=TPasClassType)
+            or (C=TPasClassOfType)
+            or (C=TPasPointerType)
+            or C.InheritsFrom(TPasProcedureType)
+            or IsDynArray(TypeEl) then
+          Result:=cExact;
+        end;
+      end
+    else if (LBT=btSet) and (RBT=btSet) then
+      begin
+      if RHS.TypeEl=nil then
+        Result:=cExact // empty set
+      else if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+[btChar])) then
+        Result:=cExact
+      else if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
+          or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
+        Result:=cCompatible
+      else if (LHS.SubType=btContext) and (LHS.TypeEl is TPasEnumType)
+          and (LHS.TypeEl=RHS.TypeEl) then
+        Result:=cExact;
+      end
+    else if RBT=btProc then
+      begin
+      if (msDelphi in CurrentParser.CurrentModeswitches)
+          and (LHS.TypeEl is TPasProcedureType)
+          and (RHS.IdentEl is TPasProcedure) then
+        begin
+        // for example  ProcVar:=Proc
+        if CheckProcTypeCompatibility(TPasProcedureType(LHS.TypeEl),
+            TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
+          Result:=cExact;
+        end;
+      end
+    else if LBT=btPointer then
+      begin
+      if RBT=btPointer then
+        begin
+        if IsBaseType(LHS.TypeEl,btPointer) then
+          Result:=cExact // btPointer can take any pointer
+        else if IsBaseType(RHS.TypeEl,btPointer) then
+          Result:=cTypeConversion // any pointer can take a btPointer
+        else if IsSameType(LHS.TypeEl,RHS.TypeEl) then
+          Result:=cExact // pointer of same type
+        else if (LHS.TypeEl.ClassType=TPasPointerType)
+            and (RHS.TypeEl.ClassType=TPasPointerType) then
+          Result:=CheckAssignCompatibility(TPasPointerType(LHS.TypeEl).DestType,
+            TPasPointerType(RHS.TypeEl).DestType,RaiseOnIncompatible);
+        end
+      else if IsBaseType(LHS.TypeEl,btPointer) then
+        begin
+        if RBT=btContext then
+          begin
+          C:=RHS.TypeEl.ClassType;
+          if C=TPasClassType then
+            exit(cTypeConversion) // class type or class instance
+          else if C=TPasClassOfType then
+            Result:=cTypeConversion
+          else if C=TPasArrayType then
+            begin
+            if IsDynArray(RHS.TypeEl) then
+              Result:=cTypeConversion;
+            end
+          else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+            // pointer:=procvar
+            Result:=cLossyConversion;
+          end;
+        end;
+      end
+    else if (LBT=btContext) and (LHS.TypeEl is TPasArrayType) then
+      Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
+    end;
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
+  {$ENDIF}
+  if (Result>=0) and (Result<cIncompatible) then
+    begin
+    // type fits -> check readable
+    if not (rrfReadable in RHS.Flags) then
+      begin
+      if RaiseOnIncompatible then
+        RaiseMsg(20170318235637,nVariableIdentifierExpected,
+          sVariableIdentifierExpected,[],ErrorEl);
+      exit(cIncompatible);
+      end;
+    exit;
+    end;
+
+  // incompatible
+  if not RaiseOnIncompatible then
+    exit(cIncompatible);
+
+  // create error messages
+  RaiseIncompatibleTypeRes(20170216152437,nIncompatibleTypesGotExpected,
+    [],RHS,LHS,ErrorEl);
+end;
+
+function TPasResolver.CheckEqualElCompatibility(Left, Right: TPasElement;
+  ErrorEl: TPasElement; RaiseOnIncompatible: boolean; SetReferenceFlags: boolean
+  ): integer;
+// check if the RightResolved is type compatible to LeftResolved
+var
+  LFlags, RFlags: TPasResolverComputeFlags;
+  LeftResolved, RightResolved: TPasResolverResult;
+  LeftErrorEl, RightErrorEl: TPasElement;
+begin
+  Result:=cIncompatible;
+  // Delphi resolves both sides, so it forbids "if procvar=procvar then"
+  // FPC is more clever. It supports "if procvar=@proc then", "function=value"
+  if msDelphi in CurrentParser.CurrentModeswitches then
+    LFlags:=[]
+  else
+    LFlags:=[rcNoImplicitProcType];
+  if SetReferenceFlags then
+    Include(LFlags,rcSetReferenceFlags);
+  ComputeElement(Left,LeftResolved,LFlags);
+
+  if (msDelphi in CurrentParser.CurrentModeswitches) then
+    RFlags:=LFlags
+  else
+    begin
+    if LeftResolved.BaseType=btNil then
+      RFlags:=[rcNoImplicitProcType]
+    else if IsProcedureType(LeftResolved,true) then
+      RFlags:=[rcNoImplicitProcType]
+    else
+      RFlags:=[];
+    end;
+  if SetReferenceFlags then
+    Include(RFlags,rcSetReferenceFlags);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckEqualElCompatibility LFlags=',dbgs(LFlags),' Left=',GetResolverResultDbg(LeftResolved),' Delphi=',msDelphi in CurrentParser.CurrentModeswitches,' RFlags=',dbgs(RFlags));
+  {$ENDIF}
+  ComputeElement(Right,RightResolved,RFlags);
+  if ErrorEl=nil then
+    begin
+    LeftErrorEl:=Left;
+    RightErrorEl:=Right;
+    end
+  else
+    begin
+    LeftErrorEl:=ErrorEl;
+    RightErrorEl:=ErrorEl;
+    end;
+  Result:=CheckEqualResCompatibility(LeftResolved,RightResolved,LeftErrorEl,
+    RaiseOnIncompatible,RightErrorEl);
+end;
+
+function TPasResolver.CheckEqualResCompatibility(const LHS,
+  RHS: TPasResolverResult; LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
+  RErrorEl: TPasElement): integer;
+var
+  TypeEl: TPasType;
+  ok: Boolean;
+begin
+  Result:=cIncompatible;
+  if RErrorEl=nil then RErrorEl:=LErrorEl;
+  // check if the RHS is type compatible to LHS
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckEqualCompatibility LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
+  {$ENDIF}
+  if not (rrfReadable in LHS.Flags) then
+    begin
+    ok:=false;
+    if (LHS.BaseType=btContext) and (LHS.TypeEl.ClassType=TPasClassType)
+        and (LHS.IdentEl=LHS.TypeEl) then
+      begin
+      if RHS.BaseType=btNil then
+        ok:=true
+      else if (RHS.BaseType=btContext) and (RHS.TypeEl.ClassType=TPasClassOfType)
+          and (rrfReadable in RHS.Flags) then
+        // for example  if TImage=ImageClass then
+        ok:=true;
+      end;
+    if not ok then
+      RaiseMsg(20170216152438,nNotReadable,sNotReadable,[],LErrorEl);
+    end;
+  if not (rrfReadable in RHS.Flags) then
+    begin
+    ok:=false;
+    if (RHS.BaseType=btContext) and (RHS.TypeEl.ClassType=TPasClassType)
+        and (RHS.IdentEl=RHS.TypeEl) then
+      begin
+      if LHS.BaseType=btNil then
+        ok:=true
+      else if (LHS.BaseType=btContext) and (LHS.TypeEl.ClassType=TPasClassOfType)
+          and (rrfReadable in LHS.Flags) then
+        // for example  if ImageClass=TImage then
+        ok:=true;
+      end;
+    if not ok then
+      RaiseMsg(20170216152440,nNotReadable,sNotReadable,[],RErrorEl);
+    end;
+
+  if (LHS.BaseType=btCustom) or (RHS.BaseType=btCustom) then
+    begin
+    Result:=CheckEqualCompatibilityCustomType(LHS,RHS,LErrorEl,RaiseOnIncompatible);
+    if (Result=cIncompatible) and RaiseOnIncompatible then
+      RaiseIncompatibleTypeRes(20170330010727,nIncompatibleTypesGotExpected,
+        [],RHS,LHS,LErrorEl);
+    exit;
+    end
+  else if LHS.BaseType=RHS.BaseType then
+    begin
+    if LHS.BaseType=btContext then
+      exit(CheckEqualCompatibilityUserType(LHS,RHS,LErrorEl,RaiseOnIncompatible))
+    else
+      exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
+    end
+  else if (LHS.BaseType in btAllInteger+btAllFloats)
+      and (RHS.BaseType in btAllInteger+btAllFloats) then
+    exit(cCompatible)
+  else if (LHS.BaseType in btAllBooleans)
+      and (RHS.BaseType in btAllBooleans) then
+    exit(cCompatible)
+  else if (LHS.BaseType in btAllStringAndChars)
+      and (RHS.BaseType in btAllStringAndChars) then
+    exit(cCompatible)
+  else if LHS.BaseType=btNil then
+    begin
+      if RHS.BaseType in [btPointer,btNil] then
+        exit(cExact)
+      else if RHS.BaseType=btContext then
+        begin
+        TypeEl:=RHS.TypeEl;
+        if (TypeEl.ClassType=TPasClassType)
+            or (TypeEl.ClassType=TPasClassOfType)
+            or (TypeEl.ClassType=TPasPointerType)
+            or (TypeEl is TPasProcedureType)
+            or IsDynArray(TypeEl) then
+          exit(cExact);
+        end;
+      if RaiseOnIncompatible then
+        RaiseIncompatibleTypeRes(20170216152442,nIncompatibleTypesGotExpected,
+          [],RHS,LHS,RErrorEl)
+      else
+        exit(cIncompatible);
+    end
+  else if RHS.BaseType=btNil then
+    begin
+      if LHS.BaseType=btPointer then
+        exit(cExact)
+      else if LHS.BaseType=btContext then
+        begin
+        TypeEl:=LHS.TypeEl;
+        if (TypeEl.ClassType=TPasClassType)
+            or (TypeEl.ClassType=TPasClassOfType)
+            or (TypeEl.ClassType=TPasPointerType)
+            or (TypeEl is TPasProcedureType)
+            or IsDynArray(TypeEl) then
+          exit(cExact);
+        end;
+      if RaiseOnIncompatible then
+        RaiseIncompatibleTypeRes(20170216152444,nIncompatibleTypesGotExpected,
+          [],LHS,RHS,LErrorEl)
+      else
+        exit(cIncompatible);
+    end
+  else if LHS.BaseType=btSet then
+    begin
+    if RHS.BaseType=btSet then
+      begin
+      if LHS.TypeEl=nil then
+        exit(cExact); // empty set
+      if RHS.TypeEl=nil then
+        exit(cExact); // empty set
+      if LHS.TypeEl=RHS.TypeEl then
+        exit(cExact);
+      if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+[btChar])) then
+        exit(cExact);
+      if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
+          or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
+        exit(cCompatible);
+      if RaiseOnIncompatible then
+        RaiseMsg(20170216152446,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          ['set of '+BaseTypeNames[LHS.SubType],'set of '+BaseTypeNames[RHS.SubType]],LErrorEl)
+      else
+        exit(cIncompatible);
+      end;
+    end
+  else if RaiseOnIncompatible then
+    RaiseIncompatibleTypeRes(20170216152449,nIncompatibleTypesGotExpected,
+      [],RHS,LHS,RErrorEl)
+  else
+    exit(cIncompatible);
+  RaiseNotYetImplemented(20161007101041,LErrorEl,'LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
+end;
+
+function TPasResolver.ResolvedElCanBeVarParam(
+  const ResolvedEl: TPasResolverResult): boolean;
+begin
+  Result:=false;
+  if [rrfReadable,rrfWritable]*ResolvedEl.Flags<>[rrfReadable,rrfWritable] then
+    exit;
+  if ResolvedEl.IdentEl=nil then exit;
+  if ResolvedEl.IdentEl.ClassType=TPasVariable then
+    exit(true);
+  if (ResolvedEl.IdentEl.ClassType=TPasArgument) then
+    begin
+    Result:=(TPasArgument(ResolvedEl.IdentEl).Access in [argDefault, argVar, argOut]);
+    exit;
+    end;
+  if ResolvedEl.IdentEl.ClassType=TPasResultElement then
+    exit(true);
+  if (ResolvedEl.IdentEl.ClassType=TPasConst) then
+    begin
+    // typed const are writable
+    Result:=(TPasConst(ResolvedEl.IdentEl).VarType<>nil);
+    exit;
+    end;
+  if (proPropertyAsVarParam in Options)
+      and (ResolvedEl.IdentEl.ClassType=TPasProperty) then
+    exit(true);
+end;
+
+function TPasResolver.ResolvedElIsClassInstance(
+  const ResolvedEl: TPasResolverResult): boolean;
+begin
+  Result:=false;
+  if ResolvedEl.BaseType<>btContext then exit;
+  if ResolvedEl.TypeEl=nil then exit;
+  if ResolvedEl.TypeEl.ClassType<>TPasClassType then exit;
+  if (ResolvedEl.IdentEl is TPasVariable)
+      or (ResolvedEl.IdentEl.ClassType=TPasArgument)
+      or (ResolvedEl.IdentEl.ClassType=TPasResultElement) then
+    exit(true);
+end;
+
+function TPasResolver.GetProcTypeDescription(ProcType: TPasProcedureType;
+  UseName: boolean; AddPaths: boolean): string;
+var
+  Args: TFPList;
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  if ProcType=nil then exit('nil');
+  Result:=ProcType.TypeName;
+  if ProcType.IsReferenceTo then
+    Result:=ProcTypeModifiers[ptmReferenceTo]+' '+Result;
+  if UseName and (ProcType.Parent is TPasProcedure) then
+    begin
+    if AddPaths then
+      Result:=Result+' '+ProcType.Parent.FullName
+    else
+      Result:=Result+' '+ProcType.Parent.Name;
+    end;
+  Args:=ProcType.Args;
+  if Args.Count>0 then
+    begin
+    Result:=Result+'(';
+    for i:=0 to Args.Count-1 do
+      begin
+      if i>0 then Result:=Result+';';
+      Arg:=TPasArgument(Args[i]);
+      if AccessNames[Arg.Access]<>'' then
+        Result:=Result+AccessNames[Arg.Access];
+      if Arg.ArgType=nil then
+        Result:=Result+'untyped'
+      else
+        Result:=Result+GetTypeDescription(Arg.ArgType,AddPaths);
+      end;
+    Result:=Result+')';
+    end;
+  if ProcType.IsOfObject then
+    Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
+  if ProcType.IsNested then
+    Result:=Result+' '+ProcTypeModifiers[ptmIsNested];
+  if cCallingConventions[ProcType.CallingConvention]<>'' then
+    Result:=Result+';'+cCallingConventions[ProcType.CallingConvention];
+end;
+
+function TPasResolver.GetResolverResultDescription(const T: TPasResolverResult;
+  OnlyType: boolean): string;
+
+  function GetSubTypeName: string;
+  begin
+    if (T.TypeEl<>nil) and (T.TypeEl.Name<>'') then
+      Result:=T.TypeEl.Name
+    else
+      Result:=BaseTypeNames[T.SubType];
+  end;
+
+var
+  ArrayEl: TPasArrayType;
+begin
+  case T.BaseType of
+  btModule: exit(T.IdentEl.ElementTypeName+' '+T.IdentEl.Name);
+  btNil: exit('nil');
+  btRange:
+    Result:='range of '+GetSubTypeName;
+  btSet:
+    Result:='set/array literal of '+GetSubTypeName;
+  btContext:
+    begin
+    if T.TypeEl.ClassType=TPasClassOfType then
+      Result:='class of '+TPasClassOfType(T.TypeEl).DestType.Name
+    else if T.TypeEl.ClassType=TPasAliasType then
+      Result:=TPasAliasType(T.TypeEl).DestType.Name
+    else if T.TypeEl.ClassType=TPasTypeAliasType then
+      Result:='type '+TPasAliasType(T.TypeEl).DestType.Name
+    else if T.TypeEl.ClassType=TPasArrayType then
+      begin
+      ArrayEl:=TPasArrayType(T.TypeEl);
+      if length(ArrayEl.Ranges)=0 then
+        Result:='array of '+ArrayEl.ElType.Name
+      else
+        Result:='static array[] of '+ArrayEl.ElType.Name;
+      end
+    else if T.TypeEl is TPasProcedureType then
+      Result:=GetProcTypeDescription(TPasProcedureType(T.TypeEl),false)
+    else if T.TypeEl.Name<>'' then
+      Result:=T.TypeEl.Name
+    else
+      Result:=T.TypeEl.ElementTypeName;
+    end;
+  btCustom:
+    Result:=T.TypeEl.Name;
+  else
+    Result:=BaseTypeNames[T.BaseType];
+  end;
+  if (not OnlyType) and (T.TypeEl<>T.IdentEl) and (T.IdentEl<>nil) then
+    Result:=T.IdentEl.Name+':'+Result;
+end;
+
+function TPasResolver.GetTypeDescription(aType: TPasType; AddPath: boolean): string;
+
+  function GetName: string;
+  var
+    s: String;
+  begin
+    Result:=aType.Name;
+    if Result='' then
+      Result:=aType.ElementTypeName;
+    if AddPath then
+      begin
+      s:=aType.FullPath;
+      if (s<>'') and (s<>'.') then
+        Result:=s+'.'+Result;
+      end;
+  end;
+
+var
+  C: TClass;
+begin
+  if aType=nil then exit('untyped');
+  C:=aType.ClassType;
+  if (C=TPasUnresolvedSymbolRef) then
+    begin
+    Result:=GetName;
+    if TPasUnresolvedSymbolRef(aType).CustomData is TResElDataBuiltInProc then
+      Result:=Result+'()';
+    exit;
+    end
+  else if (C=TPasUnresolvedTypeRef) then
+    Result:=GetName
+  else
+    Result:=GetName;
+end;
+
+function TPasResolver.GetTypeDescription(const R: TPasResolverResult;
+  AddPath: boolean): string;
+begin
+  Result:=GetTypeDescription(R.TypeEl,AddPath);
+  if R.IdentEl=R.TypeEl then
+    begin
+    if R.TypeEl.ElementTypeName<>'' then
+      Result:=R.TypeEl.ElementTypeName+' '+Result
+    else
+      Result:='type '+Result;
+    end;
+end;
+
+function TPasResolver.GetBaseDescription(const R: TPasResolverResult;
+  AddPath: boolean): string;
+begin
+  if R.BaseType=btContext then
+    Result:=GetTypeDescription(R,AddPath)
+  else
+    Result:=BaseTypeNames[R.BaseType];
+end;
+
+function TPasResolver.GetPasPropertyType(El: TPasProperty): TPasType;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    if El.VarType<>nil then
+      exit(El.VarType);
+    El:=GetPasPropertyAncestor(El);
+    end;
+end;
+
+function TPasResolver.GetPasPropertyAncestor(El: TPasProperty;
+  WithRedeclarations: boolean): TPasProperty;
+begin
+  Result:=nil;
+  if El=nil then exit;
+  if (not WithRedeclarations) and (El.VarType<>nil) then exit;
+  if El.CustomData=nil then exit;
+  Result:=TPasPropertyScope(El.CustomData).AncestorProp;
+end;
+
+function TPasResolver.GetPasPropertyGetter(El: TPasProperty): TPasElement;
+// search the member variable or getter function of a property
+var
+  DeclEl: TPasElement;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    if El.ReadAccessor<>nil then
+      begin
+      DeclEl:=(El.ReadAccessor.CustomData as TResolvedReference).Declaration;
+      Result:=DeclEl;
+      exit;
+      end;
+    El:=GetPasPropertyAncestor(El);
+    end;
+end;
+
+function TPasResolver.GetPasPropertySetter(El: TPasProperty): TPasElement;
+// search the member variable or setter procedure of a property
+var
+  DeclEl: TPasElement;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    if El.WriteAccessor<>nil then
+      begin
+      DeclEl:=(El.WriteAccessor.CustomData as TResolvedReference).Declaration;
+      Result:=DeclEl;
+      exit;
+      end;
+    El:=GetPasPropertyAncestor(El);
+    end;
+end;
+
+function TPasResolver.GetPasPropertyStored(El: TPasProperty): TPasElement;
+// search the member variable or setter procedure of a property
+var
+  DeclEl: TPasElement;
+begin
+  Result:=nil;
+  while El<>nil do
+    begin
+    if El.StoredAccessor<>nil then
+      begin
+      DeclEl:=(El.StoredAccessor.CustomData as TResolvedReference).Declaration;
+      Result:=DeclEl;
+      exit;
+      end;
+    El:=GetPasPropertyAncestor(El);
+    end;
+end;
+
+function TPasResolver.CheckParamCompatibility(Expr: TPasExpr;
+  Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean;
+  SetReferenceFlags: boolean): integer;
+var
+  ExprResolved, ParamResolved: TPasResolverResult;
+  NeedVar: Boolean;
+  RHSFlags: TPasResolverComputeFlags;
+begin
+  Result:=cIncompatible;
+
+  NeedVar:=Param.Access in [argVar, argOut];
+
+  ComputeElement(Param,ParamResolved,[]);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckParamCompatibility Param=',GetTreeDbg(Param,2),' ParamResolved=',GetResolverResultDbg(ParamResolved));
+  {$ENDIF}
+  if (ParamResolved.TypeEl=nil) and (Param.ArgType<>nil) then
+    RaiseInternalError(20160922163628,'GetResolvedType returned TypeEl=nil for '+GetTreeDbg(Param));
+
+  if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
+    begin
+    // passing a const set
+    if NeedVar then
+      begin
+      if RaiseOnError then
+        RaiseMsg(20170216152450,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
+      exit;
+      end;
+    if ParamResolved.TypeEl is TPasArrayType then
+      begin
+      Result:=CheckConstArrayCompatibility(TParamsExpr(Expr),ParamResolved,
+                                           RaiseOnError,[],Expr);
+      if (Result=cIncompatible) and RaiseOnError then
+        RaiseInternalError(20170326211129);
+      exit;
+      end;
+    end;
+
+  RHSFlags:=[];
+  if NeedVar then
+    Include(RHSFlags,rcNoImplicitProc)
+  else if IsProcedureType(ParamResolved,true)
+      or (ParamResolved.BaseType=btPointer)
+      or (Param.ArgType=nil)  then
+    Include(RHSFlags,rcNoImplicitProcType);
+  if SetReferenceFlags then
+    Include(RHSFlags,rcSetReferenceFlags);
+  ComputeElement(Expr,ExprResolved,RHSFlags);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckParamCompatibility Expr=',GetTreeDbg(Expr,2),' ResolvedExpr=',GetResolverResultDbg(ExprResolved),' RHSFlags=',dbgs(RHSFlags));
+  {$ENDIF}
+
+  if NeedVar then
+    begin
+    // Expr must be a variable
+    if not ResolvedElCanBeVarParam(ExprResolved) then
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.CheckParamCompatibility NeedWritable: ',GetResolverResultDbg(ExprResolved));
+      {$ENDIF}
+      if RaiseOnError then
+        RaiseMsg(20170216152450,nVariableIdentifierExpected,sVariableIdentifierExpected,[],Expr);
+      exit;
+      end;
+    if (ParamResolved.BaseType=ExprResolved.BaseType) then
+      begin
+      if IsSameType(ParamResolved.TypeEl,ExprResolved.TypeEl) then
+        exit(cExact);
+      end;
+    if (Param.ArgType=nil) then
+      exit(cExact); // untyped argument
+    if RaiseOnError then
+      RaiseIncompatibleType(20170216152452,nIncompatibleTypeArgNoVarParamMustMatchExactly,
+        [IntToStr(ParamNo+1)],ExprResolved.TypeEl,ParamResolved.TypeEl,
+        Expr);
+    exit(cIncompatible);
+    end;
+
+  Result:=CheckAssignResCompatibility(ParamResolved,ExprResolved,Expr,false);
+  if (Result=cIncompatible) and RaiseOnError then
+    RaiseIncompatibleTypeRes(20170216152454,nIncompatibleTypeArgNo,
+      [IntToStr(ParamNo+1)],ExprResolved,ParamResolved,Expr);
+end;
+
+function TPasResolver.CheckAssignCompatibilityUserType(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+var
+  RTypeEl, LTypeEl: TPasType;
+  SrcResolved, DstResolved: TPasResolverResult;
+  LArray, RArray: TPasArrayType;
+
+  function RaiseIncompatType: integer;
+  begin
+    if not RaiseOnIncompatible then exit(cIncompatible);
+    RaiseIncompatibleTypeRes(20170216152505,nIncompatibleTypesGotExpected,
+      [],RHS,LHS,ErrorEl);
+  end;
+
+begin
+  if (RHS.TypeEl=nil) then
+    RaiseInternalError(20160922163645);
+  if (LHS.TypeEl=nil) then
+    RaiseInternalError(20160922163648);
+  LTypeEl:=LHS.TypeEl;
+  RTypeEl:=RHS.TypeEl;
+  if LTypeEl=RTypeEl then
+    exit(cExact);
+
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
+  {$ENDIF}
+  Result:=-1;
+  if LTypeEl.ClassType=TPasClassType then
+    begin
+    if RHS.BaseType=btNil then
+      Result:=cExact
+    else if RTypeEl.ClassType=TPasClassType then
+      begin
+      Result:=CheckSrcIsADstType(RHS,LHS,ErrorEl);
+      if (Result=cIncompatible) and RaiseOnIncompatible then
+        RaiseIncompatibleType(20170216152458,nIncompatibleTypesGotExpected,
+          [],RTypeEl,LTypeEl,ErrorEl);
+      end
+    else
+      exit(RaiseIncompatType);
+    end
+  else if LTypeEl.ClassType=TPasClassOfType then
+    begin
+    if RHS.BaseType=btNil then
+      Result:=cExact
+    else if (RTypeEl.ClassType=TPasClassOfType) then
+      begin
+      // e.g. ImageClass:=AnotherImageClass;
+      Result:=CheckClassIsClass(TPasClassOfType(RTypeEl).DestType,
+        TPasClassOfType(LTypeEl).DestType,ErrorEl);
+      if (Result=cIncompatible) and RaiseOnIncompatible then
+        RaiseMsg(20170216152500,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          ['class of '+TPasClassOfType(RTypeEl).DestType.FullName,'class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
+      end
+    else if (RHS.IdentEl is TPasClassType) then
+      begin
+      // e.g. ImageClass:=TFPMemoryImage;
+      Result:=CheckClassIsClass(RTypeEl,TPasClassOfType(LTypeEl).DestType,ErrorEl);
+      if (Result=cIncompatible) and RaiseOnIncompatible then
+        RaiseMsg(20170216152501,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [RTypeEl.Name,'class of '+TPasClassOfType(LTypeEl).DestType.FullName],ErrorEl);
+      // do not check rrfReadable -> exit
+      exit;
+      end;
+    end
+  else if LTypeEl is TPasProcedureType then
+    begin
+    if RHS.BaseType=btNil then
+      exit(cExact);
+    //writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RHS.BaseType=',BaseTypeNames[RHS.BaseType],' RTypeEl=',GetObjName(RTypeEl),' RHS.IdentEl=',GetObjName(RHS.IdentEl),' RHS.ExprEl=',GetObjName(RHS.ExprEl),' rrfReadable=',rrfReadable in RHS.Flags);
+    if (LTypeEl.ClassType=RTypeEl.ClassType)
+        and (rrfReadable in RHS.Flags) then
+      begin
+      // e.g. ProcVar1:=ProcVar2
+      if CheckProcTypeCompatibility(TPasProcedureType(LTypeEl),TPasProcedureType(RTypeEl),
+          true,ErrorEl,RaiseOnIncompatible) then
+        exit(cExact);
+      end;
+    if RaiseOnIncompatible then
+      begin
+      if (RTypeEl is TPasProcedureType) and (rrfReadable in RHS.Flags) then
+        RaiseMsg(20170404154738,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+          [RTypeEl.ElementTypeName,LTypeEl.ElementTypeName],ErrorEl);
+      end;
+    end
+  else if LTypeEl.ClassType=TPasArrayType then
+    begin
+    // arrays of different types
+    if IsOpenArray(LTypeEl) and (RTypeEl.ClassType=TPasArrayType) then
+      begin
+      LArray:=TPasArrayType(LTypeEl);
+      RArray:=TPasArrayType(RTypeEl);
+      if length(LArray.Ranges)=length(RArray.Ranges) then
+        begin
+        if CheckProcArgTypeCompatibility(LArray.ElType,RArray.ElType) then
+          Result:=cExact
+        else if RaiseOnIncompatible then
+          RaiseMsg(20170328110050,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+            ['array of '+LArray.ElType.FullName,
+             'array of '+RArray.ElType.FullName],ErrorEl)
+        else
+          exit(cIncompatible);
+        end;
+      end;
+    end
+  else if RTypeEl.ClassType=TPasEnumType then
+    begin
+    // enums of different type
+    end
+  else if RTypeEl.ClassType=TPasSetType then
+    begin
+    // sets of different type are compatible if enum types are compatible
+    if LTypeEl.ClassType=TPasSetType then
+      begin
+      ComputeElement(TPasSetType(LTypeEl).EnumType,DstResolved,[]);
+      ComputeElement(TPasSetType(RTypeEl).EnumType,SrcResolved,[]);
+      if (SrcResolved.TypeEl<>nil)
+      and (SrcResolved.TypeEl=DstResolved.TypeEl) then
+        Result:=cExact
+      else if (SrcResolved.TypeEl.CustomData is TResElDataBaseType)
+          and (DstResolved.TypeEl.CustomData is TResElDataBaseType)
+          and (CompareText(SrcResolved.TypeEl.Name,DstResolved.TypeEl.Name)=0) then
+        Result:=cExact
+      else if RaiseOnIncompatible then
+        RaiseIncompatibleTypeRes(20170216152510,nIncompatibleTypesGotExpected,
+          [],SrcResolved,DstResolved,ErrorEl)
+      else
+        exit(cIncompatible);
+      end
+    else
+      exit(RaiseIncompatType);
+    end
+  else
+    RaiseNotYetImplemented(20160922163654,ErrorEl);
+
+  if Result=-1 then
+    exit(RaiseIncompatType);
+  if not (rrfReadable in RHS.Flags) then
+    exit(RaiseIncompatType);
+end;
+
+function TPasResolver.CheckAssignCompatibilityArrayType(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+
+  procedure CheckRange(ArrType: TPasArrayType; RangeIndex: integer;
+    Values: TPasResolverResult; ErrorEl: TPasElement);
+  var
+    Range, Value, Expr: TPasExpr;
+    RangeResolved, ValueResolved, ElTypeResolved: TPasResolverResult;
+    i, Count: Integer;
+    IsLastRange: Boolean;
+    ArrayValues: TPasExprArray;
+  begin
+    if length(ArrType.Ranges)=0 then
+      begin
+      if (Values.ExprEl<>nil) then
+        begin
+        Expr:=Values.ExprEl;
+        if Expr.ClassType=TArrayValues then
+          Count:=length(TArrayValues(Expr).Values)
+        else if (Expr.ClassType=TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
+          Count:=length(TParamsExpr(Expr).Params)
+        else if (Values.BaseType in btAllStringAndChars) and IsVarInit(Expr) then
+          begin
+          // const a: dynarray = string
+          ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
+          if ElTypeResolved.BaseType in btAllChars then
+            Result:=cExact;
+          exit;
+          end
+        else
+          begin
+          // single value
+          exit;
+          end;
+        end;
+      IsLastRange:=true;
+      end
+    else
+      begin
+      Range:=ArrType.Ranges[RangeIndex];
+      ComputeElement(Range,RangeResolved,[rcConstant]);
+      Count:=GetRangeLength(RangeResolved);
+      if Count=0 then
+        RaiseNotYetImplemented(20170222232409,Values.ExprEl,'range '+GetResolverResultDbg(RangeResolved));
+      IsLastRange:=RangeIndex+1=length(ArrType.Ranges);
+      end;
+
+    if IsLastRange then
+      begin
+      ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
+      ElTypeResolved.IdentEl:=Range;
+      Include(ElTypeResolved.Flags,rrfWritable);
+      end
+    else
+      ElTypeResolved.BaseType:=btNone;
+
+    if (Values.ExprEl<>nil) and (Values.ExprEl.ClassType=TArrayValues) then
+      begin
+      ArrayValues:=TArrayValues(Values.ExprEl).Values;
+      // check each value
+      for i:=0 to Count-1 do
+        begin
+        if i=length(ArrayValues) then
+          begin
+          // not enough values
+          if length(ArrayValues)>0 then
+            ErrorEl:=ArrayValues[length(ArrayValues)-1];
+          RaiseMsg(20170222233001,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
+            [IntToStr(Count),IntToStr(length(ArrayValues))],ErrorEl);
+          end;
+        Value:=ArrayValues[i];
+        ComputeElement(Value,ValueResolved,[rcConstant]);
+        if IsLastRange then
+          begin
+          // last dimension -> check element type
+          Result:=CheckAssignResCompatibility(ElTypeResolved,ValueResolved,Value,RaiseOnIncompatible);
+          if Result=cIncompatible then
+            exit;
+          end
+        else
+          begin
+          // multi dimensional array -> check next range
+          CheckRange(ArrType,RangeIndex+1,ValueResolved,Value);
+          end;
+        end;
+      if Count<length(ArrayValues) then
+        begin
+        // too many values
+        ErrorEl:=ArrayValues[Count];
+        if RaiseOnIncompatible then
+          RaiseMsg(20170222233605,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
+            [IntToStr(Count),IntToStr(length(ArrayValues))],ErrorEl);
+        exit;
+        end;
+      end
+    else
+      begin
+      // single value
+      // Note: the parser does not store the difference between (1) and 1
+      if (not IsLastRange) or (Count>1) then
+        begin
+        if RaiseOnIncompatible then
+          RaiseMsg(20170223095307,nExpectXArrayElementsButFoundY,sExpectXArrayElementsButFoundY,
+            [IntToStr(Count),'1'],ErrorEl);
+        exit;
+        end;
+      // check element type
+      Result:=CheckAssignResCompatibility(ElTypeResolved,Values,ErrorEl,RaiseOnIncompatible);
+      if Result=cIncompatible then
+        exit;
+      end;
+  end;
+
+var
+  LArrType: TPasArrayType;
+begin
+  Result:=cIncompatible;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckAssignCompatibilityArrayType LHS=',GetResolverResultDbg(LHS),' RHS=',GetResolverResultDbg(RHS));
+  {$ENDIF}
+  if (LHS.BaseType<>btContext) or (not (LHS.TypeEl is TPasArrayType)) then
+    RaiseInternalError(20170222230012);
+  if not (rrfReadable in RHS.Flags) then
+    exit;
+  LArrType:=TPasArrayType(LHS.TypeEl);
+  if RHS.ExprEl=nil then
+    exit;
+  if IsEmptySet(RHS) then
+    begin
+    if length(LArrType.Ranges)=0 then
+      exit(cExact); // empty set fits dyn and open array
+    end;
+
+  CheckRange(LArrType,0,RHS,ErrorEl);
+end;
+
+function TPasResolver.CheckConstArrayCompatibility(Params: TParamsExpr;
+  const ArrayResolved: TPasResolverResult; RaiseOnError: boolean;
+  Flags: TPasResolverComputeFlags; StartEl: TPasElement): integer;
+// check that each Param fits the array element type
+var
+  i, ParamComp: Integer;
+  Param: TPasExpr;
+  ArrayType: TPasArrayType;
+  ElTypeResolved, ParamResolved: TPasResolverResult;
+  ElTypeIsArray: boolean;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckConstArrayCompatibility Params.length=',length(Params.Params),
+    ' ArrayResolved=',GetResolverResultDbg(ArrayResolved),' Flags=',dbgs(Flags));
+  {$ENDIF}
+  if not (ArrayResolved.TypeEl is TPasArrayType) then
+    RaiseInternalError(20170326204957);
+  ArrayType:=TPasArrayType(ArrayResolved.TypeEl);
+  ComputeElement(ArrayType.ElType,ElTypeResolved,Flags+[rcType]);
+  ElTypeIsArray:=ResolveAliasType(ElTypeResolved.TypeEl) is TPasArrayType;
+  Result:=cExact;
+  for i:=0 to length(Params.Params)-1 do
+    begin
+    Param:=Params.Params[i];
+    if ElTypeIsArray and (Param is TParamsExpr) and (TParamsExpr(Param).Kind=pekSet) then
+      ParamComp:=CheckConstArrayCompatibility(TParamsExpr(Param),ElTypeResolved,
+                                              RaiseOnError,Flags,StartEl)
+    else
+      begin
+      ComputeElement(Param,ParamResolved,Flags,StartEl);
+      ParamComp:=CheckAssignResCompatibility(ElTypeResolved,ParamResolved,Param,RaiseOnError);
+      end;
+    if ParamComp=cIncompatible then
+      exit(cIncompatible);
+    inc(Result,ParamComp);
+    end;
+end;
+
+function TPasResolver.CheckEqualCompatibilityUserType(const TypeA,
+  TypeB: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+var
+  ElA, ElB: TPasType;
+  AResolved, BResolved: TPasResolverResult;
+
+  function IncompatibleElements: integer;
+  begin
+    Result:=cIncompatible;
+    if not RaiseOnIncompatible then exit;
+    RaiseIncompatibleType(20170216152513,nIncompatibleTypesGotExpected,
+      [],ElA,ElB,ErrorEl);
+  end;
+
+begin
+  if (TypeA.TypeEl=nil) then
+    RaiseInternalError(20161007223118);
+  if (TypeB.TypeEl=nil) then
+    RaiseInternalError(20161007223119);
+  ElA:=TypeA.TypeEl;
+  ElB:=TypeB.TypeEl;
+  if ElA=ElB then
+    exit(cExact);
+
+  if ElA.ClassType=TPasClassType then
+    begin
+    if TypeA.IdentEl is TPasType then
+      begin
+      if (TypeB.IdentEl is TPasType) and (ElA=ElB) then
+        // e.g. if TFPMemoryImage=TFPMemoryImage then ;
+        exit(cExact);
+      if ElB.ClassType=TPasClassOfType then
+        begin
+        // e.g. if TFPMemoryImage=ImageClass then ;
+        Result:=CheckClassIsClass(ElA,TPasClassOfType(ElB).DestType,ErrorEl);
+        if (Result=cIncompatible) and RaiseOnIncompatible then
+          RaiseMsg(20170216152515,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
+        exit;
+        end;
+      end
+    else if ElB.ClassType=TPasClassType then
+      begin
+      // e.g. if Sender=Button1 then
+      Result:=CheckSrcIsADstType(TypeA,TypeB,ErrorEl);
+      if Result=cIncompatible then
+        Result:=CheckSrcIsADstType(TypeB,TypeA,ErrorEl);
+      if (Result=cIncompatible) and RaiseOnIncompatible then
+        RaiseMsg(20170216152517,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
+      exit;
+      end;
+    exit(IncompatibleElements);
+    end
+  else if ElA.ClassType=TPasClassOfType then
+    begin
+    if ElB.ClassType=TPasClassOfType then
+      begin
+      // for example: if ImageClass=ImageClass then
+      Result:=CheckClassIsClass(TPasClassOfType(ElA).DestType,
+                                TPasClassOfType(ElB).DestType,ErrorEl);
+      if Result=cIncompatible then
+        Result:=CheckClassIsClass(TPasClassOfType(ElB).DestType,
+                                  TPasClassOfType(ElA).DestType,ErrorEl);
+      if (Result=cIncompatible) and RaiseOnIncompatible then
+        RaiseMsg(20170216152519,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
+      exit;
+      end
+    else if TypeB.IdentEl is TPasClassType then
+      begin
+      // for example: if ImageClass=TFPMemoryImage then
+      Result:=CheckClassIsClass(TPasClassType(TypeB.IdentEl),TPasClassOfType(ElA).DestType,ErrorEl);
+      if (Result=cIncompatible) and RaiseOnIncompatible then
+        RaiseMsg(20170216152520,nTypesAreNotRelated,sTypesAreNotRelated,[],ErrorEl);
+      exit;
+      end;
+    exit(IncompatibleElements);
+    end
+  else if ElA.ClassType=TPasEnumType then
+    begin
+    // enums of different type
+    if not RaiseOnIncompatible then
+      exit(cIncompatible);
+    if ElB.ClassType=TPasEnumValue then
+      RaiseIncompatibleType(20170216152523,nIncompatibleTypesGotExpected,
+        [],TPasEnumType(ElA),TPasEnumType(ElB),ErrorEl)
+    else
+      exit(IncompatibleElements);
+    end
+  else if ElA.ClassType=TPasSetType then
+    begin
+    if ElB.ClassType=TPasSetType then
+      begin
+      ComputeElement(TPasSetType(ElA).EnumType,AResolved,[]);
+      ComputeElement(TPasSetType(ElB).EnumType,BResolved,[]);
+      if (AResolved.TypeEl<>nil)
+      and (AResolved.TypeEl=BResolved.TypeEl) then
+        exit(cExact);
+      if (AResolved.TypeEl.CustomData is TResElDataBaseType)
+          and (BResolved.TypeEl.CustomData is TResElDataBaseType)
+          and (CompareText(AResolved.TypeEl.Name,BResolved.TypeEl.Name)=0) then
+        exit(cExact);
+      if RaiseOnIncompatible then
+        RaiseIncompatibleTypeRes(20170216152524,nIncompatibleTypesGotExpected,
+          [],AResolved,BResolved,ErrorEl)
+      else
+        exit(cIncompatible);
+      end
+    else
+      exit(IncompatibleElements);
+    end
+  else if (ElA is TPasProcedureType) and (rrfReadable in TypeA.Flags) then
+    begin
+    if (ElB is TPasProcedureType) and (rrfReadable in TypeB.Flags) then
+      begin
+      // e.g. ProcVar1 = ProcVar2
+      if CheckProcTypeCompatibility(TPasProcedureType(ElA),TPasProcedureType(ElB),
+          false,nil,false) then
+        exit(cExact);
+      end
+    else
+      exit(IncompatibleElements);
+    end;
+  exit(IncompatibleElements);
+end;
+
+function TPasResolver.CheckTypeCast(El: TPasType; Params: TParamsExpr;
+  RaiseOnError: boolean): integer;
+// for example  if TClassA(AnObject)=nil then ;
+var
+  Param: TPasExpr;
+  ParamResolved, ResolvedEl: TPasResolverResult;
+begin
+  if length(Params.Params)<>1 then
+    begin
+    if RaiseOnError then
+      RaiseMsg(20170216152526,nWrongNumberOfParametersForTypeCast,
+        sWrongNumberOfParametersForTypeCast,[El.Name],Params);
+    exit(cIncompatible);
+    end;
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
+  ComputeElement(El,ResolvedEl,[rcType]);
+  Result:=CheckTypeCastRes(ParamResolved,ResolvedEl,Param,RaiseOnError);
+end;
+
+function TPasResolver.CheckTypeCastRes(const FromResolved,
+  ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
+  ): integer;
+var
+  ToTypeEl, ToClassType, FromClassType: TPasType;
+  ToTypeBaseType: TResolverBaseType;
+  C: TClass;
+  ToProcType, FromProcType: TPasProcedureType;
+begin
+  Result:=cIncompatible;
+  ToTypeEl:=ResolveAliasType(ToResolved.TypeEl);
+  if (ToTypeEl<>nil)
+      and (rrfReadable in FromResolved.Flags) then
+    begin
+    C:=ToTypeEl.ClassType;
+    if FromResolved.BaseType=btUntyped then
+      begin
+      // typecast an untyped parameter
+      Result:=cCompatible;
+      end
+    else if C=TPasUnresolvedSymbolRef then
+      begin
+      if ToTypeEl.CustomData is TResElDataBaseType then
+        begin
+        // base type cast, e.g. double(aninteger)
+        if ToTypeEl=FromResolved.TypeEl then
+          exit(cExact);
+        ToTypeBaseType:=(ToTypeEl.CustomData as TResElDataBaseType).BaseType;
+        if ToTypeBaseType=FromResolved.BaseType then
+          Result:=cExact
+        else if ToTypeBaseType in btAllInteger then
+          begin
+          if FromResolved.BaseType in btAllInteger then
+            Result:=cCompatible
+          else if FromResolved.BaseType in btAllBooleans then
+            Result:=cCompatible;
+          end
+        else if ToTypeBaseType in btAllFloats then
+          begin
+          if FromResolved.BaseType in btAllFloats then
+            Result:=cCompatible
+          else if FromResolved.BaseType in btAllInteger then
+            Result:=cCompatible;
+          end
+        else if ToTypeBaseType in btAllBooleans then
+          begin
+          if FromResolved.BaseType in btAllBooleans then
+            Result:=cCompatible
+          else if FromResolved.BaseType in btAllInteger then
+            Result:=cCompatible;
+          end
+        else if ToTypeBaseType in btAllStrings then
+          begin
+          if FromResolved.BaseType in btAllStringAndChars then
+            Result:=cCompatible;
+          end
+        else if ToTypeBaseType=btPointer then
+          begin
+          if FromResolved.BaseType=btPointer then
+            Result:=cExact
+          else if FromResolved.BaseType=btContext then
+            begin
+            C:=FromResolved.TypeEl.ClassType;
+            if (C=TPasClassType)
+                or (C=TPasClassOfType)
+                or (C=TPasPointerType)
+                or ((C=TPasArrayType) and IsDynArray(FromResolved.TypeEl)) then
+              Result:=cExact
+            else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+              begin
+              // from procvar to pointer
+              FromProcType:=TPasProcedureType(FromResolved.TypeEl);
+              if FromProcType.IsOfObject then
+                begin
+                if proMethodAddrAsPointer in Options then
+                  Result:=cCompatible
+                else if RaiseOnError then
+                  RaiseMsg(20170416183615,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                    [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject],
+                     BaseTypeNames[btPointer]],ErrorEl);
+                end
+              else if FromProcType.IsNested then
+                begin
+                if RaiseOnError then
+                  RaiseMsg(20170416183800,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                    [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested],
+                     BaseTypeNames[btPointer]],ErrorEl);
+                end
+              else if FromProcType.IsReferenceTo then
+                begin
+                if proProcTypeWithoutIsNested in Options then
+                  Result:=cCompatible
+                else if RaiseOnError then
+                  RaiseMsg(20170419144311,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                    [FromProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo],
+                     BaseTypeNames[btPointer]],ErrorEl);
+                end
+              else
+                Result:=cCompatible;
+              end;
+            end;
+          end;
+        end;
+      end
+    else if C=TPasClassType then
+      begin
+      // to class
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasClassType then
+          begin
+          if FromResolved.IdentEl is TPasType then
+            RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
+          // type cast upwards or downwards
+          Result:=CheckSrcIsADstType(FromResolved,ToResolved,ErrorEl);
+          if Result=cIncompatible then
+            Result:=CheckSrcIsADstType(ToResolved,FromResolved,ErrorEl);
+          if Result=cIncompatible then
+            Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
+          end
+        end
+      else if FromResolved.BaseType=btPointer then
+        begin
+        if IsBaseType(FromResolved.TypeEl,btPointer) then
+          Result:=cExact; // untyped pointer to class instance
+        end;
+      end
+    else if C=TPasClassOfType then
+      begin
+      //writeln('TPasResolver.CheckTypeCast class-of FromRes.TypeEl=',GetObjName(FromResolved.TypeEl),' FromRes.IdentEl=',GetObjName(FromResolved.IdentEl));
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasClassOfType then
+          begin
+          if (FromResolved.IdentEl is TPasType) then
+            RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
+          // type cast  classof(classof-var)  upwards or downwards
+          ToClassType:=TPasClassOfType(ToTypeEl).DestType;
+          FromClassType:=TPasClassOfType(FromResolved.TypeEl).DestType;
+          Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
+          end;
+        end
+      else if FromResolved.BaseType=btPointer then
+        begin
+        if IsBaseType(FromResolved.TypeEl,btPointer) then
+          Result:=cExact; // untyped pointer to class-of
+        end;
+      end
+    else if C=TPasRecordType then
+      begin
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasRecordType then
+          begin
+          // typecast record to record
+          Result:=cExact;
+          end;
+        end;
+      end
+    else if C=TPasEnumType then
+      begin
+      if CheckIsOrdinal(FromResolved,ErrorEl,true) then
+        Result:=cExact;
+      end
+    else if C=TPasArrayType then
+      begin
+      if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl.ClassType=TPasArrayType then
+          Result:=CheckTypeCastArray(TPasArrayType(FromResolved.TypeEl),
+            TPasArrayType(ToTypeEl),ErrorEl,RaiseOnError);
+        end
+      else if FromResolved.BaseType=btPointer then
+        begin
+        if IsDynArray(ToResolved.TypeEl)
+            and IsBaseType(FromResolved.TypeEl,btPointer) then
+          Result:=cExact; // untyped pointer to dynnamic array
+        end;
+      end
+    else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+      begin
+      ToProcType:=TPasProcedureType(ToTypeEl);
+      if IsBaseType(FromResolved.TypeEl,btPointer) then
+        begin
+        // type cast untyped pointer value to proctype
+        if ToProcType.IsOfObject then
+          begin
+          if proMethodAddrAsPointer in Options then
+            Result:=cCompatible
+          else if RaiseOnError then
+            RaiseMsg(20170416183940,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+              [BaseTypeNames[btPointer],
+               ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmOfObject]],ErrorEl);
+          end
+        else if ToProcType.IsNested then
+          begin
+          if RaiseOnError then
+            RaiseMsg(20170416184149,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+              [BaseTypeNames[btPointer],
+               ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmIsNested]],ErrorEl);
+          end
+        else if ToProcType.IsReferenceTo then
+          begin
+          if proMethodAddrAsPointer in Options then
+            Result:=cCompatible
+          else if RaiseOnError then
+            RaiseMsg(20170419144357,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+              [BaseTypeNames[btPointer],
+               ToProcType.ElementTypeName+' '+ProcTypeModifiers[ptmReferenceTo]],ErrorEl);
+          end
+        else
+          Result:=cCompatible;
+        end
+      else if FromResolved.BaseType=btContext then
+        begin
+        if FromResolved.TypeEl is TPasProcedureType then
+          begin
+          // type cast procvar to proctype
+          FromProcType:=TPasProcedureType(FromResolved.TypeEl);
+          if ToProcType.IsReferenceTo then
+            Result:=cCompatible
+          else if FromProcType.IsReferenceTo then
+            Result:=cCompatible
+          else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
+              and not (proMethodAddrAsPointer in Options) then
+            begin
+            if RaiseOnError then
+              RaiseMsg(20170416183109,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [FromProcType.ElementTypeName+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
+            end
+          else if FromProcType.IsNested<>ToProcType.IsNested then
+            begin
+            if RaiseOnError then
+              RaiseMsg(20170416183305,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [FromProcType.ElementTypeName+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
+            end
+          else
+            Result:=cCompatible;
+          end;
+        end;
+      end;
+    end
+  else if ToTypeEl<>nil then
+    begin
+    // FromResolved is not readable
+    if FromResolved.BaseType=btContext then
+      begin
+      if (FromResolved.TypeEl.ClassType=TPasClassType)
+          and (FromResolved.TypeEl=FromResolved.IdentEl)
+          and (ToResolved.BaseType=btContext)
+          and (ToResolved.TypeEl.ClassType=TPasClassOfType)
+          and (ToResolved.TypeEl=ToResolved.IdentEl) then
+        begin
+        // for example  class-of(Self) in a class function
+        ToClassType:=TPasClassOfType(ToTypeEl).DestType;
+        FromClassType:=TPasClassType(FromResolved.TypeEl);
+        Result:=CheckClassesAreRelated(ToClassType,FromClassType,ErrorEl);
+        end;
+      end;
+    if (Result=cIncompatible) and RaiseOnError then
+      begin
+      if FromResolved.IdentEl is TPasType then
+        RaiseMsg(20170404162610,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
+      end;
+    end;
+
+  if Result=cIncompatible then
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckTypeCastRes From={',GetResolverResultDbg(FromResolved),'} To={',GetResolverResultDbg(ToResolved),'}');
+    {$ENDIF}
+    if RaiseOnError then
+      RaiseIncompatibleTypeRes(20170216152528,nIllegalTypeConversionTo,
+        [],FromResolved,ToResolved,ErrorEl);
+    exit;
+    end;
+end;
+
+function TPasResolver.CheckTypeCastArray(FromType, ToType: TPasArrayType;
+  ErrorEl: TPasElement; RaiseOnError: boolean): integer;
+
+  function NextDim(var ArrType: TPasArrayType; var NextIndex: integer;
+    out ElTypeResolved: TPasResolverResult): boolean;
+  begin
+    inc(NextIndex);
+    if NextIndex<length(ArrType.Ranges) then
+      begin
+      ElTypeResolved.BaseType:=btNone;
+      exit(true);
+      end;
+    ComputeElement(ArrType.ElType,ElTypeResolved,[rcType]);
+    if (ElTypeResolved.BaseType<>btContext)
+        or (ElTypeResolved.TypeEl.ClassType<>TPasArrayType) then
+      exit(false);
+    ArrType:=TPasArrayType(ElTypeResolved.TypeEl);
+    NextIndex:=0;
+    Result:=true;
+  end;
+
+var
+  FromIndex, ToIndex: Integer;
+  FromElTypeRes, ToElTypeRes: TPasResolverResult;
+  StartFromType, StartToType: TPasArrayType;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' ToType=',GetTypeDescription(ToType));
+  {$ENDIF}
+  StartFromType:=FromType;
+  StartToType:=ToType;
+  Result:=cIncompatible;
+  // check dimensions
+  FromIndex:=0;
+  ToIndex:=0;
+  repeat
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckTypeCastArray From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,' ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
+    {$ENDIF}
+    if length(ToType.Ranges)=0 then
+      // ToType is dynamic/open array -> fits any size
+    else
+      begin
+      // ToType is ranged
+      // ToDo: check size of dimension
+      end;
+    // check next dimension
+    if not NextDim(FromType,FromIndex,FromElTypeRes) then
+      begin
+      // at end of FromType
+      if NextDim(ToType,ToIndex,ToElTypeRes) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.CheckTypeCastArray To has more dims than From: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
+        {$ENDIF}
+        break; // ToType has more dimensions
+        end;
+      // have same dimension -> check ElType
+      {$IFDEF VerbosePasResolver}
+      writeln('TPasResolver.CheckTypeCastArray check ElType From=',GetResolverResultDbg(FromElTypeRes),' To=',GetResolverResultDbg(ToElTypeRes));
+      {$ENDIF}
+      Include(FromElTypeRes.Flags,rrfReadable);
+      Result:=CheckTypeCastRes(FromElTypeRes,ToElTypeRes,ErrorEl,false);
+      break;
+      end
+    else
+      begin
+      // FromType has more dimensions
+      if not NextDim(ToType,ToIndex,ToElTypeRes) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.CheckTypeCastArray From has more dims than To: From=',GetTypeDescription(FromType),' FromIndex=',FromIndex,', ToType=',GetTypeDescription(ToType),' ToIndex=',ToIndex);
+        {$ENDIF}
+        break; // ToType has less dimensions
+        end;
+      end;
+  until false;
+  if (Result=cIncompatible) and RaiseOnError then
+    RaiseIncompatibleType(20170331124643,nIllegalTypeConversionTo,
+      [],StartFromType,StartToType,ErrorEl);
+end;
+
+procedure TPasResolver.ComputeElement(El: TPasElement; out
+  ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
+  StartEl: TPasElement);
+
+  procedure ComputeIdentifier(Expr: TPasExpr);
+  var
+    Ref: TResolvedReference;
+    Proc: TPasProcedure;
+    ProcType: TPasProcedureType;
+    aClass: TPasClassType;
+  begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    ComputeElement(Ref.Declaration,ResolvedEl,Flags+[rcNoImplicitProc],StartEl);
+    if rrfConstInherited in Ref.Flags then
+      Exclude(ResolvedEl.Flags,rrfWritable);
+    {$IFDEF VerbosePasResolver}
+    if Expr is TPrimitiveExpr then
+      writeln('TPasResolver.ComputeElement.ComputeIdentifier TPrimitiveExpr "',TPrimitiveExpr(Expr).Value,'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags))
+    else
+      writeln('TPasResolver.ComputeElement.ComputeIdentifier "',GetObjName(Expr),'" ',GetResolverResultDbg(ResolvedEl),' Flags=',dbgs(Flags));
+    {$ENDIF}
+    if (ResolvedEl.BaseType=btProc) then
+      begin
+      if [rcNoImplicitProc,rcConstant,rcType]*Flags=[] then
+        begin
+        // a proc and implicit call without params is allowed -> check if possible
+        Proc:=ResolvedEl.IdentEl as TPasProcedure;
+        if not ProcNeedsParams(Proc.ProcType) then
+          begin
+          // parameter less proc -> implicit call
+          if ResolvedEl.IdentEl is TPasFunction then
+            begin
+            // function => return result
+            ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,
+              ResolvedEl,Flags+[rcType],StartEl);
+            Exclude(ResolvedEl.Flags,rrfWritable);
+            end
+          else if (ResolvedEl.IdentEl.ClassType=TPasConstructor)
+              and (rrfNewInstance in Ref.Flags) then
+            begin
+            // new instance constructor -> return value of type class
+            aClass:=GetReference_NewInstanceClass(Ref);
+            SetResolverValueExpr(ResolvedEl,btContext,aClass,TPrimitiveExpr(Expr),[rrfReadable]);
+            end
+          else if ParentNeedsExprResult(Expr) then
+            begin
+            // a procedure
+            exit;
+            end;
+          if rcSetReferenceFlags in Flags then
+            Include(Ref.Flags,rrfImplicitCallWithoutParams);
+          Include(ResolvedEl.Flags,rrfCanBeStatement);
+          end;
+        end;
+      end
+    else if IsProcedureType(ResolvedEl,true) then
+      begin
+      if [rcNoImplicitProc,rcNoImplicitProcType,rcConstant,rcType]*Flags=[] then
+        begin
+        // a proc type and implicit call without params is allowed -> check if possible
+        ProcType:=TPasProcedureType(ResolvedEl.TypeEl);
+        if not ProcNeedsParams(ProcType) then
+          begin
+          // parameter less proc -> implicit call
+          if ResolvedEl.TypeEl is TPasFunctionType then
+            // function => return result
+            ComputeElement(TPasFunctionType(ResolvedEl.TypeEl).ResultEl,
+              ResolvedEl,Flags+[rcType],StartEl)
+          else if ParentNeedsExprResult(Expr) then
+            begin
+            // a procedure has no result
+            exit;
+            end;
+          if rcSetReferenceFlags in Flags then
+            Include(Ref.Flags,rrfImplicitCallWithoutParams);
+          Include(ResolvedEl.Flags,rrfCanBeStatement);
+          end;
+        end;
+      end;
+  end;
+
+var
+  DeclEl: TPasElement;
+  ElClass: TClass;
+begin
+  if StartEl=nil then StartEl:=El;
+  ResolvedEl:=Default(TPasResolverResult);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.ComputeElement El=',GetObjName(El),' SkipTypeAlias=',rcSkipTypeAlias in Flags);
+  {$ENDIF}
+  if El=nil then
+    exit;
+  ElClass:=El.ClassType;
+  if ElClass=TPrimitiveExpr then
+    begin
+    case TPrimitiveExpr(El).Kind of
+      pekIdent,pekSelf:
+        begin
+        if not (El.CustomData is TResolvedReference) then
+          RaiseNotYetImplemented(20160922163658,El,'Value="'+TPrimitiveExpr(El).Value+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
+        ComputeIdentifier(TPrimitiveExpr(El));
+        end;
+      pekNumber:
+        // ToDo: check if btByte, btSmallInt, btSingle, ...
+        if Pos('.',TPrimitiveExpr(El).Value)>0 then
+          SetResolverValueExpr(ResolvedEl,btDouble,FBaseTypes[btDouble],TPrimitiveExpr(El),[rrfReadable])
+        else
+          SetResolverValueExpr(ResolvedEl,btLongint,FBaseTypes[btLongint],TPrimitiveExpr(El),[rrfReadable]);
+      pekString:
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.ComputeElement pekString Value="',TPrimitiveExpr(El).Value,'"');
+        {$ENDIF}
+        if IsCharLiteral(TPrimitiveExpr(El).Value) then
+          SetResolverValueExpr(ResolvedEl,btChar,FBaseTypes[btChar],TPrimitiveExpr(El),[rrfReadable])
+        else
+          SetResolverValueExpr(ResolvedEl,btString,FBaseTypes[btString],TPrimitiveExpr(El),[rrfReadable]);
+        end;
+      pekNil:
+        SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],TPrimitiveExpr(El),[rrfReadable]);
+      pekBoolConst:
+        SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],TPrimitiveExpr(El),[rrfReadable]);
+    else
+      RaiseNotYetImplemented(20160922163701,El);
+    end;
+    end
+  else if ElClass=TSelfExpr then
+    begin
+    // self is just an identifier
+    if not (El.CustomData is TResolvedReference) then
+      RaiseNotYetImplemented(20170216150017,El,' El="'+GetObjName(El)+'" CustomData='+GetObjName(El.CustomData)+' '+GetElementSourcePosStr(El));
+    ComputeIdentifier(TSelfExpr(El));
+    end
+  else if ElClass=TPasUnresolvedSymbolRef then
+    begin
+    // built-in type
+    if El.CustomData is TResElDataBaseType then
+      SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
+        El,TPasUnresolvedSymbolRef(El),[])
+    else if El.CustomData is TResElDataBuiltInProc then
+      begin
+      SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,TPasUnresolvedSymbolRef(El),[]);
+      if bipfCanBeStatement in TResElDataBuiltInProc(El.CustomData).Flags then
+        Include(ResolvedEl.Flags,rrfCanBeStatement);
+      end
+    else
+      RaiseNotYetImplemented(20160926194756,El);
+    end
+  else if ElClass=TBoolConstExpr then
+    SetResolverValueExpr(ResolvedEl,btBoolean,FBaseTypes[btBoolean],TBoolConstExpr(El),[rrfReadable])
+  else if ElClass=TBinaryExpr then
+    ComputeBinaryExpr(TBinaryExpr(El),ResolvedEl,Flags,StartEl)
+  else if ElClass=TUnaryExpr then
+    begin
+    if TUnaryExpr(El).OpCode=eopAddress then
+      ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags+[rcNoImplicitProc],StartEl)
+    else
+      ComputeElement(TUnaryExpr(El).Operand,ResolvedEl,Flags,StartEl);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.ComputeElement Unary Kind=',TUnaryExpr(El).Kind,' OpCode=',TUnaryExpr(El).OpCode,' OperandResolved=',GetResolverResultDbg(ResolvedEl),' ',GetElementSourcePosStr(El));
+    {$ENDIF}
+    case TUnaryExpr(El).OpCode of
+      eopAdd, eopSubtract:
+        if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
+          exit
+        else
+          RaiseMsg(20170216152532,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
+      eopNot:
+        if ResolvedEl.BaseType in (btAllInteger+btAllBooleans) then
+          exit
+        else
+          RaiseMsg(20170216152534,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
+      eopAddress:
+        if (ResolvedEl.BaseType=btProc) and (ResolvedEl.IdentEl is TPasProcedure) then
+          begin
+          SetResolverValueExpr(ResolvedEl,btContext,ResolvedEl.TypeEl,TUnaryExpr(El).Operand,[rrfReadable]);
+          exit;
+          end
+        else
+          RaiseMsg(20170216152535,nIllegalQualifier,sIllegalQualifier,[OpcodeStrings[TUnaryExpr(El).OpCode]],El);
+    end;
+    RaiseNotYetImplemented(20160926142426,El);
+    end
+  else if ElClass=TParamsExpr then
+    case TParamsExpr(El).Kind of
+      pekArrayParams:
+        ComputeArrayParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
+      pekFuncParams:
+        ComputeFuncParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
+      pekSet:
+        ComputeSetParams(TParamsExpr(El),ResolvedEl,Flags,StartEl);
+    else
+      RaiseNotYetImplemented(20161010184559,El);
+    end
+  else if ElClass=TInheritedExpr then
+    begin
+    // writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
+    if El.CustomData is TResolvedReference then
+      begin
+        // "inherited;"
+        DeclEl:=TResolvedReference(El.CustomData).Declaration as TPasProcedure;
+        SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
+          TPasProcedure(DeclEl).ProcType,[rrfCanBeStatement]);
+      end
+    else
+      // no ancestor proc
+      SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,[rrfCanBeStatement]);
+    end
+  else if ElClass=TPasAliasType then
+    begin
+    // e.g. 'type a = b' -> compute b
+    ComputeElement(TPasAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
+    ResolvedEl.IdentEl:=El;
+    end
+  else if (ElClass=TPasTypeAliasType) then
+    begin
+    // e.g. 'type a = type b;' -> compute b
+    ComputeElement(TPasTypeAliasType(El).DestType,ResolvedEl,Flags+[rcType],StartEl);
+    if not (rcSkipTypeAlias in Flags) then
+      ResolvedEl.IdentEl:=El;
+    end
+  else if (ElClass=TPasVariable) then
+    begin
+    // e.g. 'var a:b' -> compute b, use a as IdentEl
+    if rcConstant in Flags then
+      RaiseConstantExprExp(20170216152737,StartEl);
+    ComputeElement(TPasVariable(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
+    ResolvedEl.IdentEl:=El;
+    ResolvedEl.Flags:=[rrfReadable,rrfWritable];
+    end
+  else if (ElClass=TPasConst) then
+    begin
+    // e.g. 'var a:b' -> compute b, use a as IdentEl
+    if TPasConst(El).VarType<>nil then
+      begin
+      // typed const -> just like a var
+      if rcConstant in Flags then
+        RaiseConstantExprExp(20170216152739,StartEl);
+      ComputeElement(TPasConst(El).VarType,ResolvedEl,Flags+[rcType],StartEl);
+      ResolvedEl.IdentEl:=El;
+      ResolvedEl.Flags:=[rrfReadable,rrfWritable];
+      end
+    else
+      begin
+      // untyped const
+      ComputeElement(TPasConst(El).Expr,ResolvedEl,Flags+[rcConstant],StartEl);
+      ResolvedEl.IdentEl:=El;
+      ResolvedEl.Flags:=[rrfReadable];
+      end;
+    end
+  else if (ElClass=TPasEnumValue) then
+    SetResolverIdentifier(ResolvedEl,btContext,El,El.Parent as TPasEnumType,[rrfReadable])
+  else if (ElClass=TPasEnumType) then
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasEnumType(El),[rrfReadable])
+  else if (ElClass=TPasProperty) then
+    begin
+    if rcConstant in Flags then
+      RaiseConstantExprExp(20170216152741,StartEl);
+    if TPasProperty(El).Args.Count=0 then
+      begin
+      ComputeElement(GetPasPropertyType(TPasProperty(El)),ResolvedEl,
+        Flags+[rcType],StartEl);
+      ResolvedEl.IdentEl:=El;
+      ResolvedEl.Flags:=[];
+      if GetPasPropertyGetter(TPasProperty(El))<>nil then
+        Include(ResolvedEl.Flags,rrfReadable);
+      if GetPasPropertySetter(TPasProperty(El))<>nil then
+        Include(ResolvedEl.Flags,rrfWritable);
+      if IsProcedureType(ResolvedEl,true) then
+        Include(ResolvedEl.Flags,rrfCanBeStatement);
+      end
+    else
+      // index property
+      SetResolverIdentifier(ResolvedEl,btContext,El,nil,[]);
+    end
+  else if ElClass=TPasArgument then
+    begin
+    if rcConstant in Flags then
+      RaiseConstantExprExp(20170216152744,StartEl);
+    if TPasArgument(El).ArgType=nil then
+      // untyped parameter
+      SetResolverIdentifier(ResolvedEl,btUntyped,El,nil,[])
+    else
+      begin
+      // typed parameter -> use param as IdentEl, compute type
+      ComputeElement(TPasArgument(El).ArgType,ResolvedEl,Flags+[rcType],StartEl);
+      ResolvedEl.IdentEl:=El;
+      end;
+    ResolvedEl.Flags:=[rrfReadable];
+    if TPasArgument(El).Access in [argDefault, argVar, argOut] then
+      Include(ResolvedEl.Flags,rrfWritable);
+    if IsProcedureType(ResolvedEl,true) then
+      Include(ResolvedEl.Flags,rrfCanBeStatement);
+    end
+  else if ElClass=TPasClassType then
+    begin
+    if TPasClassType(El).IsForward and (El.CustomData<>nil) then
+      begin
+      DeclEl:=(TPasClassType(El).CustomData as TResolvedReference).Declaration;
+      ResolvedEl.TypeEl:=DeclEl as TPasClassType;
+      end
+    else
+      ResolvedEl.TypeEl:=TPasClassType(El);
+    SetResolverIdentifier(ResolvedEl,btContext,
+                          ResolvedEl.TypeEl,ResolvedEl.TypeEl,[]);
+    end
+  else if ElClass=TPasClassOfType then
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasClassOfType(El),[])
+  else if ElClass=TPasRecordType then
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasRecordType(El),[])
+  else if ElClass=TPasRangeType then
+    begin
+    ComputeElement(TPasRangeType(El).RangeExpr,ResolvedEl,[rcConstant],StartEl);
+    ResolvedEl.IdentEl:=El;
+    ResolvedEl.Flags:=[];
+    end
+  else if ElClass=TPasSetType then
+    begin
+    ComputeElement(TPasSetType(El).EnumType,ResolvedEl,[rcConstant],StartEl);
+    if ResolvedEl.BaseType=btRange then
+      ConvertRangeToFirstValue(ResolvedEl);
+    ResolvedEl.SubType:=ResolvedEl.BaseType;
+    ResolvedEl.BaseType:=btSet;
+    ResolvedEl.IdentEl:=El;
+    ResolvedEl.Flags:=[];
+    end
+  else if ElClass=TPasResultElement then
+    begin
+    if rcConstant in Flags then
+      RaiseConstantExprExp(20170216152746,StartEl);
+    ComputeElement(TPasResultElement(El).ResultType,ResolvedEl,Flags+[rcType],StartEl);
+    ResolvedEl.IdentEl:=El;
+    ResolvedEl.Flags:=[rrfReadable,rrfWritable];
+    end
+  else if ElClass=TPasUsesUnit then
+    begin
+    if TPasUsesUnit(El).Module is TPasModule then
+      SetResolverIdentifier(ResolvedEl,btModule,TPasUsesUnit(El).Module,nil,[])
+    else
+      RaiseNotYetImplemented(20170429112047,TPasUsesUnit(El).Module);
+    end
+  else if El.InheritsFrom(TPasModule) then
+    SetResolverIdentifier(ResolvedEl,btModule,El,nil,[])
+  else if ElClass=TNilExpr then
+    SetResolverValueExpr(ResolvedEl,btNil,FBaseTypes[btNil],TNilExpr(El),[rrfReadable])
+  else if El.InheritsFrom(TPasProcedure) then
+    begin
+    SetResolverIdentifier(ResolvedEl,btProc,El,TPasProcedure(El).ProcType,[rrfCanBeStatement]);
+    if El is TPasFunction then
+      Include(ResolvedEl.Flags,rrfReadable);
+    // Note: the readability of TPasConstructor depends on the context
+    // Note: implicit calls are handled in TPrimitiveExpr
+    end
+  else if El.InheritsFrom(TPasProcedureType) then
+    begin
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasProcedureType(El),[rrfCanBeStatement]);
+    // Note: implicit calls are handled in TPrimitiveExpr
+    end
+  else if ElClass=TPasArrayType then
+    SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[])
+  else if ElClass=TArrayValues then
+    SetResolverValueExpr(ResolvedEl,btSet,nil,TArrayValues(El),[rrfReadable])
+  else if ElClass=TPasStringType then
+    begin
+    SetResolverTypeExpr(ResolvedEl,btShortString,BaseTypes[btShortString],[rrfReadable]);
+    if BaseTypes[btShortString]=nil then
+      RaiseMsg(20170419203146,nIllegalQualifier,sIllegalQualifier,['['],El);
+    end
+  else
+    RaiseNotYetImplemented(20160922163705,El);
+end;
+
+function TPasResolver.IsSameType(TypeA, TypeB: TPasType; ResolveAlias: boolean
+  ): boolean;
+begin
+  if (TypeA=nil) or (TypeB=nil) then exit(false);
+  if ResolveAlias then
+    begin
+    TypeA:=ResolveAliasType(TypeA);
+    TypeB:=ResolveAliasType(TypeB);
+    end;
+  if TypeA=TypeB then exit(true);
+  if (TypeA.ClassType=TPasUnresolvedSymbolRef)
+      and (TypeB.ClassType=TPasUnresolvedSymbolRef) then
+    begin
+    Result:=CompareText(TypeA.Name,TypeB.Name)=0;
+    exit;
+    end;
+  Result:=false;
+end;
+
+function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType;
+  SkipAlias: boolean): TPasType;
+var
+  DeclEl: TPasElement;
+  ClassScope: TPasClassScope;
+begin
+  Result:=nil;
+  if ClassEl=nil then
+    exit;
+  if ClassEl.CustomData=nil then
+    exit;
+  if ClassEl.IsForward then
+    begin
+    DeclEl:=(ClassEl.CustomData as TResolvedReference).Declaration;
+    ClassEl:=DeclEl as TPasClassType;
+    Result:=ClassEl;
+    end
+  else
+    begin
+    ClassScope:=ClassEl.CustomData as TPasClassScope;
+    if not (pcsfAncestorResolved in ClassScope.Flags) then
+      exit;
+    if SkipAlias then
+      begin
+      if ClassScope.AncestorScope=nil then
+        exit;
+      Result:=TPasClassType(ClassScope.AncestorScope.Element);
+      end
+    else
+      Result:=ClassScope.DirectAncestor;
+    end;
+end;
+
+function TPasResolver.GetLoop(El: TPasElement): TPasImplElement;
+begin
+  while El<>nil do
+    begin
+    if (El.ClassType=TPasImplRepeatUntil)
+        or (El.ClassType=TPasImplWhileDo)
+        or (El.ClassType=TPasImplForLoop) then
+      exit(TPasImplElement(El));
+    El:=El.Parent;
+    end;
+  Result:=nil;
+end;
+
+function TPasResolver.ResolveAliasType(aType: TPasType): TPasType;
+var
+  C: TClass;
+begin
+  Result:=aType;
+  while Result<>nil do
+    begin
+    C:=Result.ClassType;
+    if (C=TPasAliasType) or (C=TPasTypeAliasType) then
+      Result:=TPasAliasType(Result).DestType
+    else if (C=TPasClassType) and TPasClassType(Result).IsForward
+        and (Result.CustomData is TResolvedReference) then
+      Result:=TResolvedReference(Result.CustomData).Declaration as TPasType
+    else
+      exit;
+    end;
+end;
+
+function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
+{ returns true if El is
+  a) the last element of an @ operator expression
+  e.g. '@p().o[].El' or '@El[]'
+  b) mode delphi: the last element of a right side of an assignment
+  c) an accessor function, e.g. property P read El;
+}
+var
+  Parent: TPasElement;
+  Prop: TPasProperty;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if not IsNameExpr(El) then
+    exit;
+  repeat
+    Parent:=El.Parent;
+    //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent));
+    if Parent.ClassType=TUnaryExpr then
+      begin
+      if TUnaryExpr(Parent).OpCode=eopAddress then exit(true);
+      end
+    else if Parent.ClassType=TBinaryExpr then
+      begin
+      if TBinaryExpr(Parent).right<>El then exit;
+      if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit;
+      end
+    else if Parent.ClassType=TParamsExpr then
+      begin
+      if TParamsExpr(Parent).Value<>El then exit;
+      end
+    else if Parent.ClassType=TPasProperty then
+      begin
+      Prop:=TPasProperty(Parent);
+      Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El);
+      exit;
+      end
+    else if Parent.ClassType=TPasImplAssign then
+      begin
+      if TPasImplAssign(Parent).right<>El then exit;
+      if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true);
+      exit;
+      end
+    else
+      exit;
+    El:=TPasExpr(Parent);
+  until false;
+end;
+
+function TPasResolver.ParentNeedsExprResult(El: TPasExpr): boolean;
+var
+  C: TClass;
+  P: TPasElement;
+begin
+  if (El=nil) or (El.Parent=nil) then exit(false);
+  Result:=false;
+  P:=El.Parent;
+  C:=P.ClassType;
+  if C=TBinaryExpr then
+    begin
+    if TBinaryExpr(P).right=El then
+      begin
+      if (TBinaryExpr(P).OpCode=eopSubIdent)
+          or ((TBinaryExpr(P).OpCode=eopNone) and (TBinaryExpr(P).left is TInheritedExpr)) then
+        Result:=ParentNeedsExprResult(TBinaryExpr(P))
+      else
+        Result:=true;
+      end
+    else
+      Result:=true;
+    end
+  else if C.InheritsFrom(TPasExpr) then
+    Result:=true
+  else if (C=TPasEnumValue)
+      or (C=TPasArgument)
+      or (C=TPasVariable)
+      or (C=TPasExportSymbol) then
+    Result:=true
+  else if C=TPasClassType then
+    Result:=TPasClassType(P).GUIDExpr=El
+  else if C=TPasProperty then
+    Result:=(TPasProperty(P).IndexExpr=El)
+        or (TPasProperty(P).DispIDExpr=El)
+        or (TPasProperty(P).DefaultExpr=El)
+  else if C=TPasProcedure then
+    Result:=(TPasProcedure(P).LibraryExpr=El)
+         or (TPasProcedure(P).DispIDExpr=El)
+  else if C=TPasImplRepeatUntil then
+    Result:=(TPasImplRepeatUntil(P).ConditionExpr=El)
+  else if C=TPasImplIfElse then
+    Result:=(TPasImplIfElse(P).ConditionExpr=El)
+  else if C=TPasImplWhileDo then
+    Result:=(TPasImplWhileDo(P).ConditionExpr=El)
+  else if C=TPasImplWithDo then
+    Result:=(TPasImplWithDo(P).Expressions.IndexOf(El)>=0)
+  else if C=TPasImplCaseOf then
+    Result:=(TPasImplCaseOf(P).CaseExpr=El)
+  else if C=TPasImplCaseStatement then
+    Result:=(TPasImplCaseStatement(P).Expressions.IndexOf(El)>=0)
+  else if C=TPasImplForLoop then
+    Result:=(TPasImplForLoop(P).StartExpr=El)
+         or (TPasImplForLoop(P).EndExpr=El)
+  else if C=TPasImplAssign then
+    Result:=(TPasImplAssign(P).right=El)
+  else if C=TPasImplRaise then
+    Result:=(TPasImplRaise(P).ExceptAddr=El);
+end;
+
+function TPasResolver.GetReference_NewInstanceClass(Ref: TResolvedReference
+  ): TPasClassType;
+begin
+  Result:=(Ref.Context as TResolvedRefCtxConstructor).Typ as TPasClassType;
+end;
+
+function TPasResolver.IsDynArray(TypeEl: TPasType): boolean;
+begin
+  if (TypeEl=nil) or (TypeEl.ClassType<>TPasArrayType)
+      or (length(TPasArrayType(TypeEl).Ranges)<>0) then
+    exit(false);
+  if proOpenAsDynArrays in Options then
+    Result:=true
+  else
+    Result:=(TypeEl.Parent=nil) or (TypeEl.Parent.ClassType<>TPasArgument);
+end;
+
+function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
+begin
+  Result:=(TypeEl<>nil)
+      and (TypeEl.ClassType=TPasArrayType)
+      and (length(TPasArrayType(TypeEl).Ranges)=0)
+      and (TypeEl.Parent<>nil)
+      and (TypeEl.Parent.ClassType=TPasArgument);
+end;
+
+function TPasResolver.IsDynOrOpenArray(TypeEl: TPasType): boolean;
+begin
+  Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
+      and (length(TPasArrayType(TypeEl).Ranges)=0);
+end;
+
+function TPasResolver.IsVarInit(Expr: TPasExpr): boolean;
+var
+  C: TClass;
+begin
+  Result:=false;
+  if Expr=nil then exit;
+  if Expr.Parent=nil then exit;
+  C:=Expr.Parent.ClassType;
+  if C.InheritsFrom(TPasVariable) then
+    Result:=(TPasVariable(Expr.Parent).Expr=Expr)
+  else if C=TPasArgument then
+    Result:=(TPasArgument(Expr.Parent).ValueExpr=Expr);
+end;
+
+function TPasResolver.IsEmptySet(const ResolvedEl: TPasResolverResult): boolean;
+begin
+  Result:=(ResolvedEl.BaseType=btSet) and (ResolvedEl.SubType=btNone);
+end;
+
+function TPasResolver.IsClassMethod(El: TPasElement): boolean;
+var
+  C: TClass;
+begin
+  if El=nil then exit(false);
+  C:=El.ClassType;;
+  Result:=(C=TPasClassConstructor)
+       or (C=TPasClassDestructor)
+       or (C=TPasClassProcedure)
+       or (C=TPasClassFunction)
+       or (C=TPasClassOperator);
+end;
+
+function TPasResolver.IsExternalClassName(aClass: TPasClassType;
+  const ExtName: string): boolean;
+var
+  AncestorScope: TPasClassScope;
+begin
+  Result:=false;
+  if aClass=nil then exit;
+  while (aClass<>nil) and aClass.IsExternal do
+    begin
+    if aClass.ExternalName=ExtName then exit(true);
+    AncestorScope:=(aClass.CustomData as TPasClassScope).AncestorScope;
+    if AncestorScope=nil then exit;
+    aClass:=AncestorScope.Element as TPasClassType;
+  end;
+end;
+
+function TPasResolver.IsProcedureType(const ResolvedEl: TPasResolverResult;
+  HasValue: boolean): boolean;
+begin
+  if (ResolvedEl.BaseType<>btContext) or not (ResolvedEl.TypeEl is TPasProcedureType) then
+    exit(false);
+  if HasValue and not (rrfReadable in ResolvedEl.Flags) then
+    exit(false);
+  Result:=true;
+end;
+
+function TPasResolver.IsArrayType(const ResolvedEl: TPasResolverResult
+  ): boolean;
+begin
+  Result:=(ResolvedEl.BaseType=btContext) and (ResolvedEl.TypeEl is TPasArrayType);
+end;
+
+function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
+var
+  Value: TPasExpr;
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+  C: TClass;
+begin
+  Result:=false;
+  if (Params=nil) or (Params.Kind<>pekFuncParams) then exit;
+  Value:=Params.Value;
+  if not IsNameExpr(Value) then
+    exit;
+  if not (Value.CustomData is TResolvedReference) then exit;
+  Ref:=TResolvedReference(Value.CustomData);
+  Decl:=Ref.Declaration;
+  C:=Decl.ClassType;
+  if (C=TPasAliasType) or (C=TPasTypeAliasType) then
+    begin
+    Decl:=ResolveAliasType(TPasAliasType(Decl));
+    C:=Decl.ClassType;
+    end;
+  if (C=TPasProcedureType)
+      or (C=TPasFunctionType) then
+    exit(true)
+  else if (C=TPasClassType)
+      or (C=TPasClassOfType)
+      or (C=TPasEnumType) then
+    exit(true)
+  else if (C=TPasUnresolvedSymbolRef)
+      and (Decl.CustomData is TResElDataBaseType) then
+    exit(true);
+end;
+
+function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
+begin
+  Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
+end;
+
+function TPasResolver.GetRangeLength(RangeResolved: TPasResolverResult
+  ): integer;
+begin
+  Result:=0;
+  if RangeResolved.BaseType=btContext then
+    begin
+    if RangeResolved.IdentEl is TPasEnumType then
+      Result:=TPasEnumType(RangeResolved.IdentEl).Values.Count;
+    end
+  else if RangeResolved.BaseType in btAllBooleans then
+    Result:=2;
+end;
+
+function TPasResolver.HasTypeInfo(El: TPasType): boolean;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if El.CustomData is TResElDataBaseType then
+    exit(true); // base type
+  if El.Parent=nil then exit;
+  if (El.Parent is TPasType) and not HasTypeInfo(TPasType(El.Parent)) then
+    exit;
+  Result:=true;
+end;
+
+function TPasResolver.GetActualBaseType(bt: TResolverBaseType
+  ): TResolverBaseType;
+begin
+  case bt of
+  btChar: Result:=BaseTypeChar;
+  btString: Result:=BaseTypeString;
+  btExtended: Result:=BaseTypeExtended;
+  else Result:=bt;
+  end;
+end;
+
+function TPasResolver.GetCombinedBoolean(Bool1, Bool2: TResolverBaseType;
+  ErrorEl: TPasElement): TResolverBaseType;
+begin
+  if Bool1=Bool2 then exit(Bool1);
+  case Bool1 of
+  btBoolean: Result:=Bool2;
+  btByteBool: if Bool2<>btBoolean then Result:=Bool2;
+  btWordBool: if not (Bool2 in [btBoolean,btByteBool]) then Result:=Bool2;
+  btLongBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool]) then Result:=Bool2;
+  btQWordBool: if not (Bool2 in [btBoolean,btByteBool,btWordBool,btLongBool]) then Result:=Bool2;
+  else
+    RaiseNotYetImplemented(20170420093805,ErrorEl);
+  end;
+end;
+
+function TPasResolver.GetCombinedInt(const Int1, Int2: TPasResolverResult;
+  ErrorEl: TPasElement): TResolverBaseType;
+var
+  Precision1, Precision2: word;
+  Signed1, Signed2: boolean;
+begin
+  if Int1.BaseType=Int2.BaseType then exit;
+  GetIntegerProps(Int1.BaseType,Precision1,Signed1);
+  GetIntegerProps(Int2.BaseType,Precision2,Signed2);
+  if Precision1=Precision2 then
+    begin
+    if Signed1<>Signed2 then
+      Precision1:=Max(Precision1,Precision2)+1;
+    end;
+  Result:=GetIntegerBaseType(Max(Precision1,Precision2),Signed1 or Signed2,ErrorEl);
+end;
+
+procedure TPasResolver.GetIntegerProps(bt: TResolverBaseType; out
+  Precision: word; out Signed: boolean);
+begin
+  case bt of
+  btByte: begin Precision:=8; Signed:=false; end;
+  btShortInt: begin Precision:=8; Signed:=true; end;
+  btWord: begin Precision:=16; Signed:=false; end;
+  btSmallInt: begin Precision:=16; Signed:=true; end;
+  btIntSingle: begin Precision:=23; Signed:=true; end;
+  btUIntSingle: begin Precision:=22; Signed:=false; end;
+  btLongWord: begin Precision:=32; Signed:=false; end;
+  btLongint: begin Precision:=32; Signed:=true; end;
+  btIntDouble: begin Precision:=53; Signed:=true; end;
+  btUIntDouble: begin Precision:=52; Signed:=false; end;
+  btQWord: begin Precision:=64; Signed:=false; end;
+  btInt64,btComp: begin Precision:=64; Signed:=true; end;
+  else
+    RaiseInternalError(20170420095727);
+  end;
+end;
+
+function TPasResolver.GetIntegerRange(bt: TResolverBaseType; out MinVal,
+  MaxVal: int64): boolean;
+begin
+  Result:=true;
+  if bt=btExtended then bt:=BaseTypeExtended;
+  case bt of
+  btByte: begin MinVal:=Low(byte); MaxVal:=High(byte); end;
+  btShortInt: begin MinVal:=low(ShortInt); MaxVal:=high(ShortInt); end;
+  btWord: begin MinVal:=low(word); MaxVal:=high(word); end;
+  btSmallInt: begin MinVal:=low(SmallInt); MaxVal:=high(SmallInt); end;
+  btLongWord: begin MinVal:=low(LongWord); MaxVal:=high(LongWord); end;
+  btLongint: begin MinVal:=low(LongInt); MaxVal:=high(LongInt); end;
+  btInt64,btComp: begin MinVal:=low(int64); MaxVal:=high(int64); end;
+  btSingle,btIntSingle: begin MinVal:=MinSafeIntSingle; MaxVal:=MaxSafeIntSingle; end;
+  btUIntSingle: begin MinVal:=0; MaxVal:=MaxSafeIntSingle; end;
+  btDouble,btIntDouble: begin MinVal:=MinSafeIntDouble; MaxVal:=MaxSafeIntDouble; end;
+  btUIntDouble: begin MinVal:=0; MaxVal:=MaxSafeIntDouble; end;
+  btCurrency: begin MinVal:=MinSafeIntCurrency; MaxVal:=MaxSafeIntCurrency; end;
+  else
+    Result:=false;
+  end;
+end;
+
+function TPasResolver.GetIntegerBaseType(Precision: word; Signed: boolean;
+  ErrorEl: TPasElement): TResolverBaseType;
+begin
+  if Precision<=8 then
+    begin
+    if Signed then
+      Result:=btShortInt
+    else
+      Result:=btByte;
+    if BaseTypes[Result]<>nil then exit;
+    end;
+  if Precision<=16 then
+    begin
+    if Signed then
+      Result:=btSmallInt
+    else
+      Result:=btWord;
+    if BaseTypes[Result]<>nil then exit;
+    end;
+  if (Precision<=22) and (not Signed) and (BaseTypes[btUIntSingle]<>nil) then
+    exit(btUIntSingle);
+  if (Precision<=23) and Signed and (BaseTypes[btIntSingle]<>nil) then
+    exit(btIntSingle);
+  if Precision<=32 then
+    begin
+    if Signed then
+      Result:=btLongint
+    else
+      Result:=btLongWord;
+    if BaseTypes[Result]<>nil then exit;
+    end;
+  if (Precision<=52) and (not Signed) and (BaseTypes[btUIntDouble]<>nil) then
+    exit(btUIntDouble);
+  if (Precision<=53) and Signed and (BaseTypes[btIntDouble]<>nil) then
+    exit(btIntDouble);
+  if Precision<=64 then
+    begin
+    if Signed then
+      Result:=btInt64
+    else
+      Result:=btQWord;
+    if BaseTypes[Result]<>nil then exit;
+    end;
+  RaiseRangeCheck(20170420100336,ErrorEl);
+end;
+
+function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
+  ErrorEl: TPasElement): TResolverBaseType;
+var
+  bt1, bt2: TResolverBaseType;
+begin
+  bt1:=GetActualBaseType(Char1.BaseType);
+  bt2:=GetActualBaseType(Char2.BaseType);
+  if bt1=bt2 then exit(bt1);
+  if not (bt1 in btAllChars) then
+    RaiseInternalError(20170420103128);
+  Result:=btWideChar;
+  if Result=BaseTypeChar then
+    Result:=btChar;
+  if ErrorEl=nil then ;
+end;
+
+function TPasResolver.GetCombinedString(const Str1, Str2: TPasResolverResult;
+  ErrorEl: TPasElement): TResolverBaseType;
+var
+  bt1, bt2: TResolverBaseType;
+begin
+  bt1:=GetActualBaseType(Str1.BaseType);
+  bt2:=GetActualBaseType(Str2.BaseType);
+  if bt1=bt2 then exit(bt1);
+  case bt1 of
+  btChar,btAnsiChar:
+    case bt2 of
+    btChar: Result:=btChar;
+    btWideChar: Result:=btWideChar;
+    else Result:=bt2;
+    end;
+  btWideChar:
+    case bt2 of
+    btAnsiChar: Result:=btWideChar;
+    btWideString: Result:=btWideString;
+    btString,btShortString,btAnsiString,btRawByteString,btUnicodeString: Result:=btUnicodeString;
+    else RaiseNotYetImplemented(20170420103808,ErrorEl);
+    end;
+  btShortString:
+    case bt2 of
+    btChar,btAnsiChar: Result:=btShortString;
+    btString,btAnsiString: Result:=btAnsiString;
+    btRawByteString: Result:=btRawByteString;
+    btWideChar,btUnicodeString: Result:=btUnicodeString;
+    btWideString: Result:=btWideString;
+    else RaiseNotYetImplemented(20170420120937,ErrorEl);
+    end;
+  btString,btAnsiString:
+    case bt2 of
+    btChar,btAnsiChar,btString,btShortString,btRawByteString: Result:=btAnsiString;
+    btWideChar,btUnicodeString: Result:=btUnicodeString;
+    btWideString: Result:=btWideString;
+    else RaiseNotYetImplemented(20170420121201,ErrorEl);
+    end;
+  btRawByteString:
+    case bt2 of
+    btChar,btAnsiChar,btRawByteString,btShortString: Result:=btRawByteString;
+    btString,btAnsiString: Result:=btAnsiString;
+    btWideChar,btUnicodeString: Result:=btUnicodeString;
+    btWideString: Result:=btWideString;
+    else RaiseNotYetImplemented(20170420121352,ErrorEl);
+    end;
+  btWideString:
+    case bt2 of
+    btChar,btAnsiChar,btWideChar,btShortString,btWideString: Result:=btWideString;
+    btString,btAnsiString,btUnicodeString: Result:=btUnicodeString;
+    else RaiseNotYetImplemented(20170420121532,ErrorEl);
+    end;
+  btUnicodeString:
+    Result:=btUnicodeString;
+  else
+    RaiseNotYetImplemented(20170420103153,ErrorEl);
+  end;
+  if Result=BaseTypeChar then
+    Result:=btChar
+  else if Result=BaseTypeString then
+    Result:=btString;
+end;
+
+function TPasResolver.CheckSrcIsADstType(const ResolvedSrcType,
+  ResolvedDestType: TPasResolverResult; ErrorEl: TPasElement): integer;
+// finds distance between classes SrcType and DestType
+begin
+  Result:=CheckClassIsClass(ResolvedSrcType.TypeEl,ResolvedDestType.TypeEl,ErrorEl);
+end;
+
+function TPasResolver.CheckClassIsClass(SrcType, DestType: TPasType;
+  ErrorEl: TPasElement): integer;
+// check if Src is equal or descends from Dest
+var
+  ClassEl: TPasClassType;
+begin
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.CheckClassIsClass SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
+  {$ENDIF}
+  if DestType=nil then exit(cIncompatible);
+  // skip Dest alias
+  while (DestType.ClassType=TPasAliasType) do
+    DestType:=TPasAliasType(DestType).DestType;
+
+  Result:=cExact;
+  while SrcType<>nil do
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln(' Step=',Result,' SrcType=',GetObjName(SrcType),' DestType=',GetObjName(DestType));
+    {$ENDIF}
+    if SrcType=DestType then
+      exit
+    else if SrcType.ClassType=TPasAliasType then
+      // alias -> skip
+      SrcType:=TPasAliasType(SrcType).DestType
+    else if SrcType.ClassType=TPasTypeAliasType then
+      begin
+      // type alias -> increases distance
+      SrcType:=TPasAliasType(SrcType).DestType;
+      inc(Result);
+      end
+    else if SrcType.ClassType=TPasClassType then
+      begin
+      ClassEl:=TPasClassType(SrcType);
+      if ClassEl.IsForward then
+        // class forward -> skip
+        SrcType:=(ClassEl.CustomData as TResolvedReference).Declaration as TPasType
+      else
+        begin
+        // class ancestor -> increase distance
+        SrcType:=(ClassEl.CustomData as TPasClassScope).DirectAncestor;
+        inc(Result);
+        end;
+      end
+    else
+      exit(cIncompatible);
+    end;
+  if ErrorEl=nil then ;
+  Result:=cIncompatible;
+end;
+
+function TPasResolver.CheckClassesAreRelated(TypeA, TypeB: TPasType;
+  ErrorEl: TPasElement): integer;
+begin
+  Result:=CheckClassIsClass(TypeA,TypeB,ErrorEl);
+  if Result<>cIncompatible then exit;
+  Result:=CheckClassIsClass(TypeB,TypeA,ErrorEl);
+end;
+
+end.
+
diff --git a/packages/fcl-passrc/src/passrcutil.pp b/packages/fcl-passrc/src/passrcutil.pp
index 7964e6db5d..3599c42204 100644
--- a/packages/fcl-passrc/src/passrcutil.pp
+++ b/packages/fcl-passrc/src/passrcutil.pp
@@ -74,6 +74,7 @@ end;
 
 function TSrcContainer.FindElement(const AName: String): TPasElement;
 begin
+  if AName='' then ;
   Result:=Nil;
 end;
 
@@ -171,8 +172,6 @@ procedure TPasSrcAnalysis.GetClassMembers(AClass: TPasClassType; List: TStrings;
 Var
   I : Integer;
   E : TPasElement;
-  V : TPasVariant;
-
 begin
   For I:=0 to AClass.Members.Count-1 do
     begin
@@ -193,7 +192,11 @@ procedure TPasSrcAnalysis.GetUses(ASection : TPasSection; List: TStrings);
 Var
   I : Integer;
 begin
-  If Assigned(ASection) and Assigned(ASection.UsesList) then
+  If not Assigned(ASection) then exit;
+  if ASection.UsesList.Count=length(ASection.UsesClause) then
+    For I:=0 to length(ASection.UsesClause)-1 do
+      List.Add(ASection.UsesClause[i].Name)
+  else
     For I:=0 to ASection.UsesList.Count-1 do
       List.Add(TPasElement(ASection.UsesList[i]).Name);
 end;
diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp
index 59df48c9d3..9d70f3cb59 100644
--- a/packages/fcl-passrc/src/pastree.pp
+++ b/packages/fcl-passrc/src/pastree.pp
@@ -27,6 +27,11 @@ resourcestring
   // Parse tree node type names
   SPasTreeElement = 'generic element';
   SPasTreeSection = 'unit section';
+  SPasTreeProgramSection = 'program section';
+  SPasTreeLibrarySection = 'library section';
+  SPasTreeInterfaceSection = 'interface section';
+  SPasTreeImplementationSection = 'implementation section';
+  SPasTreeUsesUnit = 'uses unit';
   SPasTreeModule = 'module';
   SPasTreeUnit = 'unit';
   SPasTreeProgram = 'program';
@@ -82,9 +87,17 @@ type
   // Visitor pattern.
   TPassTreeVisitor = class;
 
+  { TPasElementBase }
+
   TPasElementBase = class
-    procedure Accept(Visitor: TPassTreeVisitor); virtual; abstract;
+  private
+    FData: TObject;
+  protected
+    procedure Accept(Visitor: TPassTreeVisitor); virtual;
+  public
+    Property CustomData : TObject Read FData Write FData;
   end;
+  TPasElementBaseClass = class of TPasElementBase;
 
 
   TPasModule = class;
@@ -93,20 +106,25 @@ type
     visPublished, visAutomated,
     visStrictPrivate, visStrictProtected);
 
-  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall,ccSysCall);
+  TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,
+                        ccOldFPCCall,ccSafeCall,ccSysCall);
+  TProcTypeModifier = (ptmOfObject,ptmIsNested,ptmStatic,ptmVarargs,ptmReferenceTo);
+  TProcTypeModifiers = set of TProcTypeModifier;
   TPackMode = (pmNone,pmPacked,pmBitPacked);
 
   TPasMemberVisibilities = set of TPasMemberVisibility;
   TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented);
   TPasMemberHints = set of TPasMemberHint; 
 
+  TPasElement = class;
   TPTreeElement = class of TPasElement;
 
+  TOnForEachPasElement = procedure(El: TPasElement; arg: pointer) of object;
+
   { TPasElement }
 
   TPasElement = class(TPasElementBase)
   private
-    FData: TObject;
     FDocComment: String;
     FRefCount: LongWord;
     FName: string;
@@ -121,8 +139,13 @@ type
     Visibility: TPasMemberVisibility;
   public
     constructor Create(const AName: string; AParent: TPasElement); virtual;
+    destructor Destroy; override;
     procedure AddRef;
     procedure Release;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); virtual;
+    procedure ForEachChildCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer; Child: TPasElement; CheckParent: boolean); virtual;
     function FullPath: string;
     function ParentPath: string;
     function FullName: string; virtual;         // Name including parent's names
@@ -132,17 +155,18 @@ type
     Function HintsString : String;
     function GetDeclaration(full : Boolean) : string; virtual;
     procedure Accept(Visitor: TPassTreeVisitor); override;
+    function HasParent(aParent: TPasElement): boolean;
     property RefCount: LongWord read FRefCount;
     property Name: string read FName write FName;
-    property Parent: TPasElement read FParent;
+    property Parent: TPasElement read FParent Write FParent;
     Property Hints : TPasMemberHints Read FHints Write FHints;
-    Property CustomData : TObject Read FData Write FData;
     Property HintMessage : String Read FHintMessage Write FHintMessage;
     Property DocComment : String Read FDocComment Write FDocComment;
   end;
 
-  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst, pekRange,
-     pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp, pekInherited, pekSelf);
+  TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
+     pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
+     pekInherited, pekSelf);
 
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -158,15 +182,21 @@ type
 
   TPasExpr = class(TPasElement)
     Kind      : TPasExprKind;
-    OpCode    : TexprOpcode;
-    constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode); virtual; overload;
+    OpCode    : TExprOpCode;
+    format1,format2 : TPasExpr; // write, writeln, str
+    constructor Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TExprOpCode); virtual; overload;
+    destructor Destroy; override;
   end;
 
+  { TUnaryExpr }
+
   TUnaryExpr = class(TPasExpr)
     Operand   : TPasExpr;
     constructor Create(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode); overload;
     function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TBinaryExpr }
@@ -178,14 +208,20 @@ type
     constructor CreateRange(AParent : TPasElement; xleft, xright: TPasExpr); overload;
     function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
+  { TPrimitiveExpr }
+
   TPrimitiveExpr = class(TPasExpr)
     Value     : AnsiString;
     constructor Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring); overload;
     function GetDeclaration(full : Boolean) : string; override;
   end;
   
+  { TBoolConstExpr }
+
   TBoolConstExpr = class(TPasExpr)
     Value     : Boolean;
     constructor Create(AParent : TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean); overload;
@@ -214,16 +250,20 @@ type
     function GetDeclaration(full : Boolean) : string; override;
   end;
 
-  { TParamsExpr }
+  TPasExprArray = array of TPasExpr;
+
+  { TParamsExpr - source position is the opening bracket }
 
   TParamsExpr = class(TPasExpr)
     Value     : TPasExpr;
-    Params    : array of TPasExpr;
-    {pekArray, pekFuncCall, pekSet}
+    Params    : TPasExprArray;
+    // Kind: pekArrayParams, pekFuncParams, pekSet
     constructor Create(AParent : TPasElement; AKind: TPasExprKind); overload;
     function GetDeclaration(full : Boolean) : string; override;
     destructor Destroy; override;
     procedure AddParam(xp: TPasExpr);
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TRecordValues }
@@ -239,16 +279,20 @@ type
     destructor Destroy; override;
     procedure AddField(const AName: AnsiString; Value: TPasExpr);
     function GetDeclaration(full : Boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TArrayValues }
 
   TArrayValues = class(TPasExpr)
-    Values    : array of TPasExpr;
+    Values    : TPasExprArray;
     constructor Create(AParent : TPasElement); overload;
     destructor Destroy; override;
     procedure AddValues(AValue: TPasExpr);
     function GetDeclaration(full : Boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TPasDeclarations }
@@ -258,36 +302,73 @@ type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Declarations, ResStrings, Types, Consts, Classes,
+    Declarations: TFPList; // list of TPasElement
+    // Declarations contains all the following:
+    ResStrings, Types, Consts, Classes,
     Functions, Variables, Properties, ExportSymbols: TFPList;
   end;
 
+  { TPasUsesUnit - Parent is TPasSection }
+
+  TPasUsesUnit = class(TPasElement)
+  public
+    destructor Destroy; override;
+    function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+  public
+    Expr: TPasExpr; // name expression
+    InFilename: TPrimitiveExpr; // Kind=pekString, can be nil
+    Module: TPasElement; // TPasUnresolvedUnitRef or TPasModule
+  end;
+  TPasUsesClause = array of TPasUsesUnit;
+
   { TPasSection }
 
   TPasSection = class(TPasDeclarations)
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
-    procedure AddUnitToUsesList(const AUnitName: string);
+    function AddUnitToUsesList(const AUnitName: string; aName: TPasExpr = nil;
+      InFilename: TPrimitiveExpr = nil; aModule: TPasElement = nil;
+      UsesUnit: TPasUsesUnit = nil): TPasUsesUnit;
+    function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    UsesList: TFPList;            // TPasUnresolvedTypeRef or TPasModule elements
+    UsesList: TFPList; // kept for compatibility, see TPasUsesUnit.Module
+    UsesClause: TPasUsesClause;
   end;
 
   { TInterfaceSection }
 
   TInterfaceSection = class(TPasSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
   { TImplementationSection }
 
   TImplementationSection = class(TPasSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
+  { TProgramSection }
+
   TProgramSection = class(TImplementationSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
+  { TLibrarySection }
+
   TLibrarySection = class(TImplementationSection)
+  public
+    function ElementTypeName: string; override;
   end;
 
   TInitializationSection = class;
@@ -300,30 +381,35 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     InterfaceSection: TInterfaceSection;
     ImplementationSection: TImplementationSection;
-    InitializationSection: TInitializationSection;
+    InitializationSection: TInitializationSection; // in TPasProgram the begin..end.
     FinalizationSection: TFinalizationSection;
     PackageName: string;
     Filename   : String;  // the IN filename, only written when not empty.
   end;
 
-  { TPasProgram }
-
   { TPasUnitModule }
 
   TPasUnitModule = Class(TPasModule)
     function ElementTypeName: string; override;
   end;
 
+  { TPasProgram }
+
   TPasProgram = class(TPasModule)
   Public
     destructor Destroy; override;
     function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   Public
     ProgramSection: TProgramSection;
     InputFile,OutPutFile : String;
+    // Note: the begin..end. block is in the InitializationSection
   end;
 
   { TPasLibrary }
@@ -332,6 +418,8 @@ type
   Public
     destructor Destroy; override;
     function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   Public
     LibrarySection: TLibrarySection;
     InputFile,OutPutFile : String;
@@ -344,6 +432,8 @@ type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     Modules: TFPList;     // List of TPasModule objects
   end;
@@ -355,6 +445,8 @@ type
     Destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean) : string; Override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     Expr: TPasExpr;
   end;
@@ -366,24 +458,29 @@ type
     function ElementTypeName: string; override;
   end;
 
-  { TPasPointerType }
+  { TPasAliasType }
 
-  TPasPointerType = class(TPasType)
+  TPasAliasType = class(TPasType)
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean): string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     DestType: TPasType;
+    Expr: TPasExpr;
   end;
 
-  { TPasAliasType }
+  { TPasPointerType - todo: change it TPasAliasType }
 
-  TPasAliasType = class(TPasType)
+  TPasPointerType = class(TPasType)
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean): string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     DestType: TPasType;
   end;
@@ -403,6 +500,36 @@ type
     function GetDeclaration(full: boolean) : string; override;
   end;
 
+  { TPasSpecializeType }
+
+  TPasSpecializeType = class(TPasAliasType)
+  public
+    constructor Create(const AName: string; AParent: TPasElement); override;
+    destructor Destroy; override;
+    function ElementTypeName: string; override;
+    function GetDeclaration(full: boolean) : string; override;
+    procedure AddParam(El: TPasElement);
+  public
+    Params: TFPList; // list of TPasType or TPasExpr
+  end;
+
+  { TInlineTypeExpr }
+
+  TInlineTypeExpr = class(TPasExpr)
+  public
+    destructor Destroy; override;
+    function ElementTypeName: string; override;
+    function GetDeclaration(full : Boolean): string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+  public
+    DestType: TPasType;
+  end;
+
+  { TInlineSpecializeExpr }
+
+  TInlineSpecializeExpr = class(TInlineTypeExpr)
+  end;
 
   { TPasRangeType }
 
@@ -410,8 +537,10 @@ type
   public
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    RangeExpr : TBinaryExpr;
+    RangeExpr : TBinaryExpr; // Kind=pekRange
     Destructor Destroy; override;
     Function RangeStart : String;
     Function RangeEnd : String;
@@ -424,11 +553,16 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    IndexRange : string;
+    IndexRange : string; // only valid if Parser po_arrayrangeexpr disabled
+    Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
     PackMode : TPackMode;
     ElType: TPasType;
+    Function IsGenericArray : Boolean;
     Function IsPacked : Boolean;
+    procedure AddRange(Range: TPasExpr);
   end;
 
   { TPasFileType }
@@ -438,15 +572,19 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     ElType: TPasType;
   end;
 
-  { TPasEnumValue }
+  { TPasEnumValue - Parent is TPasEnumType }
 
   TPasEnumValue = class(TPasElement)
   public
     function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     Value: TPasExpr;
     Destructor Destroy; override;
@@ -459,11 +597,13 @@ type
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
-     function ElementTypeName: string; override;
+    function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
     Procedure GetEnumNames(Names : TStrings);
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Values: TFPList;      // List of TPasEnumValue objects
+    Values: TFPList;      // List of TPasEnumValue
   end;
 
   { TPasSetType }
@@ -473,8 +613,11 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     EnumType: TPasType;
+    IsPacked : Boolean;
   end;
 
   TPasRecordType = class;
@@ -486,8 +629,10 @@ type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Values: TFPList;
+    Values: TFPList; // list of TPasElement
     Members: TPasRecordType;
   end;
 
@@ -501,20 +646,23 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    PackMode : TPackMode;
+    PackMode: TPackMode;
     Members: TFPList;     // array of TPasVariable elements
-    VariantName: string;
-    VariantType: TPasType;
+    VariantEl: TPasElement; // TPasVariable or TPasType
     Variants: TFPList;	// array of TPasVariant elements, may be nil!
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
     Function IsPacked: Boolean;
     Function IsBitPacked : Boolean;
     Function IsAdvancedRecord : Boolean;
+    Procedure SetGenericTemplates(AList : TFPList);
   end;
 
-  TPasGenericTemplateType = Class(TPasElement);
+  TPasGenericTemplateType = Class(TPasType);
   TPasObjKind = (okObject, okClass, okInterface, okGeneric, okSpecialize,
-                 okClassHelper,okRecordHelper,okTypeHelper);
+                 okClassHelper,okRecordHelper,okTypeHelper, okDispInterface);
 
   { TPasClassType }
 
@@ -523,23 +671,31 @@ type
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    PackMode : TPackMode;
+    PackMode: TPackMode;
     ObjKind: TPasObjKind;
-    AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
+    AncestorType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
     HelperForType: TPasType;     // TPasClassType or TPasUnresolvedTypeRef
-    IsForward : Boolean;
+    IsForward: Boolean;
+    IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
     GUIDExpr : TPasExpr;
-    Members: TFPList;     // array of TPasElement objects
-    ClassVars: TFPList;   // class vars
+    Members: TFPList;     // list of TPasElement
     Modifiers: TStringList;
-    Interfaces : TFPList;
-    GenericTemplateTypes : TFPList;
+    Interfaces : TFPList; // list of TPasElement
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
+    ExternalNameSpace : String;
+    ExternalName : String;
+    Procedure SetGenericTemplates(AList : TFPList);
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function IsPacked : Boolean;
     Function InterfaceGUID : string;
+    Function IsSealed : Boolean;
+    Function IsAbstract : Boolean;
+    Function HasModifier(const aModifier: String): Boolean;
   end;
 
 
@@ -553,16 +709,25 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     Access: TArgumentAccess;
-    ArgType: TPasType;
-    ValueExpr: TPasExpr;
+    ArgType: TPasType; // can be nil, when Access<>argDefault
+    ValueExpr: TPasExpr; // the default value
     Function Value : String;
   end;
 
   { TPasProcedureType }
 
   TPasProcedureType = class(TPasType)
+  private
+    function GetIsNested: Boolean;
+    function GetIsOfObject: Boolean;
+    function GetIsReference: Boolean;
+    procedure SetIsNested(const AValue: Boolean);
+    procedure SetIsOfObject(const AValue: Boolean);
+    procedure SetIsReference(AValue: Boolean);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -571,11 +736,15 @@ type
     function GetDeclaration(full : boolean) : string; override;
     procedure GetArguments(List : TStrings);
     function CreateArgument(const AName, AUnresolvedTypeName: string):TPasArgument;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    IsOfObject: Boolean;
-    IsNested : Boolean;
     Args: TFPList;        // List of TPasArgument objects
-    CallingConvention : TCallingConvention;
+    CallingConvention: TCallingConvention;
+    Modifiers: TProcTypeModifiers;
+    property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
+    property IsNested : Boolean read GetIsNested write SetIsNested;
+    property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
   end;
 
   { TPasResultElement }
@@ -584,6 +753,8 @@ type
   public
     destructor Destroy; override;
     function ElementTypeName : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     ResultType: TPasType;
   end;
@@ -596,6 +767,8 @@ type
     class function TypeName: string; override;
     function ElementTypeName: string; override;
     function GetDeclaration(Full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     ResultEl: TPasResultElement;
   end;
@@ -613,12 +786,12 @@ type
   { TPasUnresolvedUnitRef }
 
   TPasUnresolvedUnitRef = Class(TPasUnresolvedSymbolRef)
-    function ElementTypeName: string; override;
-  Public
+  public
     FileName : string;
+    function ElementTypeName: string; override;
   end;
 
-  { TPasStringType }
+  { TPasStringType - e.g. string[len] }
 
   TPasStringType = class(TPasUnresolvedTypeRef)
   public
@@ -626,16 +799,18 @@ type
     function ElementTypeName: string; override;
   end;
 
-  { TPasTypeRef }
+  { TPasTypeRef  - not used by TPasParser }
 
   TPasTypeRef = class(TPasUnresolvedTypeRef)
   public
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     RefType: TPasType;
   end;
 
   { TPasVariable }
-  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass);
+  TVariableModifier = (vmCVar, vmExternal, vmPublic, vmExport, vmClass, vmStatic);
   TVariableModifiers = set of TVariableModifier;
 
   TPasVariable = class(TPasElement)
@@ -643,10 +818,13 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     VarType: TPasType;
     VarModifiers : TVariableModifiers;
-    LibraryName,ExportName : string;
+    LibraryName : TPasExpr; // libname of modifier external
+    ExportName : TPasExpr; // symbol name of modifier external, export and public
     Modifiers : string;
     AbsoluteLocation : String;
     Expr: TPasExpr;
@@ -656,38 +834,53 @@ type
   { TPasExportSymbol }
 
   TPasExportSymbol = class(TPasElement)
+  public
     ExportName : TPasExpr;
-    Exportindex : TPasExpr;
+    ExportIndex : TPasExpr;
     Destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TPasConst }
 
   TPasConst = class(TPasVariable)
   public
-  public
+    IsConst: boolean; // e.g. $WritableConst off
     function ElementTypeName: string; override;
   end;
 
   { TPasProperty }
 
   TPasProperty = class(TPasVariable)
-  Public
+  private
     FResolvedType : TPasType;
+    function GetIsClass: boolean;
+    procedure SetIsClass(AValue: boolean);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    IndexExpr,
-    DefaultExpr : TPasExpr;
+    IndexExpr: TPasExpr;
+    ReadAccessor: TPasExpr;
+    WriteAccessor: TPasExpr;
+    ImplementsFunc: TPasExpr;
+    DispIDExpr : TPasexpr;   // Can be nil.
+
+    StoredAccessor: TPasExpr; // can be nil, if StoredAccessorName is 'True' or 'False'
+    DefaultExpr: TPasExpr;
     Args: TFPList;        // List of TPasArgument objects
-    ReadAccessorName, WriteAccessorName,ImplementsName,
+    ReadAccessorName, WriteAccessorName, ImplementsName,
       StoredAccessorName: string;
-    IsClass, IsDefault, IsNodefault: Boolean;
+    DispIDReadOnly,
+    IsDefault, IsNodefault: Boolean;
+    property IsClass: boolean read GetIsClass write SetIsClass;
     Function ResolvedType : TPasType;
     Function IndexValue : String;
     Function DefaultValue : string;
@@ -708,14 +901,19 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     Overloads: TFPList;           // List of TPasProcedure nodes
   end;
 
+  { TPasProcedure }
+
   TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
                         pmExport, pmOverload, pmMessage, pmReintroduce,
-                        pmStatic,pmInline,pmAssembler,pmVarargs, pmPublic,
-                        pmCompilerProc,pmExternal,pmForward);
+                        pmInline,pmAssembler, pmPublic,
+                        pmCompilerProc,pmExternal,pmForward, pmDispId, 
+                        pmNoReturn, pmfar, pmFinal);
   TProcedureModifiers = Set of TProcedureModifier;
   TProcedureMessageType = (pmtNone,pmtInteger,pmtString);
                         
@@ -734,12 +932,16 @@ type
     function TypeName: string; override;
     function GetDeclaration(full: Boolean): string; override;
     procedure GetModifiers(List: TStrings);
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
-    PublicName,
+    PublicName, // e.g. public PublicName;
     LibrarySymbolName,
-    LibraryExpr : TPasExpr;
+    LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
+    DispIDExpr :  TPasExpr;
+    AliasName : String;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -760,7 +962,7 @@ type
 
   TPasFunction = class(TPasProcedure)
   private
-    function GetFT: TPasFunctionType;
+    function GetFT: TPasFunctionType; inline;
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
@@ -773,7 +975,7 @@ type
                    otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
                    otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
                    otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
-                   otRightShift);
+                   otRightShift,otEnumerator);
   TOperatorTypes = set of TOperatorType;
 
   TPasOperator = class(TPasFunction)
@@ -794,7 +996,7 @@ type
     function TypeName: string; override;
     function GetDeclaration (full : boolean) : string; override;
     Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
-    // True if the declaration was using a token instead of a
+    // True if the declaration was using a token instead of an identifier
     Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
   end;
 
@@ -848,7 +1050,7 @@ Type
 
   { TPasClassFunction }
 
-  TPasClassFunction = class(TPasProcedure)
+  TPasClassFunction = class(TPasFunction)
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
@@ -862,9 +1064,9 @@ Type
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-
-    Labels: TFPList;
     Body: TPasImplBlock;
   end;
 
@@ -903,11 +1105,11 @@ Type
   TPasImplElement = class(TPasElement)
   end;
 
-  { TPasImplCommand }
+  { TPasImplCommand - currently used as empty statement, e.g. if then else ; }
 
   TPasImplCommand = class(TPasImplElement)
   public
-    Command: string;
+    Command: string; // never set by TPasParser
   end;
 
   { TPasImplCommands - used by mkxmlrpc, not used by pparser }
@@ -924,7 +1126,7 @@ Type
 
   TPasLabels = class(TPasImplElement)
   public
-    Labels  : TStrings;
+    Labels: TStrings;
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
   end;
@@ -960,17 +1162,22 @@ Type
     function AddCaseOf(const Expression: TPasExpr): TPasImplCaseOf;
     function AddForLoop(AVar: TPasVariable;
       const AStartValue, AEndValue: TPasExpr): TPasImplForLoop;
-    function AddForLoop(const AVarName : String; AStartValue, AEndValue: TPasExpr;
+    function AddForLoop(AVarName : TPasExpr; AStartValue, AEndValue: TPasExpr;
       ADownTo: Boolean = false): TPasImplForLoop;
     function AddTry: TPasImplTry;
-    function AddExceptOn(const VarName, TypeName: TPasExpr): TPasImplExceptOn;
+    function AddExceptOn(const VarName, TypeName: string): TPasImplExceptOn;
+    function AddExceptOn(const VarName: string; VarType: TPasType): TPasImplExceptOn;
+    function AddExceptOn(const VarEl: TPasVariable): TPasImplExceptOn;
+    function AddExceptOn(const TypeEl: TPasType): TPasImplExceptOn;
     function AddRaise: TPasImplRaise;
     function AddLabelMark(const Id: string): TPasImplLabelMark;
     function AddAssign(left, right: TPasExpr): TPasImplAssign;
     function AddSimple(exp: TPasExpr): TPasImplSimple;
     function CloseOnSemicolon: boolean; virtual;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Elements: TFPList;    // TPasImplElement objects
+    Elements: TFPList;    // list of TPasImplElement and maybe one TPasImplCaseElse
   end;
 
   { TPasImplStatement }
@@ -1013,6 +1220,8 @@ Type
     ConditionExpr : TPasExpr;
     destructor Destroy; override;
     Function Condition: string;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TPasImplIfElse }
@@ -1022,8 +1231,10 @@ Type
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
     function CloseOnSemicolon: boolean; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    ConditionExpr : TPasExpr;
+    ConditionExpr: TPasExpr;
     IfBranch: TPasImplElement;
     ElseBranch: TPasImplElement; // can be nil
     Function Condition: string;
@@ -1035,6 +1246,8 @@ Type
   public
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     ConditionExpr : TPasExpr;
     Body: TPasImplElement;
@@ -1049,15 +1262,17 @@ Type
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
     procedure AddExpression(const Expression: TPasExpr);
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Expressions: TFPList;
+    Expressions: TFPList; // list of TPasExpr
     Body: TPasImplElement;
   end;
 
   TPasImplCaseStatement = class;
   TPasImplCaseElse = class;
 
-  { TPasImplCaseOf }
+  { TPasImplCaseOf - Elements are TPasImplCaseStatement }
 
   TPasImplCaseOf = class(TPasImplBlock)
   public
@@ -1065,9 +1280,11 @@ Type
     procedure AddElement(Element: TPasImplElement); override;
     function AddCase(const Expression: TPasExpr): TPasImplCaseStatement;
     function AddElse: TPasImplCaseElse;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     CaseExpr : TPasExpr;
-    ElseBranch: TPasImplCaseElse;
+    ElseBranch: TPasImplCaseElse; // this is also in Elements
     function Expression: string;
   end;
 
@@ -1079,8 +1296,10 @@ Type
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
     procedure AddExpression(const Expr: TPasExpr);
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Expressions: TFPList;
+    Expressions: TFPList; // list of TPasExpr
     Body: TPasImplElement;
   end;
 
@@ -1090,18 +1309,21 @@ Type
   end;
 
   { TPasImplForLoop }
+
   TLoopType = (ltNormal,ltDown,ltIn);
   TPasImplForLoop = class(TPasImplStatement)
   public
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    Variable: TPasVariable;
+    VariableName : TPasExpr;
+    LoopType : TLoopType;
     StartExpr : TPasExpr;
     EndExpr : TPasExpr;
-    VariableName : String;
-    LoopType : TLoopType;
     Body: TPasImplElement;
+    Variable: TPasVariable; // not used by TPasParser
     Function Down: boolean; // downto, backward compatibility
     Function StartValue : String;
     Function EndValue: string;
@@ -1115,6 +1337,8 @@ Type
     right : TPasExpr;
     Kind : TAssignKind;
     Destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   { TPasImplSimple }
@@ -1123,6 +1347,8 @@ Type
   public
     expr  : TPasExpr;
     Destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   end;
 
   TPasImplTryHandler = class;
@@ -1138,6 +1364,8 @@ Type
     function AddFinally: TPasImplTryFinally;
     function AddExcept: TPasImplTryExcept;
     function AddExceptElse: TPasImplTryExceptElse;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
     FinallyExcept: TPasImplTryHandler;
     ElseBranch: TPasImplTryExceptElse;
@@ -1167,8 +1395,11 @@ Type
   public
     destructor Destroy; override;
     procedure AddElement(Element: TPasImplElement); override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   public
-    VarExpr,TypeExpr : TPasExpr;
+    VarEl: TPasVariable; // can be nil
+    TypeEl : TPasType;
     Body: TPasImplElement;
     Function VariableName : String;
     Function TypeName: string;
@@ -1179,36 +1410,59 @@ Type
   TPasImplRaise = class(TPasImplStatement)
   public
     destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
   Public
     ExceptObject,
     ExceptAddr : TPasExpr;
   end;
 
-  { TPassTreeVisitor }
+  { TPasImplLabelMark }
 
-  TPassTreeVisitor = class
-    procedure Visit(obj: TPasElement); virtual;
+  TPasImplLabelMark = class(TPasImplElement)
+  public
+    LabelId: AnsiString;
   end;
 
-  TPasImplLabelMark = class(TPasImplElement)
+  { TPassTreeVisitor }
+
+  TPassTreeVisitor = class
   public
-    LabelId:  AnsiString;
+    procedure Visit(obj: TPasElement); virtual;
   end;
 
 const
   AccessNames: array[TArgumentAccess] of string[9] = ('', 'const ', 'var ', 'out ','constref ');
+  AccessDescriptions: array[TArgumentAccess] of string[9] = ('default', 'const', 'var', 'out','constref');
   AllVisibilities: TPasMemberVisibilities =
      [visDefault, visPrivate, visProtected, visPublic,
       visPublished, visAutomated];
 
   VisibilityNames: array[TPasMemberVisibility] of string = (
-    'default', 'private', 'protected', 'public', 'published', 'automated','strict private', 'strict protected');
+    'default','private', 'protected', 'public', 'published', 'automated',
+    'strict private', 'strict protected');
 
   ObjKindNames: array[TPasObjKind] of string = (
-    'object', 'class', 'interface','class','class','class helper','record helper','type helper');
-  
-  OpcodeStrings : Array[TExprOpCode] of string = 
-       ('','+','-','*','/','div','mod','**',
+    'object', 'class', 'interface','class','class','class helper','record helper','type helper','dispinterface');
+
+  ExprKindNames : Array[TPasExprKind] of string = (
+      'Ident',
+      'Number',
+      'String',
+      'Set',
+      'Nil',
+      'BoolConst',
+      'Range',
+      'Unary',
+      'Binary',
+      'FuncParams',
+      'ArrayParams',
+      'ListOfExp',
+      'Inherited',
+      'Self');
+
+  OpcodeStrings : Array[TExprOpCode] of string = (
+        '','+','-','*','/','div','mod','**',
         'shr','shl',
         'not','and','or','xor',
         '=','<>',
@@ -1218,36 +1472,193 @@ const
         '.');
 
 
-  UnaryOperators = [otImplicit,otExplicit,otAssign,otNegative,otPositive];
+  UnaryOperators = [otImplicit,otExplicit,otAssign,otNegative,otPositive,otEnumerator];
 
   OperatorTokens : Array[TOperatorType] of string
        =  ('','','','*','+','-','/','<','=',
            '>',':=','<>','<=','>=','**',
            '><','Inc','Dec','mod','-','+','Or','div',
            'shl','or','and','xor','and','not','xor',
-           'shr');
+           'shr','enumerator');
   OperatorNames : Array[TOperatorType] of string
        =  ('','implicit','explicit','multiply','add','subtract','divide','lessthan','equal',
            'greaterthan','assign','notequal','lessthanorequal','greaterthanorequal','power',
            'symmetricaldifference','inc','dec','modulus','negative','positive','bitwiseor','intdivide',
            'leftshift','logicalor','bitwiseand','bitwisexor','logicaland','logicalnot','logicalxor',
-           'rightshift');
+           'rightshift','enumerator');
+
+  AssignKindNames : Array[TAssignKind] of string = (':=','+=','-=','*=','/=' );
 
-  cPasMemberHint : array[TPasMemberHint] of string =
+  cPasMemberHint : Array[TPasMemberHint] of string =
       ( 'deprecated', 'library', 'platform', 'experimental', 'unimplemented' );
-  cCallingConventions : array[TCallingConvention] of string =
+  cCallingConventions : Array[TCallingConvention] of string =
       ( '', 'Register','Pascal','CDecl','StdCall','OldFPCCall','SafeCall','SysCall');
+  ProcTypeModifiers : Array[TProcTypeModifier] of string =
+      ('of Object', 'is nested','static','varargs','reference to');
 
   ModifierNames : Array[TProcedureModifier] of string
                 = ('virtual', 'dynamic','abstract', 'override',
                    'export', 'overload', 'message', 'reintroduce',
-                   'static','inline','assembler','varargs', 'public',
-                   'compilerproc','external','forward');
+                   'inline','assembler','public',
+                   'compilerproc','external','forward','dispid',
+                   'noreturn','far','final');
+
+  VariableModifierNames : Array[TVariableModifier] of string
+     = ('cvar', 'external', 'public', 'export', 'class', 'static');
+
+procedure ReleaseAndNil(var El: TPasElement); overload;
 
 implementation
 
 uses SysUtils;
 
+procedure ReleaseAndNil(var El: TPasElement);
+begin
+  if El=nil then exit;
+  {$IFDEF VerbosePasTreeMem}writeln('ReleaseAndNil ',El.Name,' ',El.ClassName);{$ENDIF}
+  El.Release;
+  El:=nil;
+end;
+
+{ TInlineTypeExpr }
+
+destructor TInlineTypeExpr.Destroy;
+begin
+  ReleaseAndNil(TPasElement(DestType));
+  inherited Destroy;
+end;
+
+function TInlineTypeExpr.ElementTypeName: string;
+begin
+  Result := DestType.ElementTypeName;
+end;
+
+function TInlineTypeExpr.GetDeclaration(full: Boolean): string;
+begin
+  Result:=DestType.GetDeclaration(full);
+end;
+
+procedure TInlineTypeExpr.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+begin
+  DestType.ForEachChildCall(aMethodCall,Arg,DestType,true);
+end;
+
+{ TPasSpecializeType }
+
+constructor TPasSpecializeType.Create(const AName: string; AParent: TPasElement
+  );
+begin
+  inherited Create(AName, AParent);
+  Params:=TFPList.Create;
+end;
+
+destructor TPasSpecializeType.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to Params.Count-1 do
+    TPasElement(Params[i]).Release;
+  FreeAndNil(Params);
+  inherited Destroy;
+end;
+
+function TPasSpecializeType.ElementTypeName: string;
+begin
+  Result:=SPasTreeSpecializedType;
+end;
+
+function TPasSpecializeType.GetDeclaration(full: boolean): string;
+var
+  i: Integer;
+begin
+  Result:='specialize '+DestType.Name+'<';
+  for i:=0 to Params.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
+    end;
+  If Full then
+    begin
+    Result:=Name+' = '+Result;
+    ProcessHints(False,Result);
+    end;
+end;
+
+procedure TPasSpecializeType.AddParam(El: TPasElement);
+begin
+  Params.Add(El);
+end;
+
+{ TInterfaceSection }
+
+function TInterfaceSection.ElementTypeName: string;
+begin
+  Result:=SPasTreeInterfaceSection;
+end;
+
+{ TLibrarySection }
+
+function TLibrarySection.ElementTypeName: string;
+begin
+  Result:=SPasTreeLibrarySection;
+end;
+
+{ TProgramSection }
+
+function TProgramSection.ElementTypeName: string;
+begin
+  Result:=SPasTreeProgramSection;
+end;
+
+{ TImplementationSection }
+
+function TImplementationSection.ElementTypeName: string;
+begin
+  Result:=SPasTreeImplementationSection;
+end;
+
+{ TPasUsesUnit }
+
+destructor TPasUsesUnit.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Expr));
+  ReleaseAndNil(TPasElement(InFilename));
+  ReleaseAndNil(TPasElement(Module));
+  inherited Destroy;
+end;
+
+function TPasUsesUnit.ElementTypeName: string;
+begin
+  Result := SPasTreeUsesUnit;
+end;
+
+procedure TPasUsesUnit.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Expr,false);
+  ForEachChildCall(aMethodCall,Arg,InFilename,false);
+  ForEachChildCall(aMethodCall,Arg,Module,true);
+end;
+
+{ TPasElementBase }
+
+procedure TPasElementBase.Accept(Visitor: TPassTreeVisitor);
+begin
+  if Visitor=nil then ;
+end;
+
+{ TPasTypeRef }
+
+procedure TPasTypeRef.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,RefType,true);
+end;
+
 { TPasClassOperator }
 
 function TPasClassOperator.TypeName: string;
@@ -1281,16 +1692,24 @@ end;
 
 destructor TPasImplRaise.Destroy;
 begin
-  FreeAndNil(ExceptObject);
-  FreeAndNil(ExceptAddr);
+  ReleaseAndNil(TPasElement(ExceptObject));
+  ReleaseAndNil(TPasElement(ExceptAddr));
   Inherited;
 end;
 
+procedure TPasImplRaise.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ExceptObject,false);
+  ForEachChildCall(aMethodCall,Arg,ExceptAddr,false);
+end;
+
 { TPasImplRepeatUntil }
 
 destructor TPasImplRepeatUntil.Destroy;
 begin
-  FreeAndNil(ConditionExpr);
+  ReleaseAndNil(TPasElement(ConditionExpr));
   inherited Destroy;
 end;
 
@@ -1302,29 +1721,51 @@ begin
     Result:='';
 end;
 
+procedure TPasImplRepeatUntil.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
+end;
+
 { TPasImplSimple }
 
 destructor TPasImplSimple.Destroy;
 begin
-  FreeAndNil(Expr);
+  ReleaseAndNil(TPasElement(Expr));
   inherited Destroy;
 end;
 
+procedure TPasImplSimple.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Expr,false);
+end;
+
 { TPasImplAssign }
 
 destructor TPasImplAssign.Destroy;
 begin
-  FreeAndNil(Left);
-  FreeAndNil(Right);
+  ReleaseAndNil(TPasElement(Left));
+  ReleaseAndNil(TPasElement(Right));
   inherited Destroy;
 end;
 
+procedure TPasImplAssign.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,left,false);
+  ForEachChildCall(aMethodCall,Arg,right,false);
+end;
+
 { TPasExportSymbol }
 
 destructor TPasExportSymbol.Destroy;
 begin
-  FreeAndNil(ExportName);
-  FreeAndNil(ExportIndex);
+  ReleaseAndNil(TPasElement(ExportName));
+  ReleaseAndNil(TPasElement(ExportIndex));
   inherited Destroy;
 end;
 
@@ -1342,6 +1783,14 @@ begin
     Result:=Result+' index '+ExportIndex.GetDeclaration(Full);
 end;
 
+procedure TPasExportSymbol.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ExportName,false);
+  ForEachChildCall(aMethodCall,Arg,ExportIndex,false);
+end;
+
 { TPasUnresolvedUnitRef }
 
 function TPasUnresolvedUnitRef.ElementTypeName: string;
@@ -1353,7 +1802,7 @@ end;
 
 destructor TPasLibrary.Destroy;
 begin
-  FreeAndNil(LibrarySection);
+  ReleaseAndNil(TPasElement(LibrarySection));
   inherited Destroy;
 end;
 
@@ -1362,12 +1811,22 @@ begin
   Result:=inherited ElementTypeName;
 end;
 
+procedure TPasLibrary.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,LibrarySection,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 { TPasProgram }
 
 destructor TPasProgram.Destroy;
 begin
-  FreeAndNil(ProgramSection);
+  {$IFDEF VerbosePasTreeMem}writeln('TPasProgram.Destroy ProgramSection');{$ENDIF}
+  ReleaseAndNil(TPasElement(ProgramSection));
+  {$IFDEF VerbosePasTreeMem}writeln('TPasProgram.Destroy inherited');{$ENDIF}
   inherited Destroy;
+  {$IFDEF VerbosePasTreeMem}writeln('TPasProgram.Destroy END');{$ENDIF}
 end;
 
 function TPasProgram.ElementTypeName: string;
@@ -1375,6 +1834,13 @@ begin
   Result:=inherited ElementTypeName;
 end;
 
+procedure TPasProgram.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,ProgramSection,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 { TPasUnitModule }
 
 function TPasUnitModule.ElementTypeName: string;
@@ -1394,7 +1860,7 @@ end;
 
 function TPasElement.ElementTypeName: string; begin Result := SPasTreeElement end;
 
-Function TPasElement.HintsString: String;
+function TPasElement.HintsString: String;
 
 Var
   H : TPasmemberHint;
@@ -1411,22 +1877,51 @@ begin
 end;
 
 function TPasDeclarations.ElementTypeName: string; begin Result := SPasTreeSection end;
+
+procedure TPasDeclarations.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Declarations.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Declarations[i]),false);
+end;
+
 function TPasModule.ElementTypeName: string; begin Result := SPasTreeModule end;
 function TPasPackage.ElementTypeName: string; begin Result := SPasTreePackage end;
-function TPasResString.ElementTypeName: string; begin Result := SPasTreeResString end;
-function TPasType.ElementTypeName: string; begin Result := SPasTreeType end;
-function TPasPointerType.ElementTypeName: string; begin Result := SPasTreePointerType end;
-function TPasAliasType.ElementTypeName: string; begin Result := SPasTreeAliasType end;
-function TPasTypeAliasType.ElementTypeName: string; begin Result := SPasTreeTypeAliasType end;
-function TPasClassOfType.ElementTypeName: string; begin Result := SPasTreeClassOfType end;
-function TPasRangeType.ElementTypeName: string; begin Result := SPasTreeRangeType end;
-function TPasArrayType.ElementTypeName: string; begin Result := SPasTreeArrayType end;
-function TPasFileType.ElementTypeName: string; begin Result := SPasTreeFileType end;
-function TPasEnumValue.ElementTypeName: string; begin Result := SPasTreeEnumValue end;
+
+procedure TPasPackage.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Modules.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasModule(Modules[i]),true);
+end;
+
+function TPasResString.ElementTypeName: string; begin Result := SPasTreeResString; end;
+function TPasType.ElementTypeName: string; begin Result := SPasTreeType; end;
+function TPasPointerType.ElementTypeName: string; begin Result := SPasTreePointerType; end;
+function TPasAliasType.ElementTypeName: string; begin Result := SPasTreeAliasType; end;
+function TPasTypeAliasType.ElementTypeName: string; begin Result := SPasTreeTypeAliasType; end;
+function TPasClassOfType.ElementTypeName: string; begin Result := SPasTreeClassOfType; end;
+function TPasRangeType.ElementTypeName: string; begin Result := SPasTreeRangeType; end;
+function TPasArrayType.ElementTypeName: string; begin Result := SPasTreeArrayType; end;
+function TPasFileType.ElementTypeName: string; begin Result := SPasTreeFileType; end;
+function TPasEnumValue.ElementTypeName: string; begin Result := SPasTreeEnumValue; end;
+
+procedure TPasEnumValue.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Value,false);
+end;
 
 destructor TPasEnumValue.Destroy;
 begin
-  FreeAndNil(Value);
+  ReleaseAndNil(TPasElement(Value));
   inherited Destroy;
 end;
 
@@ -1444,6 +1939,14 @@ function TPasRecordType.ElementTypeName: string; begin Result := SPasTreeRecordT
 function TPasArgument.ElementTypeName: string; begin Result := SPasTreeArgument end;
 function TPasProcedureType.ElementTypeName: string; begin Result := SPasTreeProcedureType end;
 function TPasResultElement.ElementTypeName: string; begin Result := SPasTreeResultElement end;
+
+procedure TPasResultElement.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ResultType,true);
+end;
+
 function TPasFunctionType.ElementTypeName: string; begin Result := SPasTreeFunctionType end;
 function TPasUnresolvedTypeRef.ElementTypeName: string; begin Result := SPasTreeUnresolvedTypeRef end;
 function TPasVariable.ElementTypeName: string; begin Result := SPasTreeVariable end;
@@ -1559,76 +2062,6 @@ function TPasConstructorImpl.ElementTypeName: string; begin Result := SPasTreeCo
 function TPasDestructorImpl.ElementTypeName: string; begin Result := SPasTreeDestructorImpl end;
 function TPasStringType.ElementTypeName: string; begin Result:=SPasStringType;end;
 
-function TPasClassType.ElementTypeName: string;
-begin
-  case ObjKind of
-    okObject: Result := SPasTreeObjectType;
-    okClass: Result := SPasTreeClassType;
-    okInterface: Result := SPasTreeInterfaceType;
-    okGeneric : Result := SPasTreeGenericType;
-    okSpecialize : Result := SPasTreeSpecializedType;
-    okClassHelper : Result:=SPasClassHelperType;
-    okRecordHelper : Result:=SPasRecordHelperType;
-  end;
-end;
-
-function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
-
-Var
-  I : Integer;
-
-begin
-//  Writeln('Looking for ',MemberName,'(',MemberClass.ClassName,') in ',Name);
-  Result:=Nil;
-  I:=0;
-  While (Result=Nil) and (I<Members.Count) do
-    begin
-    Result:=TPasElement(Members[i]);
-    if (Result.ClassType<>MemberClass) or (CompareText(Result.Name,MemberName)<>0) then
-      Result:=Nil;
-    Inc(I);
-    end;
-end;
-
-function TPasClassType.FindMemberInAncestors(MemberClass: TPTreeElement;
-  const MemberName: String): TPasElement;
-
-  Function A (C : TPasClassType) : TPasClassType;
-
-  begin
-    if C.AncestorType is TPasClassType then
-      result:=TPasClassType(C.AncestorType)
-    else
-      result:=Nil;
-  end;
-
-Var
-  C : TPasClassType;
-
-begin
-  Result:=Nil;
-  C:=A(Self);
-  While (Result=Nil) and (C<>Nil) do
-    begin
-    Result:=C.FindMember(MemberClass,MemberName);
-    C:=A(C);
-    end;
-end;
-
-function TPasClassType.InterfaceGUID: string;
-begin
-  If Assigned(GUIDExpr) then
-    Result:=GUIDExpr.GetDeclaration(True)
-  else
-    Result:=''
-end;
-
-function TPasClassType.IsPacked: Boolean;
-begin
-  Result:=PackMode<>pmNone;
-end;
-
-
 
 { All other stuff: }
 
@@ -1655,6 +2088,17 @@ begin
   FParent := AParent;
 end;
 
+destructor TPasElement.Destroy;
+begin
+  if (FRefCount>0) and (FRefCount<high(FRefCount)) then
+    begin
+    {$if defined(debugrefcount) or defined(VerbosePasTreeMem)}writeln('TPasElement.Destroy ',Name,':',ClassName);{$ENDIF}
+    raise Exception.Create('');
+    end;
+  FParent:=nil;
+  inherited Destroy;
+end;
+
 procedure TPasElement.AddRef;
 begin
   Inc(FRefCount);
@@ -1664,24 +2108,46 @@ end;
 
 procedure TPasElement.Release;
 
-{$ifdef debugrefcount}
+{$if defined(debugrefcount) or defined(VerbosePasTreeMem)}
 Var
   Cn : String;
   {$endif}
 
 begin
-{$ifdef debugrefcount}
-  CN:=ClassName;
+{$if defined(debugrefcount) or defined(VerbosePasTreeMem)}
+  CN:=ClassName+' '+Name;
   CN:=CN+' '+IntToStr(FRefCount);
-  If Assigned(Parent) then
-    CN:=CN+' ('+Parent.ClassName+')';
-  Writeln('Release : ',Cn);
+  //If Assigned(Parent) then
+  //  CN:=CN+' ('+Parent.ClassName+')';
+  Writeln('TPasElement.Release : ',Cn);
 {$endif}
   if FRefCount = 0 then
-    Free
+    begin
+    FRefCount:=High(FRefCount);
+    Free;
+    end
+  else if FRefCount=High(FRefCount) then
+    begin
+    {$if defined(debugrefcount) or defined(VerbosePasTreeMem)}  Writeln('TPasElement.Released OUCH: ',Cn); {$endif}
+    raise Exception.Create('');
+    end
   else
     Dec(FRefCount);
-{$ifdef debugrefcount}  Writeln('Released : ',Cn); {$endif}
+{$if defined(debugrefcount) or defined(VerbosePasTreeMem)}  Writeln('TPasElement.Released : ',Cn); {$endif}
+end;
+
+procedure TPasElement.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  aMethodCall(Self,Arg);
+end;
+
+procedure TPasElement.ForEachChildCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer; Child: TPasElement; CheckParent: boolean);
+begin
+  if (Child=nil) then exit;
+  if CheckParent and (not Child.HasParent(Self)) then exit;
+  Child.ForEachCall(aMethodCall,Arg);
 end;
 
 function TPasElement.FullPath: string;
@@ -1772,6 +2238,19 @@ begin
   Visitor.Visit(Self);
 end;
 
+function TPasElement.HasParent(aParent: TPasElement): boolean;
+var
+  El: TPasElement;
+begin
+  El:=Parent;
+  while El<>nil do
+    begin
+    if El=aParent then exit(true);
+    El:=El.Parent;
+    end;
+  Result:=false;
+end;
+
 constructor TPasDeclarations.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -1790,30 +2269,38 @@ destructor TPasDeclarations.Destroy;
 var
   i: Integer;
 begin
-  ExportSymbols.Free;
-  Variables.Free;
-  Functions.Free;
-  Classes.Free;
-  Consts.Free;
-  Types.Free;
-  ResStrings.Free;
-  Properties.Free;
+  {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy START');{$ENDIF}
+  FreeAndNil(ExportSymbols);
+  FreeAndNil(Properties);
+  FreeAndNil(Variables);
+  FreeAndNil(Functions);
+  FreeAndNil(Classes);
+  FreeAndNil(Consts);
+  FreeAndNil(Types);
+  FreeAndNil(ResStrings);
+  {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy Declarations');{$ENDIF}
   for i := 0 to Declarations.Count - 1 do
     TPasElement(Declarations[i]).Release;
-  Declarations.Free;
+  FreeAndNil(Declarations);
 
+  {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy inherited');{$ENDIF}
   inherited Destroy;
+  {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy END');{$ENDIF}
 end;
 
 destructor TPasModule.Destroy;
 begin
-  if Assigned(InterfaceSection) then
-    InterfaceSection.Release;
-  if Assigned(ImplementationSection) then
-    ImplementationSection.Release;
- FreeAndNil(InitializationSection);
- FreeAndNil(FinalizationSection);
- inherited Destroy;
+  {$IFDEF VerbosePasTreeMem}writeln('TPasModule.Destroy interface');{$ENDIF}
+  ReleaseAndNil(TPasElement(InterfaceSection));
+  {$IFDEF VerbosePasTreeMem}writeln('TPasModule.Destroy implementation');{$ENDIF}
+  ReleaseAndNil(TPasElement(ImplementationSection));
+  {$IFDEF VerbosePasTreeMem}writeln('TPasModule.Destroy initialization');{$ENDIF}
+  ReleaseAndNil(TPasElement(InitializationSection));
+  {$IFDEF VerbosePasTreeMem}writeln('TPasModule.Destroy finalization');{$ENDIF}
+  ReleaseAndNil(TPasElement(FinalizationSection));
+  {$IFDEF VerbosePasTreeMem}writeln('TPasModule.Destroy inherited');{$ENDIF}
+  inherited Destroy;
+  {$IFDEF VerbosePasTreeMem}writeln('TPasModule.Destroy END');{$ENDIF}
 end;
 
 
@@ -1832,7 +2319,7 @@ var
 begin
   for i := 0 to Modules.Count - 1 do
     TPasModule(Modules[i]).Release;
-  Modules.Free;
+  FreeAndNil(Modules);
   inherited Destroy;
 end;
 
@@ -1847,14 +2334,18 @@ end;
 
 destructor TPasAliasType.Destroy;
 begin
-  if Assigned(DestType) then
-    DestType.Release;
+  ReleaseAndNil(TPasElement(DestType));
+  ReleaseAndNil(TPasElement(Expr));
   inherited Destroy;
 end;
 
 
 destructor TPasArrayType.Destroy;
+var
+  i: Integer;
 begin
+  for i:=0 to length(Ranges)-1 do
+    Ranges[i].Release;
   if Assigned(ElType) then
     ElType.Release;
   inherited Destroy;
@@ -1880,7 +2371,7 @@ var
 begin
   for i := 0 to Values.Count - 1 do
     TPasEnumValue(Values[i]).Release;
-  Values.Free;
+  FreeAndNil(Values);
   inherited Destroy;
 end;
 
@@ -1897,14 +2388,14 @@ begin
   end;
 end;
 
-
-destructor TPasSetType.Destroy;
+procedure TPasEnumType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
 begin
-  if Assigned(EnumType) then
-    begin
-    EnumType.Release;
-    end;
-  inherited Destroy;
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Values.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasEnumValue(Values[i]),false);
 end;
 
 
@@ -1921,10 +2412,10 @@ Var
 
 begin
   For I:=0 to Values.Count-1 do
-    TObject(Values[i]).Free;
-  Values.Free;
+    TPasElement(Values[i]).Release;
+  FreeAndNil(Values);
   if Assigned(Members) then
-    Members.Release;
+    ReleaseAndNil(TpasElement(Members));
   inherited Destroy;
 end;
 
@@ -1950,37 +2441,56 @@ begin
       S.Free;
     end;
     Result:=Result+');';
+    if Full then ;
     end;
 end;
 
+procedure TPasVariant.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Values.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Values[i]),false);
+  ForEachChildCall(aMethodCall,Arg,Members,false);
+end;
+
+{ TPasRecordType }
 
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
   Members := TFPList.Create;
+  GenericTemplateTypes:=TFPList.Create;
 end;
 
 destructor TPasRecordType.Destroy;
 var
   i: Integer;
 begin
+  for i := 0 to GenericTemplateTypes.Count - 1 do
+    TPasElement(GenericTemplateTypes[i]).Release;
+  FreeAndNil(GenericTemplateTypes);
+
   for i := 0 to Members.Count - 1 do
     TPasVariable(Members[i]).Release;
-  Members.Free;
+  FreeAndNil(Members);
 
-  if Assigned(VariantType) then
-    VariantType.Release;
+  if Assigned(VariantEl) then
+    ReleaseAndNil(TPasElement(VariantEl));
 
   if Assigned(Variants) then
   begin
     for i := 0 to Variants.Count - 1 do
       TPasVariant(Variants[i]).Release;
-    Variants.Free;
+    FreeAndNil(Variants);
   end;
 
   inherited Destroy;
 end;
 
+{ TPasClassType }
 
 constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
@@ -1989,10 +2499,8 @@ begin
   IsShortDefinition := False;
   Members := TFPList.Create;
   Modifiers := TStringList.Create;
-  ClassVars := TFPList.Create;
   Interfaces:= TFPList.Create;
   GenericTemplateTypes:=TFPList.Create;
-
 end;
 
 destructor TPasClassType.Destroy;
@@ -2003,30 +2511,194 @@ begin
     TPasElement(Members[i]).Release;
   for i := 0 to Interfaces.Count - 1 do
     TPasElement(Interfaces[i]).Release;
-  Members.Free;
+  FreeAndNil(Members);
   if Assigned(AncestorType) then
     AncestorType.Release;
   if Assigned(HelperForType) then
     HelperForType.Release;
-  FreeAndNil(GUIDExpr);
-  Modifiers.Free;
-  ClassVars.Free;
-  Interfaces.Free;
+  ReleaseAndNil(TPasElement(GUIDExpr));
+  FreeAndNil(Modifiers);
+  FreeAndNil(Interfaces);
   for i := 0 to GenericTemplateTypes.Count - 1 do
     TPasElement(GenericTemplateTypes[i]).Release;
-  GenericTemplateTypes.Free;
+  FreeAndNil(GenericTemplateTypes);
   inherited Destroy;
 end;
 
+function TPasClassType.ElementTypeName: string;
+begin
+  case ObjKind of
+    okObject: Result := SPasTreeObjectType;
+    okClass: Result := SPasTreeClassType;
+    okInterface: Result := SPasTreeInterfaceType;
+    okGeneric : Result := SPasTreeGenericType;
+    okSpecialize : Result := SPasTreeSpecializedType;
+    okClassHelper : Result:=SPasClassHelperType;
+    okRecordHelper : Result:=SPasRecordHelperType;
+  else
+    Result:='ObjKind('+IntToStr(ord(ObjKind))+')';
+  end;
+end;
+
+procedure TPasClassType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+
+  ForEachChildCall(aMethodCall,Arg,AncestorType,true);
+  for i:=0 to Interfaces.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Interfaces[i]),true);
+  ForEachChildCall(aMethodCall,Arg,HelperForType,true);
+  ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
+  for i:=0 to Members.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
+  for i:=0 to GenericTemplateTypes.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
+end;
+
+procedure TPasClassType.SetGenericTemplates(AList: TFPList);
+
+Var
+  I : Integer;
+
+begin
+  ObjKind:=okGeneric;
+  For I:=0 to AList.Count-1 do
+    begin
+    TPasElement(AList[i]).Parent:=Self;
+    GenericTemplateTypes.Add(AList[i]);
+    end;
+  ObjKind:=okGeneric;
+end;
+
+function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
+
+Var
+  I : Integer;
+
+begin
+//  Writeln('Looking for ',MemberName,'(',MemberClass.ClassName,') in ',Name);
+  Result:=Nil;
+  I:=0;
+  While (Result=Nil) and (I<Members.Count) do
+    begin
+    Result:=TPasElement(Members[i]);
+    if (Result.ClassType<>MemberClass) or (CompareText(Result.Name,MemberName)<>0) then
+      Result:=Nil;
+    Inc(I);
+    end;
+end;
+
+function TPasClassType.FindMemberInAncestors(MemberClass: TPTreeElement;
+  const MemberName: String): TPasElement;
+
+  Function A (C : TPasClassType) : TPasClassType;
+
+  begin
+    if C.AncestorType is TPasClassType then
+      result:=TPasClassType(C.AncestorType)
+    else
+      result:=Nil;
+  end;
+
+Var
+  C : TPasClassType;
+
+begin
+  Result:=Nil;
+  C:=A(Self);
+  While (Result=Nil) and (C<>Nil) do
+    begin
+    Result:=C.FindMember(MemberClass,MemberName);
+    C:=A(C);
+    end;
+end;
+
+function TPasClassType.InterfaceGUID: string;
+begin
+  If Assigned(GUIDExpr) then
+    Result:=GUIDExpr.GetDeclaration(True)
+  else
+    Result:=''
+end;
+
+function TPasClassType.IsSealed: Boolean;
+begin
+  Result:=HasModifier('sealed');
+end;
+
+function TPasClassType.IsAbstract: Boolean;
+begin
+  Result:=HasModifier('abstract');
+end;
+
+function TPasClassType.HasModifier(const aModifier: String): Boolean;
+var
+  i: Integer;
+begin
+  for i:=0 to Modifiers.Count-1 do
+    if CompareText(aModifier,Modifiers[i])=0 then
+      exit(true);
+  Result:=false;
+end;
+
+function TPasClassType.IsPacked: Boolean;
+begin
+  Result:=PackMode<>pmNone;
+end;
+
+
+{ TPasArgument }
 
 destructor TPasArgument.Destroy;
 begin
-  if Assigned(ArgType) then
-    ArgType.Release;
-  FreeAndNil(ValueExpr);
+  ReleaseAndNil(TPasElement(ArgType));
+  ReleaseAndNil(TPasElement(ValueExpr));
   inherited Destroy;
 end;
 
+{ TPasProcedureType }
+
+function TPasProcedureType.GetIsNested: Boolean;
+begin
+  Result:=ptmIsNested in Modifiers;
+end;
+
+function TPasProcedureType.GetIsOfObject: Boolean;
+begin
+  Result:=ptmOfObject in Modifiers;
+end;
+
+function TPasProcedureType.GetIsReference: Boolean;
+begin
+  Result:=ptmReferenceTo in Modifiers;
+end;
+
+procedure TPasProcedureType.SetIsNested(const AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmIsNested)
+  else
+    Exclude(Modifiers,ptmIsNested);
+end;
+
+procedure TPasProcedureType.SetIsOfObject(const AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmOfObject)
+  else
+    Exclude(Modifiers,ptmOfObject);
+end;
+
+procedure TPasProcedureType.SetIsReference(AValue: Boolean);
+begin
+  if AValue then
+    Include(Modifiers,ptmReferenceTo)
+  else
+    Exclude(Modifiers,ptmReferenceTo);
+end;
 
 constructor TPasProcedureType.Create(const AName: string; AParent: TPasElement);
 begin
@@ -2057,6 +2729,17 @@ begin
   Result.ArgType := TPasUnresolvedTypeRef.Create(AUnresolvedTypeName, Result);
 end;
 
+procedure TPasProcedureType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Args.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Args[i]),false);
+end;
+
+{ TPasResultElement }
 
 destructor TPasResultElement.Destroy;
 begin
@@ -2082,6 +2765,7 @@ end;
 
 constructor TPasUnresolvedTypeRef.Create(const AName: string; AParent: TPasElement);
 begin
+  if AParent=nil then ;
   inherited Create(AName, nil);
 end;
 
@@ -2091,13 +2775,25 @@ begin
 //  FreeAndNil(Expr);
   { Attention, in derived classes, VarType isn't necessarily set!
     (e.g. in Constants) }
-  if Assigned(VarType) then
-    VarType.Release;
-  if Assigned(Expr) then
-    Expr.Release;
+  ReleaseAndNil(TPasElement(VarType));
+  ReleaseAndNil(TPasElement(Expr));
+  ReleaseAndNil(TPasElement(LibraryName));
+  ReleaseAndNil(TPasElement(ExportName));
   inherited Destroy;
 end;
 
+function TPasProperty.GetIsClass: boolean;
+begin
+  Result:=vmClass in VarModifiers;
+end;
+
+procedure TPasProperty.SetIsClass(AValue: boolean);
+begin
+   if AValue then
+    Include(VarModifiers,vmClass)
+  else
+    Exclude(VarModifiers,vmClass);
+end;
 
 constructor TPasProperty.Create(const AName: string; AParent: TPasElement);
 begin
@@ -2111,9 +2807,14 @@ var
 begin
   for i := 0 to Args.Count - 1 do
     TPasArgument(Args[i]).Release;
-  Args.Free;
-  FreeAndNil(DefaultExpr);
-  FreeAndNil(IndexExpr);
+  FreeAndNil(Args);
+  ReleaseAndNil(TPasElement(IndexExpr));
+  ReleaseAndNil(TPasElement(ReadAccessor));
+  ReleaseAndNil(TPasElement(WriteAccessor));
+  ReleaseAndNil(TPasElement(ImplementsFunc));
+  ReleaseAndNil(TPasElement(StoredAccessor));
+  ReleaseAndNil(TPasElement(DefaultExpr));
+  ReleaseAndNil(TPasElement(DispIDExpr));
   inherited Destroy;
 end;
 
@@ -2130,7 +2831,7 @@ var
 begin
   for i := 0 to Overloads.Count - 1 do
     TPasProcedure(Overloads[i]).Release;
-  Overloads.Free;
+  FreeAndNil(Overloads);
   inherited Destroy;
 end;
 
@@ -2142,6 +2843,16 @@ begin
     SetLength(Result, 0);
 end;
 
+procedure TPasOverloadedProc.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Overloads.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasProcedure(Overloads[i]),false);
+end;
+
 function TPasProcedure.GetCallingConvention: TCallingConvention;
 begin
   Result:=ccDefault;
@@ -2161,9 +2872,9 @@ begin
     ProcType.Release;
   if Assigned(Body) then
     Body.Release;
-  FreeAndNil(PublicName);
-  FreeAndNil(LibraryExpr);
-  FreeAndNil(LibrarySymbolName);
+  ReleaseAndNil(TPasElement(PublicName));
+  ReleaseAndNil(TPasElement(LibraryExpr));
+  ReleaseAndNil(TPasElement(LibrarySymbolName));
   inherited Destroy;
 end;
 
@@ -2187,7 +2898,7 @@ begin
 
   for i := 0 to Locals.Count - 1 do
     TPasElement(Locals[i]).Release;
-  Locals.Free;
+  FreeAndNil(Locals);
 
   if Assigned(ProcType) then
     ProcType.Release;
@@ -2220,18 +2931,16 @@ end;
 
 destructor TPasImplCommands.Destroy;
 begin
-  Commands.Free;
+  FreeAndNil(Commands);
   inherited Destroy;
 end;
 
 
 destructor TPasImplIfElse.Destroy;
 begin
-  FreeAndNil(ConditionExpr);
-  if Assigned(IfBranch) then
-    IfBranch.Release;
-  if Assigned(ElseBranch) then
-    ElseBranch.Release;
+  ReleaseAndNil(TPasElement(ConditionExpr));
+  ReleaseAndNil(TPasElement(IfBranch));
+  ReleaseAndNil(TPasElement(ElseBranch));
   inherited Destroy;
 end;
 
@@ -2241,7 +2950,7 @@ begin
   if IfBranch=nil then
     begin
     IfBranch:=Element;
-    element.AddRef;
+    Element.AddRef;
     end
   else if ElseBranch=nil then
     begin
@@ -2257,6 +2966,17 @@ begin
   Result:=ElseBranch<>nil;
 end;
 
+procedure TPasImplIfElse.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
+  if Elements.IndexOf(IfBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,IfBranch,false);
+  if Elements.IndexOf(ElseBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 function TPasImplIfElse.Condition: string;
 begin
   If Assigned(ConditionExpr) then
@@ -2265,12 +2985,11 @@ end;
 
 destructor TPasImplForLoop.Destroy;
 begin
-  FreeAndNil(StartExpr);
-  FreeAndNil(EndExpr);
-  if Assigned(Variable) then
-    Variable.Release;
-  if Assigned(Body) then
-    Body.Release;
+  ReleaseAndNil(TPasElement(VariableName));
+  ReleaseAndNil(TPasElement(StartExpr));
+  ReleaseAndNil(TPasElement(EndExpr));
+  ReleaseAndNil(TPasElement(Variable));
+  ReleaseAndNil(TPasElement(Body));
   inherited Destroy;
 end;
 
@@ -2286,6 +3005,18 @@ begin
     raise Exception.Create('TPasImplForLoop.AddElement body already set - please report this bug');
 end;
 
+procedure TPasImplForLoop.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,VariableName,false);
+  ForEachChildCall(aMethodCall,Arg,Variable,false);
+  ForEachChildCall(aMethodCall,Arg,StartExpr,false);
+  ForEachChildCall(aMethodCall,Arg,EndExpr,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 function TPasImplForLoop.Down: boolean;
 begin
   Result:=(LoopType=ltDown);
@@ -2319,7 +3050,7 @@ var
 begin
   for i := 0 to Elements.Count - 1 do
     TPasImplElement(Elements[i]).Release;
-  Elements.Free;
+  FreeAndNil(Elements);
   inherited Destroy;
 end;
 
@@ -2391,7 +3122,7 @@ begin
   AddElement(Result);
 end;
 
-function TPasImplBlock.AddForLoop(const AVarName: String; AStartValue,
+function TPasImplBlock.AddForLoop(AVarName: TPasExpr; AStartValue,
   AEndValue: TPasExpr; ADownTo: Boolean): TPasImplForLoop;
 begin
   Result := TPasImplForLoop.Create('', Self);
@@ -2409,12 +3140,35 @@ begin
   AddElement(Result);
 end;
 
-function TPasImplBlock.AddExceptOn(const VarName, TypeName: TPasExpr
+function TPasImplBlock.AddExceptOn(const VarName, TypeName: string
   ): TPasImplExceptOn;
 begin
+  Result:=AddExceptOn(VarName,TPasUnresolvedTypeRef.Create(TypeName,nil));
+end;
+
+function TPasImplBlock.AddExceptOn(const VarName: string; VarType: TPasType
+  ): TPasImplExceptOn;
+var
+  V: TPasVariable;
+begin
+  V:=TPasVariable.Create(VarName,nil);
+  V.VarType:=VarType;
+  Result:=AddExceptOn(V);
+end;
+
+function TPasImplBlock.AddExceptOn(const VarEl: TPasVariable): TPasImplExceptOn;
+begin
   Result:=TPasImplExceptOn.Create('',Self);
-  Result.VarExpr:=VarName;
-  Result.TypeExpr:=TypeName;
+  Result.VarEl:=VarEl;
+  Result.TypeEl:=VarEl.VarType;
+  Result.TypeEl.AddRef;
+  AddElement(Result);
+end;
+
+function TPasImplBlock.AddExceptOn(const TypeEl: TPasType): TPasImplExceptOn;
+begin
+  Result:=TPasImplExceptOn.Create('',Self);
+  Result.TypeEl:=TypeEl;
   AddElement(Result);
 end;
 
@@ -2451,6 +3205,16 @@ begin
   Result:=false;
 end;
 
+procedure TPasImplBlock.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Elements.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Elements[i]),false);
+end;
+
 
 
 { ---------------------------------------------------------------------
@@ -2460,6 +3224,17 @@ end;
 function TPasModule.GetDeclaration(full : boolean): string;
 begin
   Result := 'Unit ' + Name;
+  if full then ;
+end;
+
+procedure TPasModule.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,InterfaceSection,false);
+  ForEachChildCall(aMethodCall,Arg,ImplementationSection,false);
+  ForEachChildCall(aMethodCall,Arg,InitializationSection,false);
+  ForEachChildCall(aMethodCall,Arg,FinalizationSection,false);
 end;
 
 {
@@ -2469,7 +3244,7 @@ begin
 end;
 }
 
-function TPasResString.GetDeclaration (full : boolean) : string;
+function TPasResString.GetDeclaration(full: Boolean): string;
 begin
   Result:=Expr.GetDeclaration(true);
   If Full Then
@@ -2479,6 +3254,13 @@ begin
     end;
 end;
 
+procedure TPasResString.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Expr,false);
+end;
+
 destructor TPasResString.Destroy;
 begin
   If Assigned(Expr) then
@@ -2486,7 +3268,7 @@ begin
   inherited Destroy;
 end;
 
-function TPasPointerType.GetDeclaration (full : boolean) : string;
+function TPasPointerType.GetDeclaration(full: Boolean): string;
 begin
   Result:='^'+DestType.Name;
   If Full then
@@ -2496,7 +3278,14 @@ begin
     end;
 end;
 
-function TPasAliasType.GetDeclaration (full : boolean) : string;
+procedure TPasPointerType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,DestType,true);
+end;
+
+function TPasAliasType.GetDeclaration(full: Boolean): string;
 begin
   Result:=DestType.Name;
   If Full then
@@ -2506,6 +3295,13 @@ begin
     end;
 end;
 
+procedure TPasAliasType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,DestType,true);
+end;
+
 function TPasClassOfType.GetDeclaration (full : boolean) : string;
 begin
   Result:='Class of '+DestType.Name;
@@ -2526,9 +3322,16 @@ begin
     end;
 end;
 
+procedure TPasRangeType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,RangeExpr,false);
+end;
+
 destructor TPasRangeType.Destroy;
 begin
-  FreeAndNil(RangeExpr);
+  ReleaseAndNil(TPasElement(RangeExpr));
   inherited Destroy;
 end;
 
@@ -2561,11 +3364,32 @@ begin
     end;
 end;
 
+procedure TPasArrayType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ElType,true);
+end;
+
+function TPasArrayType.IsGenericArray: Boolean;
+begin
+  Result:=elType is TPasGenericTemplateType;
+end;
+
 function TPasArrayType.IsPacked: Boolean;
 begin
   Result:=PackMode=pmPacked;
 end;
 
+procedure TPasArrayType.AddRange(Range: TPasExpr);
+var
+  i: Integer;
+begin
+  i:=Length(Ranges);
+  SetLength(Ranges, i+1);
+  Ranges[i]:=Range;
+end;
+
 function TPasFileType.GetDeclaration (full : boolean) : string;
 begin
   Result:='File';
@@ -2578,6 +3402,13 @@ begin
     end;
 end;
 
+procedure TPasFileType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ElType,true);
+end;
+
 Function IndentStrings(S : TStrings; indent : Integer) : string;
 
 Var
@@ -2626,6 +3457,12 @@ begin
   end;
 end;
 
+destructor TPasSetType.Destroy;
+begin
+  ReleaseAndNil(TPasElement(EnumType));
+  inherited Destroy;
+end;
+
 function TPasSetType.GetDeclaration (full : boolean) : string;
 
 Var
@@ -2659,6 +3496,13 @@ begin
     ProcessHints(False,Result);
 end;
 
+procedure TPasSetType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,EnumType,true);
+end;
+
 procedure TPasRecordType.GetMembers(S: TStrings);
 
 Var
@@ -2700,10 +3544,10 @@ begin
   if Variants<>nil then
     begin
     temp:='case ';
-    if (VariantName<>'') then
-      temp:=Temp+variantName+' : ';
-    if (VariantType<>Nil) then
-      temp:=temp+VariantType.Name;
+    if (VariantEl is TPasVariable) then
+      temp:=Temp+VariantEl.Name+' : '+TPasVariable(VariantEl).VarType.Name
+    else if (VariantEl<>Nil) then
+      temp:=temp+VariantEl.Name;
     S.Add(temp+' of');
     T.Clear;
     For I:=0 to Variants.Count-1 do
@@ -2742,6 +3586,22 @@ begin
   end;
 end;
 
+procedure TPasRecordType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Members.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
+  ForEachChildCall(aMethodCall,Arg,VariantEl,false);
+  if Variants<>nil then
+    for i:=0 to Variants.Count-1 do
+      ForEachChildCall(aMethodCall,Arg,TPasElement(Variants[i]),false);
+  for i:=0 to GenericTemplateTypes.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
+end;
+
 function TPasRecordType.IsPacked: Boolean;
 begin
   Result:=(PackMode <> pmNone);
@@ -2768,6 +3628,17 @@ begin
     end;
 end;
 
+procedure TPasRecordType.SetGenericTemplates(AList: TFPList);
+var
+  I: Integer;
+begin
+  For I:=0 to AList.Count-1 do
+    begin
+    TPasElement(AList[i]).Parent:=Self;
+    GenericTemplateTypes.Add(AList[i]);
+    end;
+end;
+
 procedure TPasProcedureType.GetArguments(List : TStrings);
 
 Var
@@ -2813,7 +3684,7 @@ begin
   end;
 end;
 
-function TPasFunctionType.GetDeclaration (full : boolean) : string;
+function TPasFunctionType.GetDeclaration(Full: boolean): string;
 
 Var
   S : TStringList;
@@ -2846,6 +3717,13 @@ begin
   end;
 end;
 
+procedure TPasFunctionType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ResultEl,false);
+end;
+
 function TPasVariable.GetDeclaration (full : boolean) : string;
 
 Const
@@ -2871,6 +3749,13 @@ begin
     end;
 end;
 
+procedure TPasVariable.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,VarType,true);
+  ForEachChildCall(aMethodCall,Arg,Expr,false);
+end;
 
 
 function TPasVariable.Value: String;
@@ -2920,6 +3805,22 @@ begin
   ProcessHints(True, Result);
 end;
 
+procedure TPasProperty.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,IndexExpr,false);
+  for i:=0 to Args.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Args[i]),false);
+  ForEachChildCall(aMethodCall,Arg,ReadAccessor,false);
+  ForEachChildCall(aMethodCall,Arg,WriteAccessor,false);
+  ForEachChildCall(aMethodCall,Arg,ImplementsFunc,false);
+  ForEachChildCall(aMethodCall,Arg,StoredAccessor,false);
+  ForEachChildCall(aMethodCall,Arg,DefaultExpr,false);
+end;
+
 function TPasProperty.ResolvedType: TPasType;
 
   Function GC(P : TPasProperty) : TPasClassType;
@@ -2970,7 +3871,7 @@ begin
     Result:='';
 end;
 
-Procedure TPasProcedure.GetModifiers(List : TStrings);
+procedure TPasProcedure.GetModifiers(List: TStrings);
 
   Procedure DoAdd(B : Boolean; S : string);
 
@@ -2990,33 +3891,44 @@ begin
   DoAdd(IsMessage,' Message');
 end;
 
-Procedure TPasProcedure.AddModifier(AModifier : TProcedureModifier);
+procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,PublicName,false);
+  ForEachChildCall(aMethodCall,Arg,ProcType,false);
+  ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
+  ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
+  ForEachChildCall(aMethodCall,Arg,Body,false);
+end;
+
+procedure TPasProcedure.AddModifier(AModifier: TProcedureModifier);
 
 begin
   Include(FModifiers,AModifier);
 end;
 
-Function TPasProcedure.IsVirtual : Boolean;
+function TPasProcedure.IsVirtual: Boolean;
 begin
   Result:=pmVirtual in FModifiers;
 end;
 
-Function TPasProcedure.IsDynamic : Boolean;
+function TPasProcedure.IsDynamic: Boolean;
 begin
   Result:=pmDynamic in FModifiers;
 end;
 
-Function TPasProcedure.IsAbstract : Boolean;
+function TPasProcedure.IsAbstract: Boolean;
 begin
   Result:=pmAbstract in FModifiers;
 end;
 
-Function TPasProcedure.IsOverride : Boolean;
+function TPasProcedure.IsOverride: Boolean;
 begin
   Result:=pmOverride in FModifiers;
 end;
 
-Function TPasProcedure.IsExported : Boolean;
+function TPasProcedure.IsExported: Boolean;
 begin
   Result:=pmExport in FModifiers;
 end;
@@ -3026,25 +3938,25 @@ begin
   Result:=pmExternal in FModifiers;
 end;
 
-Function TPasProcedure.IsOverload : Boolean;
+function TPasProcedure.IsOverload: Boolean;
 begin
   Result:=pmOverload in FModifiers;
 end;
 
-Function TPasProcedure.IsMessage: Boolean;
+function TPasProcedure.IsMessage: Boolean;
 begin
   Result:=pmMessage in FModifiers;
 end;
 
-Function TPasProcedure.IsReintroduced : Boolean;
+function TPasProcedure.IsReintroduced: Boolean;
 begin
   Result:=pmReintroduce in FModifiers;
 end;
 
-Function TPasProcedure.IsStatic : Boolean;
+function TPasProcedure.IsStatic: Boolean;
 
 begin
-  Result:=pmStatic in FModifiers;
+  Result:=ptmStatic in ProcType.Modifiers;
 end;
 
 function TPasProcedure.IsForward: Boolean;
@@ -3052,7 +3964,7 @@ begin
   Result:=pmForward in FModifiers;
 end;
 
-function TPasProcedure.GetDeclaration (full : boolean) : string;
+function TPasProcedure.GetDeclaration(full: Boolean): string;
 
 Var
   S : TStringList;
@@ -3192,6 +4104,14 @@ begin
     Result:='';
 end;
 
+procedure TPasArgument.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,ArgType,true);
+  ForEachChildCall(aMethodCall,Arg,ValueExpr,false);
+end;
+
 function TPasArgument.Value: String;
 begin
   If Assigned(ValueExpr) then
@@ -3200,13 +4120,12 @@ begin
     Result:='';
 end;
 
-
-
 { TPassTreeVisitor }
 
 procedure TPassTreeVisitor.Visit(obj: TPasElement);
 begin
   // Needs to be implemented by descendents.
+  if Obj=nil then ;
 end;
 
 { TPasSection }
@@ -3221,16 +4140,64 @@ destructor TPasSection.Destroy;
 var
   i: Integer;
 begin
+  {$IFDEF VerbosePasTreeMem}writeln('TPasSection.Destroy UsesList');{$ENDIF}
   for i := 0 to UsesList.Count - 1 do
     TPasType(UsesList[i]).Release;
-  UsesList.Free;
+  FreeAndNil(UsesList);
+  {$IFDEF VerbosePasTreeMem}writeln('TPasSection.Destroy UsesClause');{$ENDIF}
+  for i := 0 to length(UsesClause) - 1 do
+    UsesClause[i].Release;
+  SetLength(UsesClause,0);
 
+  {$IFDEF VerbosePasTreeMem}writeln('TPasSection.Destroy inherited');{$ENDIF}
   inherited Destroy;
+  {$IFDEF VerbosePasTreeMem}writeln('TPasSection.Destroy END');{$ENDIF}
+end;
+
+function TPasSection.AddUnitToUsesList(const AUnitName: string;
+  aName: TPasExpr; InFilename: TPrimitiveExpr; aModule: TPasElement;
+  UsesUnit: TPasUsesUnit): TPasUsesUnit;
+var
+  l: Integer;
+begin
+  if (InFilename<>nil) and (InFilename.Kind<>pekString) then
+    raise Exception.Create('');
+  if aModule=nil then
+    aModule:=TPasUnresolvedUnitRef.Create(AUnitName, Self);
+  l:=length(UsesClause);
+  SetLength(UsesClause,l+1);
+  if UsesUnit=nil then
+    begin
+    UsesUnit:=TPasUsesUnit.Create(AUnitName,Self);
+    if aName<>nil then
+      begin
+      Result.SourceFilename:=aName.SourceFilename;
+      Result.SourceLinenumber:=aName.SourceLinenumber;
+      end;
+    end;
+  UsesClause[l]:=UsesUnit;
+  UsesUnit.Expr:=aName;
+  UsesUnit.InFilename:=InFilename;
+  UsesUnit.Module:=aModule;
+  Result:=UsesUnit;
+
+  UsesList.Add(aModule);
+  aModule.AddRef;
+end;
+
+function TPasSection.ElementTypeName: string;
+begin
+  Result := SPasTreeSection;
 end;
 
-procedure TPasSection.AddUnitToUsesList(const AUnitName: string);
+procedure TPasSection.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
 begin
-  UsesList.Add(TPasUnresolvedTypeRef.Create(AUnitName, Self));
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(UsesClause)-1 do
+    ForEachChildCall(aMethodCall,Arg,UsesClause[i],false);
 end;
 
 { TProcedureBody }
@@ -3238,24 +4205,28 @@ end;
 constructor TProcedureBody.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
-  Labels:=TFPList.Create;
 end;
 
 destructor TProcedureBody.Destroy;
 begin
-  FreeAndNil(Labels);
   if Assigned(Body) then
     Body.Release;
   inherited Destroy;
 end;
 
+procedure TProcedureBody.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Body,false);
+end;
+
 { TPasImplWhileDo }
 
 destructor TPasImplWhileDo.Destroy;
 begin
-  FreeAndNil(ConditionExpr);
-  if Assigned(Body) then
-    Body.Release;
+  ReleaseAndNil(TPasElement(ConditionExpr));
+  ReleaseAndNil(TPasElement(Body));
   inherited Destroy;
 end;
 
@@ -3268,7 +4239,16 @@ begin
     Body.AddRef;
     end
   else
-    raise Exception.Create('TPasImplWhileDo.AddElement body already set - please report this bug');
+    raise Exception.Create('TPasImplWhileDo.AddElement body already set');
+end;
+
+procedure TPasImplWhileDo.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,ConditionExpr,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 function TPasImplWhileDo.Condition: string;
@@ -3281,9 +4261,8 @@ end;
 
 destructor TPasImplCaseOf.Destroy;
 begin
-  FreeAndNil(CaseExpr);
-  if Assigned(ElseBranch) then
-    ElseBranch.Release;
+  ReleaseAndNil(TPasElement(CaseExpr));
+  ReleaseAndNil(TPasElement(ElseBranch));
   inherited Destroy;
 end;
 
@@ -3309,6 +4288,15 @@ begin
   AddElement(Result);
 end;
 
+procedure TPasImplCaseOf.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,CaseExpr,false);
+  if Elements.IndexOf(ElseBranch)<0 then
+    ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 function TPasImplCaseOf.Expression: string;
 begin
   if Assigned(CaseExpr) then
@@ -3333,10 +4321,9 @@ Var
 
 begin
   For I:=0 to Expressions.Count-1 do
-    TPasExpr(Expressions[i]).Free;
+    TPasExpr(Expressions[i]).Release;
   FreeAndNil(Expressions);
-  if Assigned(Body) then
-    Body.Release;
+  ReleaseAndNil(TPasElement(Body));
   inherited Destroy;
 end;
 
@@ -3348,11 +4335,26 @@ begin
     Body:=Element;
     Body.AddRef;
     end
+  else
+    raise Exception.Create('TPasImplCaseStatement.AddElement body already set');
 end;
 
 procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
 begin
   Expressions.Add(Expr);
+  Expr.Parent:=Self;
+end;
+
+procedure TPasImplCaseStatement.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
+begin
+  for i:=0 to Expressions.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Expressions[i]),false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
 end;
 
 { TPasImplWithDo }
@@ -3370,7 +4372,7 @@ begin
   if Assigned(Body) then
     Body.Release;
   For I:=0 to Expressions.Count-1 do
-    TObject(Expressions[i]).Free;
+    TPasExpr(Expressions[i]).Release;
   FreeAndNil(Expressions);
   inherited Destroy;
 end;
@@ -3382,7 +4384,9 @@ begin
     begin
     Body:=Element;
     Body.AddRef;
-    end;
+    end
+  else
+    raise Exception.Create('TPasImplWithDo.AddElement body already set');
 end;
 
 procedure TPasImplWithDo.AddExpression(const Expression: TPasExpr);
@@ -3390,6 +4394,18 @@ begin
   Expressions.Add(Expression);
 end;
 
+procedure TPasImplWithDo.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  for i:=0 to Expressions.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Expressions[i]),false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 { TPasImplTry }
 
 destructor TPasImplTry.Destroy;
@@ -3419,14 +4435,21 @@ begin
   ElseBranch:=Result;
 end;
 
+procedure TPasImplTry.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,FinallyExcept,false);
+  ForEachChildCall(aMethodCall,Arg,ElseBranch,false);
+end;
+
 { TPasImplExceptOn }
 
 destructor TPasImplExceptOn.Destroy;
 begin
-  FreeAndNil(VarExpr);
-  FreeAndNil(TypeExpr);
-  if Assigned(Body) then
-    Body.Release;
+  ReleaseAndNil(TPasElement(VarEl));
+  ReleaseAndNil(TPasElement(TypeEl));
+  ReleaseAndNil(TPasElement(Body));
   inherited Destroy;
 end;
 
@@ -3440,18 +4463,28 @@ begin
     end;
 end;
 
+procedure TPasImplExceptOn.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  ForEachChildCall(aMethodCall,Arg,VarEl,false);
+  ForEachChildCall(aMethodCall,Arg,TypeEl,false);
+  if Elements.IndexOf(Body)<0 then
+    ForEachChildCall(aMethodCall,Arg,Body,false);
+  inherited ForEachCall(aMethodCall, Arg);
+end;
+
 function TPasImplExceptOn.VariableName: String;
 begin
-  If assigned(VarExpr) then
-    Result:=VarExpr.GetDeclaration(True)
+  If assigned(VarEl) then
+    Result:=VarEl.Name
   else
     Result:='';
 end;
 
 function TPasImplExceptOn.TypeName: string;
 begin
-  If assigned(TypeExpr) then
-    Result:=TypeExpr.GetDeclaration(True)
+  If assigned(TypeEl) then
+    Result:=TypeEl.GetDeclaration(True)
   else
     Result:='';
 end;
@@ -3465,18 +4498,27 @@ end;
 
 { TPasExpr }
 
-constructor TPasExpr.Create(AParent : TPasElement; AKind: TPasExprKind; AOpCode: TexprOpcode);
+constructor TPasExpr.Create(AParent: TPasElement; AKind: TPasExprKind;
+  AOpCode: TExprOpCode);
 begin
   inherited Create(ClassName, AParent);
   Kind:=AKind;
   OpCode:=AOpCode;
 end;
 
+destructor TPasExpr.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Format1));
+  ReleaseAndNil(TPasElement(Format2));
+  inherited Destroy;
+end;
+
 { TPrimitiveExpr }
 
-function TPrimitiveExpr.GetDeclaration(Full : Boolean):AnsiString;
+function TPrimitiveExpr.GetDeclaration(full: Boolean): string;
 begin
   Result:=Value;
+  if full then ;
 end;
 
 constructor TPrimitiveExpr.Create(AParent : TPasElement; AKind: TPasExprKind; const AValue : Ansistring);
@@ -3493,20 +4535,21 @@ begin
   Value:=ABoolValue;
 end;
 
-Function TBoolConstExpr.GetDeclaration(Full: Boolean):AnsiString;
+function TBoolConstExpr.GetDeclaration(full: Boolean): string;
 
 begin
   If Value then
     Result:='True'
   else
-    Result:='False';  
+    Result:='False';
+  if full then ;
 end;
 
 
 
 { TUnaryExpr }
 
-Function TUnaryExpr.GetDeclaration(Full : Boolean):AnsiString;
+function TUnaryExpr.GetDeclaration(full: Boolean): string;
 
 begin
   Result:=OpCodeStrings[Opcode];
@@ -3522,12 +4565,20 @@ end;
 
 destructor TUnaryExpr.Destroy;
 begin
-  Operand.Free;
+  if Assigned(Operand) then
+    Operand.Release;
+end;
+
+procedure TUnaryExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Operand,false);
 end;
 
 { TBinaryExpr }
 
-function TBinaryExpr.GetDeclaration(Full : Boolean):AnsiString;
+function TBinaryExpr.GetDeclaration(full: Boolean): string;
   function OpLevel(op: TPasExpr): Integer;
   begin
     case op.OpCode of
@@ -3550,7 +4601,11 @@ begin
   If Kind=pekRange then
     Result:='..'
   else
-    Result:=' '+OpcodeStrings[Opcode]+' ';
+    begin
+    Result:=OpcodeStrings[Opcode];
+    if Not (OpCode in [eopAddress,eopDeref,eopSubIdent]) then
+      Result:=' '+Result+' ';
+    end;
   If Assigned(Left) then
   begin
     op := Left.GetDeclaration(Full);
@@ -3574,26 +4629,40 @@ constructor TBinaryExpr.Create(AParent : TPasElement; xleft,xright:TPasExpr; AOp
 begin
   inherited Create(AParent,pekBinary, AOpCode);
   left:=xleft;
+  left.Parent:=Self;
   right:=xright;
+  right.Parent:=Self;
 end;
 
 constructor TBinaryExpr.CreateRange(AParent : TPasElement; xleft,xright:TPasExpr);
 begin
   inherited Create(AParent,pekRange, eopNone);
   left:=xleft;
+  left.Parent:=Self;
   right:=xright;
+  right.Parent:=Self;
 end;
 
 destructor TBinaryExpr.Destroy;
 begin
-  left.Free;
-  right.Free;
+  if Assigned(left) then left.Release;
+  left:=nil;
+  if Assigned(right) then right.Release;
+  right:=nil;
   inherited Destroy;
 end;
 
+procedure TBinaryExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,left,false);
+  ForEachChildCall(aMethodCall,Arg,right,false);
+end;
+
 { TParamsExpr }
 
-Function TParamsExpr.GetDeclaration(Full: Boolean) : Ansistring;
+function TParamsExpr.GetDeclaration(full: Boolean): string;
 
 Var
   I : Integer;
@@ -3621,6 +4690,17 @@ begin
   Params[i]:=xp;
 end;
 
+procedure TParamsExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,Value,false);
+  for i:=0 to Length(Params)-1 do
+    ForEachChildCall(aMethodCall,Arg,Params[i],false);
+end;
+
 constructor TParamsExpr.Create(AParent : TPasElement; AKind: TPasExprKind);
 begin
   inherited Create(AParent,AKind, eopNone)
@@ -3630,14 +4710,14 @@ destructor TParamsExpr.Destroy;
 var
   i : Integer;
 begin
-  FreeAndNil(Value);
-  for i:=0 to length(Params)-1 do Params[i].Free;
+  ReleaseAndNil(TPasElement(Value));
+  for i:=0 to length(Params)-1 do Params[i].Release;
   inherited Destroy;
 end;
 
 { TRecordValues }
 
-Function TRecordValues.GetDeclaration(Full : Boolean):AnsiString;
+function TRecordValues.GetDeclaration(full: Boolean): string;
 
 Var
   I : Integer;
@@ -3652,6 +4732,18 @@ begin
   Result:='('+Result+')';
 end;
 
+procedure TRecordValues.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(Fields)-1 do
+    with Fields[i] do
+      if ValueExp<>nil then
+        ForEachChildCall(aMethodCall,Arg,ValueExp,false);
+end;
+
 constructor TRecordValues.Create(AParent : TPasElement);
 begin
   inherited Create(AParent,pekListOfExp, eopNone);
@@ -3661,7 +4753,9 @@ destructor TRecordValues.Destroy;
 var
   i : Integer;
 begin
-  for i:=0 to length(Fields)-1 do Fields[i].ValueExp.Free;
+  for i:=0 to length(Fields)-1 do
+    Fields[i].ValueExp.Release;
+  Fields:=nil;
   inherited Destroy;
 end;
 
@@ -3673,13 +4767,15 @@ begin
   SetLength(Fields, i+1);
   Fields[i].Name:=AName;
   Fields[i].ValueExp:=Value;
+  Value.Parent:=Self;
 end;
 
 { TNilExpr }
 
-Function TNilExpr.GetDeclaration(Full :Boolean):AnsiString;
+function TNilExpr.GetDeclaration(full: Boolean): string;
 begin
   Result:='Nil';
+  if full then ;
 end;
 
 { TInheritedExpr }
@@ -3687,18 +4783,20 @@ end;
 function TInheritedExpr.GetDeclaration(full: Boolean): string;
 begin
   Result:='Inherited';
+  if full then ;
 end;
 
 { TSelfExpr }
 
-Function TSelfExpr.GetDeclaration(Full :Boolean):AnsiString;
+function TSelfExpr.GetDeclaration(full: Boolean): string;
 begin
   Result:='Self';
+  if full then ;
 end;
 
 { TArrayValues }
 
-Function TArrayValues.GetDeclaration(Full: Boolean):AnsiString;
+function TArrayValues.GetDeclaration(full: Boolean): string;
 
 Var
   I : Integer;
@@ -3714,6 +4812,16 @@ begin
   Result:='('+Result+')';
 end;
 
+procedure TArrayValues.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(Values)-1 do
+    ForEachChildCall(aMethodCall,Arg,Values[i],false);
+end;
+
 constructor TArrayValues.Create(AParent : TPasElement);
 begin
   inherited Create(AParent,pekListOfExp, eopNone)
@@ -3723,7 +4831,9 @@ destructor TArrayValues.Destroy;
 var
   i : Integer;
 begin
-  for i:=0 to length(Values)-1 do Values[i].Free;
+  for i:=0 to length(Values)-1 do
+    Values[i].Release;
+  Values:=nil;
   inherited Destroy;
 end;
 
@@ -3734,6 +4844,7 @@ begin
   i:=length(Values);
   SetLength(Values, i+1);
   Values[i]:=AValue;
+  AValue.Parent:=Self;
 end;
 
 { TNilExpr }
@@ -3768,7 +4879,7 @@ end;
 
 destructor TPasLabels.Destroy;
 begin
-  Labels.Free;
+  FreeAndNil(Labels);
   inherited Destroy;
 end;
 
diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas
new file mode 100644
index 0000000000..9a63874ea3
--- /dev/null
+++ b/packages/fcl-passrc/src/pasuseanalyzer.pas
@@ -0,0 +1,1979 @@
+{
+    This file is part of the Free Component Library
+
+    Pascal parse tree classes
+    Copyright (c) 2017  Mattias Gaertner, mattias@freepascal.org
+
+    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.
+
+ **********************************************************************}
+{
+Abstract:
+  After running TPasResolver, run this to
+  - create a list of used declararion, either in a module or a whole program.
+  - emit hints about unused declarations
+  - and warnings about uninitialized variables.
+
+Working:
+- mark used elements of a module, starting from all accessible elements
+- Hint: 'Unit "%s" not used in %s'
+- Hint: 'Parameter "%s" not used'
+- Hint: 'Local variable "%s" not used'
+- Hint: 'Value parameter "%s" is assigned but never used'
+- Hint: 'Local variable "%s" is assigned but never used'
+- Hint: 'Local %s "%s" not used'
+- Hint: 'Private field "%s" is never used'
+- Hint: 'Private field "%s" is assigned but never used'
+- Hint: 'Private method "%s" is never used'
+- Hint: 'Private type "%s" never used'
+- Hint: 'Private const "%s" never used'
+- Hint: 'Private property "%s" never used'
+- Hint: 'Function result does not seem to be set'
+
+ToDo:
+- record members
+- class members
+- Improve Call Override: e.g. A.Proc, mark only overrides of descendants of A
+- TPasArgument: compute the effective Access
+- calls: use the effective Access of arguments
+}
+unit PasUseAnalyzer;
+
+{$mode objfpc}{$H+}{$inline on}
+
+interface
+
+uses
+  Classes, SysUtils, AVL_Tree, PasTree, PScanner,
+  {$IFDEF VerbosePasAnalyzer}
+  PasResolveEval,
+  {$ENDIF}
+  PasResolver;
+
+const
+  nPAUnitNotUsed = 5023;
+  sPAUnitNotUsed = 'Unit "%s" not used in %s';
+  nPAParameterNotUsed = 5024;
+  sPAParameterNotUsed = 'Parameter "%s" not used';
+  nPALocalVariableNotUsed = 5025;
+  sPALocalVariableNotUsed = 'Local variable "%s" not used';
+  nPAValueParameterIsAssignedButNeverUsed = 5026;
+  sPAValueParameterIsAssignedButNeverUsed = 'Value parameter "%s" is assigned but never used';
+  nPALocalVariableIsAssignedButNeverUsed = 5027;
+  sPALocalVariableIsAssignedButNeverUsed = 'Local variable "%s" is assigned but never used';
+  nPALocalXYNotUsed = 5028;
+  sPALocalXYNotUsed = 'Local %s "%s" not used';
+  nPAPrivateFieldIsNeverUsed = 5029;
+  sPAPrivateFieldIsNeverUsed = 'Private field "%s" is never used';
+  nPAPrivateFieldIsAssignedButNeverUsed = 5030;
+  sPAPrivateFieldIsAssignedButNeverUsed = 'Private field "%s" is assigned but never used';
+  nPAPrivateMethodIsNeverUsed = 5031;
+  sPAPrivateMethodIsNeverUsed = 'Private method "%s" is never used';
+  nPAFunctionResultDoesNotSeemToBeSet = 5033;
+  sPAFunctionResultDoesNotSeemToBeSet  = 'Function result does not seem to be set';
+  nPAPrivateTypeXNeverUsed = 5071;
+  sPAPrivateTypeXNeverUsed = 'Private type "%s" never used';
+  nPAPrivateConstXNeverUsed = 5072;
+  sPAPrivateConstXNeverUsed = 'Private const "%s" never used';
+  nPAPrivatePropertyXNeverUsed = 5073;
+  sPAPrivatePropertyXNeverUsed = 'Private property "%s" never used';
+  //nPAUnreachableCode = 6018;
+  //sPAUnreachableCode = 'unreachable code';
+
+type
+  EPasAnalyzer = class(EPasResolve);
+
+  { TPAMessage }
+
+  TPAMessage = class
+  private
+    FRefCount: integer;
+  public
+    Id: int64;
+    MsgType: TMessageType;
+    MsgNumber: integer;
+    MsgText: string;
+    MsgPattern: String;
+    Args: TMessageArgs;
+    PosEl: TPasElement;
+    Filename: string;
+    Row, Col: integer;
+    constructor Create;
+    procedure AddRef;
+    procedure Release;
+    property RefCount: integer read FRefCount;
+  end;
+
+  TPAMessageEvent = procedure(Sender: TObject; Msg: TPAMessage) of object;
+
+  TPAIdentifierAccess = (
+    paiaNone,
+    paiaRead,
+    paiaWrite,
+    paiaReadWrite,
+    paiaWriteRead
+    );
+
+  { TPAElement }
+
+  TPAElement = class
+  private
+    FElement: TPasElement;
+    procedure SetElement(AValue: TPasElement);
+  public
+    Access: TPAIdentifierAccess;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement;
+  end;
+  TPAElementClass = class of TPAElement;
+
+  { TPAOverrideList }
+
+  TPAOverrideList = class
+  private
+    FElement: TPasElement;
+    FOverrides: TFPList; // list of TPasElement
+    function GetOverrides(Index: integer): TPasElement; inline;
+    procedure SetElement(AValue: TPasElement);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(OverrideEl: TPasElement);
+    property Element: TPasElement read FElement write SetElement;
+    function Count: integer;
+    function IndexOf(OverrideEl: TPasElement): integer; inline;
+    property Overrides[Index: integer]: TPasElement read GetOverrides; default;
+  end;
+
+  TPasAnalyzerOption = (
+    paoOnlyExports // default: use all class members accessible from outside (protected, but not private)
+    );
+  TPasAnalyzerOptions = set of TPasAnalyzerOption;
+
+  TPAUseMode = (
+    paumElement, // Mark element. Do not descend into children.
+    paumAllPublic, // Mark element and descend into children and mark public identifiers
+    paumAllExports, // Do not mark element. Descend into children and mark exports.
+    paumPublished // Mark element and its type and descend into children and mark published identifiers
+    );
+  TPAUseModes = set of TPAUseMode;
+
+  { TPasAnalyzer }
+
+  TPasAnalyzer = class
+  private
+    FChecked: array[TPAUseMode] of TAVLTree; // tree of TElement
+    FOnMessage: TPAMessageEvent;
+    FOptions: TPasAnalyzerOptions;
+    FOverrideLists: TAVLTree; // tree of TPAOverrideList sorted for Element
+    FResolver: TPasResolver;
+    FScopeModule: TPasModule;
+    FUsedElements: TAVLTree; // tree of TPAElement sorted for Element
+    function AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
+    function FindOverrideNode(El: TPasElement): TAVLTreeNode;
+    function FindOverrideList(El: TPasElement): TPAOverrideList;
+    procedure SetOptions(AValue: TPasAnalyzerOptions);
+    procedure UpdateAccess(IsWrite: Boolean; IsRead: Boolean; Usage: TPAElement);
+  protected
+    procedure RaiseInconsistency(const Id: int64; Msg: string);
+    procedure RaiseNotSupported(const Id: int64; El: TPasElement; const Msg: string = '');
+    // mark used elements
+    function Add(El: TPasElement; CheckDuplicate: boolean = true;
+      aClass: TPAElementClass = nil): TPAElement;
+    function FindNode(El: TPasElement): TAVLTreeNode; inline;
+    function FindPAElement(El: TPasElement): TPAElement; inline;
+    procedure CreateTree; virtual;
+    function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
+    function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
+    procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
+      UseFull: boolean); virtual;
+    procedure UsePublished(El: TPasElement); virtual;
+    procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual;
+    procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
+    procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
+    procedure UseImplElement(El: TPasImplElement); virtual;
+    procedure UseExpr(El: TPasExpr); virtual;
+    procedure UseExprRef(Expr: TPasExpr; Access: TResolvedRefAccess;
+      UseFull: boolean); virtual;
+    procedure UseProcedure(Proc: TPasProcedure); virtual;
+    procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
+    procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
+    procedure UseRecordType(El: TPasRecordType; Mode: TPAUseMode); virtual;
+    procedure UseClassType(El: TPasClassType; Mode: TPAUseMode); virtual;
+    procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
+      UseFull: boolean); virtual;
+    procedure UseArgument(El: TPasArgument; Access: TResolvedRefAccess); virtual;
+    procedure UseResultElement(El: TPasResultElement; Access: TResolvedRefAccess); virtual;
+    // create hints for a unit, program or library
+    procedure EmitElementHints(El: TPasElement); virtual;
+    procedure EmitSectionHints(Section: TPasSection); virtual;
+    procedure EmitDeclarationsHints(El: TPasDeclarations); virtual;
+    procedure EmitTypeHints(El: TPasType); virtual;
+    procedure EmitVariableHints(El: TPasVariable); virtual;
+    procedure EmitProcedureHints(El: TPasProcedure); virtual;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure AnalyzeModule(aModule: TPasModule);
+    procedure AnalyzeWholeProgram(aStartModule: TPasProgram);
+    procedure EmitModuleHints(aModule: TPasModule); virtual;
+    function FindElement(El: TPasElement): TPAElement;
+    // utility
+    function IsUsed(El: TPasElement): boolean; // valid after calling Analyze*
+    function IsTypeInfoUsed(El: TPasElement): boolean; // valid after calling Analyze*
+    function IsModuleInternal(El: TPasElement): boolean;
+    function IsExport(El: TPasElement): boolean;
+    function IsIdentifier(El: TPasElement): boolean;
+    function IsImplBlockEmpty(El: TPasImplBlock): boolean;
+    procedure EmitMessage(const Id: int64; const MsgType: TMessageType;
+      MsgNumber: integer; Fmt: String; const Args: array of const; PosEl: TPasElement);
+    procedure EmitMessage(Msg: TPAMessage);
+    property OnMessage: TPAMessageEvent read FOnMessage write FOnMessage;
+    property Options: TPasAnalyzerOptions read FOptions write SetOptions;
+    property Resolver: TPasResolver read FResolver write FResolver;
+    property ScopeModule: TPasModule read FScopeModule write FScopeModule;
+  end;
+
+function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
+function CompareElementWithPAElement(El, Id: Pointer): integer;
+function ComparePAOverrideLists(List1, List2: Pointer): integer;
+function CompareElementWithPAOverrideList(El, List: Pointer): integer;
+function GetElModName(El: TPasElement): string;
+
+implementation
+
+function ComparePointer(Data1, Data2: Pointer): integer;
+begin
+  if Data1>Data2 then Result:=-1
+  else if Data1<Data2 then Result:=1
+  else Result:=0;
+end;
+
+function ComparePAElements(Identifier1, Identifier2: Pointer): integer;
+var
+  Item1: TPAElement absolute Identifier1;
+  Item2: TPAElement absolute Identifier2;
+begin
+  Result:=ComparePointer(Item1.Element,Item2.Element);
+end;
+
+function CompareElementWithPAElement(El, Id: Pointer): integer;
+var
+  Identifier: TPAElement absolute Id;
+begin
+  Result:=ComparePointer(El,Identifier.Element);
+end;
+
+function ComparePAOverrideLists(List1, List2: Pointer): integer;
+var
+  Item1: TPAOverrideList absolute List1;
+  Item2: TPAOverrideList absolute List2;
+begin
+  Result:=ComparePointer(Item1.Element,Item2.Element);
+end;
+
+function CompareElementWithPAOverrideList(El, List: Pointer): integer;
+var
+  OvList: TPAOverrideList absolute List;
+begin
+  Result:=ComparePointer(El,OvList.Element);
+end;
+
+function GetElModName(El: TPasElement): string;
+var
+  aModule: TPasModule;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName;
+  aModule:=El.GetModule;
+  if aModule=El then exit;
+  if aModule=nil then
+    Result:='NilModule.'+Result
+  else
+    Result:=aModule.Name+'.'+Result;
+end;
+
+{ TPAMessage }
+
+constructor TPAMessage.Create;
+begin
+  FRefCount:=1;
+end;
+
+procedure TPAMessage.AddRef;
+begin
+  inc(FRefCount);
+end;
+
+procedure TPAMessage.Release;
+begin
+  if FRefCount=0 then
+    raise Exception.Create('');
+  dec(FRefCount);
+  if FRefCount=0 then
+    Free;
+end;
+
+{ TPAOverrideList }
+
+// inline
+function TPAOverrideList.GetOverrides(Index: integer): TPasElement;
+begin
+  Result:=TPasElement(FOverrides[Index]);
+end;
+
+// inline
+function TPAOverrideList.IndexOf(OverrideEl: TPasElement): integer;
+begin
+  Result:=FOverrides.IndexOf(OverrideEl);
+end;
+
+procedure TPAOverrideList.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if FElement<>nil then
+    FElement.Release;
+  FElement:=AValue;
+  if FElement<>nil then
+    FElement.AddRef;
+end;
+
+constructor TPAOverrideList.Create;
+begin
+  FOverrides:=TFPList.Create;
+end;
+
+destructor TPAOverrideList.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to FOverrides.Count-1 do
+    TPasElement(FOverrides[i]).Release;
+  FreeAndNil(FOverrides);
+  inherited Destroy;
+end;
+
+procedure TPAOverrideList.Add(OverrideEl: TPasElement);
+begin
+  FOverrides.Add(OverrideEl);
+  OverrideEl.AddRef;
+end;
+
+function TPAOverrideList.Count: integer;
+begin
+  Result:=FOverrides.Count;
+end;
+
+{ TPAElement }
+
+procedure TPAElement.SetElement(AValue: TPasElement);
+begin
+  if FElement=AValue then Exit;
+  if FElement<>nil then
+    FElement.Release;
+  FElement:=AValue;
+  if FElement<>nil then
+    FElement.AddRef;
+end;
+
+destructor TPAElement.Destroy;
+begin
+  Element:=nil;
+  inherited Destroy;
+end;
+
+{ TPasAnalyzer }
+
+// inline
+function TPasAnalyzer.FindNode(El: TPasElement): TAVLTreeNode;
+begin
+  Result:=FUsedElements.FindKey(El,@CompareElementWithPAElement);
+end;
+
+// inline
+function TPasAnalyzer.FindPAElement(El: TPasElement): TPAElement;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FindNode(El);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TPAElement(Node.Data);
+end;
+
+procedure TPasAnalyzer.SetOptions(AValue: TPasAnalyzerOptions);
+begin
+  if FOptions=AValue then Exit;
+  FOptions:=AValue;
+end;
+
+function TPasAnalyzer.FindOverrideNode(El: TPasElement): TAVLTreeNode;
+begin
+  Result:=FOverrideLists.FindKey(El,@CompareElementWithPAOverrideList);
+end;
+
+function TPasAnalyzer.FindOverrideList(El: TPasElement): TPAOverrideList;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FindOverrideNode(El);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TPAOverrideList(Node.Data);
+end;
+
+function TPasAnalyzer.AddOverride(OverriddenEl, OverrideEl: TPasElement): boolean;
+// OverrideEl overrides OverriddenEl
+// returns true if new override
+var
+  Node: TAVLTreeNode;
+  Item: TPAOverrideList;
+  OverriddenPAEl: TPAElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AddOverride OverriddenEl=',GetElModName(OverriddenEl),' OverrideEl=',GetElModName(OverrideEl));
+  {$ENDIF}
+  Node:=FindOverrideNode(OverriddenEl);
+  if Node=nil then
+    begin
+    Item:=TPAOverrideList.Create;
+    Item.Element:=OverriddenEl;
+    FOverrideLists.Add(Item);
+    end
+  else
+    begin
+    Item:=TPAOverrideList(Node.Data);
+    if Item.IndexOf(OverrideEl)>=0 then
+      exit(false);
+    end;
+  // new override
+  Item.Add(OverrideEl);
+  Result:=true;
+
+  OverriddenPAEl:=FindPAElement(OverriddenEl);
+  if OverriddenPAEl<>nil then
+    UseElement(OverrideEl,rraNone,true);
+end;
+
+procedure TPasAnalyzer.UpdateAccess(IsWrite: Boolean; IsRead: Boolean;
+  Usage: TPAElement);
+begin
+  if IsRead then
+    case Usage.Access of
+      paiaNone: Usage.Access:=paiaRead;
+      paiaRead: ;
+      paiaWrite: Usage.Access:=paiaWriteRead;
+      paiaReadWrite: ;
+      paiaWriteRead: ;
+      else RaiseInconsistency(20170311183122, '');
+    end;
+  if IsWrite then
+    case Usage.Access of
+      paiaNone: Usage.Access:=paiaWrite;
+      paiaRead: Usage.Access:=paiaReadWrite;
+      paiaWrite: ;
+      paiaReadWrite: ;
+      paiaWriteRead: ;
+      else RaiseInconsistency(20170311183127, '');
+    end;
+end;
+
+procedure TPasAnalyzer.RaiseInconsistency(const Id: int64; Msg: string);
+begin
+  raise EPasAnalyzer.Create('['+IntToStr(Id)+']: '+Msg);
+end;
+
+procedure TPasAnalyzer.RaiseNotSupported(const Id: int64; El: TPasElement;
+  const Msg: string);
+var
+  s: String;
+  E: EPasAnalyzer;
+begin
+  s:='['+IntToStr(Id)+']: Element='+GetElModName(El);
+  if Msg<>'' then S:=S+' '+Msg;
+  E:=EPasAnalyzer.Create(s);
+  E.PasElement:=El;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.RaiseNotSupported ',E.Message);
+  {$ENDIF}
+  raise E;
+end;
+
+function TPasAnalyzer.Add(El: TPasElement; CheckDuplicate: boolean;
+  aClass: TPAElementClass): TPAElement;
+begin
+  if El=nil then
+    RaiseInconsistency(20170308093407,'');
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.Add ',GetElModName(El),' New=',FindNode(El)=nil);
+  {$ENDIF}
+  if CheckDuplicate and (FindNode(El)<>nil) then
+    RaiseInconsistency(20170304201318,'');
+  if aClass=nil then
+    aClass:=TPAElement;
+  Result:=aClass.Create;
+  Result.Element:=El;
+  FUsedElements.Add(Result);
+end;
+
+procedure TPasAnalyzer.CreateTree;
+begin
+  FUsedElements:=TAVLTree.Create(@ComparePAElements);
+end;
+
+function TPasAnalyzer.MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass
+  ): boolean;
+
+  function MarkModule(CurModule: TPasModule): boolean;
+  begin
+    if FindNode(CurModule)<>nil then
+      exit(false);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.MarkElement.MarkModule mark "',GetElModName(CurModule),'"');
+    {$ENDIF}
+    Add(CurModule);
+    Result:=true;
+  end;
+
+var
+  CurModule: TPasModule;
+begin
+  if El=nil then exit(false);
+  CurModule:=El.GetModule;
+  if CurModule=nil then
+    begin
+    if El.ClassType=TPasUnresolvedSymbolRef then
+      exit(false);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.MarkElement GetModule failed for El=',GetElModName(El),' El.Parent=',GetElModName(El.Parent));
+    {$ENDIF}
+    RaiseInconsistency(20170308093540,GetElModName(El));
+    end;
+  if (ScopeModule<>nil) then
+    begin
+    // single module analysis
+    if (CurModule<>ScopeModule) then
+      begin
+      // element from another unit
+      // -> mark unit as used and do not descend deeper
+      MarkModule(CurModule);
+      exit(false);
+      end;
+    end;
+
+  // mark element
+  if FindNode(El)<>nil then exit(false);
+  Add(El,false,aClass);
+  Result:=true;
+
+  if ScopeModule=nil then
+    begin
+    // whole program analysis
+    if IsIdentifier(El) then
+      // an identifier of this unit is used -> mark unit
+      if MarkModule(CurModule) then
+        UseModule(CurModule,paumElement);
+    end;
+end;
+
+function TPasAnalyzer.ElementVisited(El: TPasElement; Mode: TPAUseMode
+  ): boolean;
+begin
+  if El=nil then
+    exit(true);
+  if FChecked[Mode].Find(El)<>nil then exit(true);
+  Result:=false;
+  FChecked[Mode].Add(El);
+end;
+
+procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
+  UseFull: boolean);
+var
+  C: TClass;
+begin
+  if El=nil then exit;
+  C:=El.ClassType;
+  if C.InheritsFrom(TPasType) then
+    UseType(TPasType(El),paumElement)
+  else if C.InheritsFrom(TPasVariable) then
+    UseVariable(TPasVariable(El),Access,UseFull)
+  else if C=TPasArgument then
+    UseArgument(TPasArgument(El),Access)
+  else if C=TPasResultElement then
+    UseResultElement(TPasResultElement(El),Access)
+  else if C.InheritsFrom(TPasProcedure) then
+    UseProcedure(TPasProcedure(El))
+  else if C.InheritsFrom(TPasExpr) then
+    UseExpr(TPasExpr(El))
+  else if C=TPasEnumValue then
+    begin
+    repeat
+      MarkElementAsUsed(El);
+      El:=El.Parent;
+    until not (El is TPasType);
+    end
+  else if (C.InheritsFrom(TPasModule)) or (C=TPasUsesUnit) then
+    // e.g. unitname.identifier -> the module is used by the identifier
+  else
+    RaiseNotSupported(20170307090947,El);
+end;
+
+procedure TPasAnalyzer.UsePublished(El: TPasElement);
+// mark typeinfo, do not mark code
+var
+  C: TClass;
+  Members: TFPList;
+  i: Integer;
+  Member: TPasElement;
+  MemberResolved: TPasResolverResult;
+  Prop: TPasProperty;
+  ProcType: TPasProcedureType;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
+  {$ENDIF}
+  if ElementVisited(El,paumPublished) then exit;
+  C:=El.ClassType;
+  if C=TPasUnresolvedSymbolRef then
+  else if (C=TPasVariable) or (C=TPasConst) then
+    UsePublished(TPasVariable(El).VarType)
+  else if (C=TPasArgument) then
+    UsePublished(TPasArgument(El).ArgType)
+  else if C=TPasProperty then
+    begin
+    // published property
+    Prop:=TPasProperty(El);
+    for i:=0 to Prop.Args.Count-1 do
+      UsePublished(TPasArgument(Prop.Args[i]).ArgType);
+    UsePublished(Prop.VarType);
+    // Note: read, write and index don't need extra typeinfo
+
+    // stored and defaultvalue are only used when published -> mark as used
+    UseElement(Prop.StoredAccessor,rraRead,false);
+    UseElement(Prop.DefaultExpr,rraRead,false);
+    end
+  else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
+    UsePublished(TPasAliasType(El).DestType)
+  else if C=TPasEnumType then
+  else if C=TPasSetType then
+    UsePublished(TPasSetType(El).EnumType)
+  else if C=TPasArrayType then
+    begin
+    UsePublished(TPasArrayType(El).ElType);
+    for i:=0 to length(TPasArrayType(El).Ranges)-1 do
+      begin
+      Member:=TPasArrayType(El).Ranges[i];
+      Resolver.ComputeElement(Member,MemberResolved,[rcConstant]);
+      UsePublished(MemberResolved.TypeEl);
+      end;
+    end
+  else if C=TPasPointerType then
+    UsePublished(TPasPointerType(El).DestType)
+  else if C=TPasClassType then
+  else if C=TPasClassOfType then
+  else if C=TPasRecordType then
+    begin
+    // published record: use all members
+    Members:=TPasRecordType(El).Members;
+    for i:=0 to Members.Count-1 do
+      begin
+      Member:=TPasElement(Members[i]);
+      UsePublished(Member);
+      UseElement(Member,rraNone,true);
+      end;
+    end
+  else if C.InheritsFrom(TPasProcedure) then
+    UsePublished(TPasProcedure(El).ProcType)
+  else if C.InheritsFrom(TPasProcedureType) then
+    begin
+    ProcType:=TPasProcedureType(El);
+    for i:=0 to ProcType.Args.Count-1 do
+      UsePublished(TPasArgument(ProcType.Args[i]).ArgType);
+    if El is TPasFunctionType then
+      UsePublished(TPasFunctionType(El).ResultEl.ResultType);
+    end
+  else
+    RaiseNotSupported(20170414153904,El);
+end;
+
+procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
+
+  procedure UseInitFinal(aSection: TPasImplBlock);
+  begin
+    if IsImplBlockEmpty(aSection) then exit;
+    // this module has an initialization section -> mark module
+    if FindNode(aModule)=nil then
+      Add(aModule);
+    UseImplBlock(aSection,true);
+  end;
+
+begin
+  if ElementVisited(aModule,Mode) then exit;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode);
+  {$ENDIF}
+  if Mode in [paumAllExports,paumAllPublic] then
+    begin
+    if aModule is TPasProgram then
+      UseSection(TPasProgram(aModule).ProgramSection,Mode)
+    else if aModule is TPasLibrary then
+      UseSection(TPasLibrary(aModule).LibrarySection,Mode)
+    else
+      begin
+      // unit
+      UseSection(aModule.InterfaceSection,Mode);
+      end;
+    end;
+  UseInitFinal(aModule.InitializationSection);
+  UseInitFinal(aModule.FinalizationSection);
+
+  if Mode=paumElement then
+    // e.g. a reference: unitname.identifier
+    if FindNode(aModule)=nil then
+      Add(aModule);
+end;
+
+procedure TPasAnalyzer.UseSection(Section: TPasSection; Mode: TPAUseMode);
+// called by UseModule
+var
+  i: Integer;
+  UsedModule: TPasModule;
+  Decl: TPasElement;
+  OnlyExports: Boolean;
+  UsesClause: TPasUsesClause;
+begin
+  // Section is TProgramSection, TLibrarySection, TInterfaceSection, TImplementationSection
+  if Mode=paumElement then
+    RaiseInconsistency(20170317172721,'');
+  if ElementVisited(Section,Mode) then exit;
+
+  OnlyExports:=Mode=paumAllExports;
+
+  if Mode=paumAllPublic then
+    MarkElementAsUsed(Section);
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseSection ',GetElModName(Section),' Mode=',Mode);
+  {$ENDIF}
+
+  // used units
+  UsesClause:=Section.UsesClause;
+  for i:=0 to length(UsesClause)-1 do
+    begin
+    if UsesClause[i].Module is TPasModule then
+      begin
+      UsedModule:=TPasModule(UsesClause[i].Module);
+      if ScopeModule=nil then
+        // whole program analysis
+        UseModule(UsedModule,paumAllExports)
+      else
+        begin
+        // unit analysis
+        if IsImplBlockEmpty(UsedModule.InitializationSection)
+            and IsImplBlockEmpty(UsedModule.FinalizationSection) then
+          continue;
+        if FindNode(UsedModule)=nil then
+          Add(UsedModule);
+        UseImplBlock(UsedModule.InitializationSection,true);
+        UseImplBlock(UsedModule.FinalizationSection,true);
+        end;
+      end;
+    end;
+
+  // section declarations
+  for i:=0 to Section.Declarations.Count-1 do
+    begin
+    Decl:=TPasElement(Section.Declarations[i]);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseSection ',Section.ClassName,' Decl=',GetElModName(Decl),' Mode=',Mode);
+    {$ENDIF}
+    if Decl is TPasProcedure then
+      begin
+      if OnlyExports and ([pmExport,pmPublic]*TPasProcedure(Decl).Modifiers=[]) then
+        continue;
+      UseProcedure(TPasProcedure(Decl))
+      end
+    else if Decl is TPasType then
+      UseType(TPasType(Decl),Mode)
+    else if Decl is TPasVariable then
+      begin
+      if OnlyExports and ([vmExport,vmPublic]*TPasVariable(Decl).VarModifiers=[]) then
+        continue;
+      UseVariable(TPasVariable(Decl),rraNone,true);
+      end
+    else
+      RaiseNotSupported(20170306165213,Decl);
+    end;
+end;
+
+procedure TPasAnalyzer.UseImplBlock(Block: TPasImplBlock; Mark: boolean);
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  if Block=nil then exit;
+  if Mark and not MarkElementAsUsed(Block) then exit;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseImplBlock ',GetElModName(Block),' Elements=',Block.Elements.Count);
+  {$ENDIF}
+  for i:=0 to Block.Elements.Count-1 do
+    begin
+    El:=TPasElement(Block.Elements[i]);
+    if El is TPasImplElement then
+      UseImplElement(TPasImplElement(El))
+    else
+      RaiseNotSupported(20170306195110,El);
+    end;
+end;
+
+procedure TPasAnalyzer.UseImplElement(El: TPasImplElement);
+var
+  C: TClass;
+  ForLoop: TPasImplForLoop;
+  CaseOf: TPasImplCaseOf;
+  i, j: Integer;
+  CaseSt: TPasImplCaseStatement;
+  WithDo: TPasImplWithDo;
+  SubEl, ParentEl: TPasElement;
+begin
+  // do not mark
+  if El=nil then exit;
+  C:=El.ClassType;
+  if C=TPasImplBlock then
+    // impl block
+    UseImplBlock(TPasImplBlock(El),false)
+  else if C=TPasImplSimple then
+    // simple expression
+    UseExpr(TPasImplSimple(El).expr)
+  else if C=TPasImplAssign then
+    // a:=b
+    begin
+    UseExpr(TPasImplAssign(El).left);
+    UseExpr(TPasImplAssign(El).right);
+    end
+  else if C=TPasImplAsmStatement then
+    // asm..end
+  else if C=TPasImplBeginBlock then
+    // begin..end
+    UseImplBlock(TPasImplBeginBlock(El),false)
+  else if C=TPasImplCaseOf then
+    begin
+    // case-of
+    CaseOf:=TPasImplCaseOf(El);
+    UseExpr(CaseOf.CaseExpr);
+    for i:=0 to CaseOf.Elements.Count-1 do
+      begin
+      SubEl:=TPasElement(CaseOf.Elements[i]);
+      if SubEl.ClassType=TPasImplCaseStatement then
+        begin
+        CaseSt:=TPasImplCaseStatement(SubEl);
+        for j:=0 to CaseSt.Expressions.Count-1 do
+          UseExpr(TObject(CaseSt.Expressions[j]) as TPasExpr);
+        UseImplElement(CaseSt.Body);
+        end
+      else if SubEl.ClassType=TPasImplCaseElse then
+        UseImplBlock(TPasImplCaseElse(SubEl),false)
+      else
+        RaiseNotSupported(20170307195329,SubEl);
+      end;
+    end
+  else if C=TPasImplForLoop then
+    begin
+    // for-loop
+    ForLoop:=TPasImplForLoop(El);
+    UseExpr(ForLoop.VariableName);
+    UseExpr(ForLoop.StartExpr);
+    UseExpr(ForLoop.EndExpr);
+    UseImplElement(ForLoop.Body);
+    end
+  else if C=TPasImplIfElse then
+    begin
+    // if-then-else
+    UseExpr(TPasImplIfElse(El).ConditionExpr);
+    UseImplElement(TPasImplIfElse(El).IfBranch);
+    UseImplElement(TPasImplIfElse(El).ElseBranch);
+    end
+  else if C=TPasImplLabelMark then
+    // label mark
+  else if C=TPasImplRepeatUntil then
+    begin
+    // repeat-until
+    UseImplBlock(TPasImplRepeatUntil(El),false);
+    UseExpr(TPasImplRepeatUntil(El).ConditionExpr);
+    end
+  else if C=TPasImplWhileDo then
+    begin
+    // while-do
+    UseExpr(TPasImplWhileDo(El).ConditionExpr);
+    UseImplBlock(TPasImplWhileDo(El),false);
+    end
+  else if C=TPasImplWithDo then
+    begin
+    // with-do
+    WithDo:=TPasImplWithDo(El);
+    for i:=0 to WithDo.Expressions.Count-1 do
+      UseExpr(TObject(WithDo.Expressions[i]) as TPasExpr);
+    UseImplBlock(WithDo,false);
+    end
+  else if C=TPasImplExceptOn then
+    begin
+    // except-on
+    UseType(TPasImplExceptOn(El).TypeEl,paumElement);
+    UseImplElement(TPasImplExceptOn(El).Body);
+    end
+  else if C=TPasImplRaise then
+    begin
+    // raise
+    if TPasImplRaise(El).ExceptObject<>nil then
+      UseExpr(TPasImplRaise(El).ExceptObject)
+    else
+      begin
+      // raise; -> mark On E:
+      ParentEl:=El.Parent;
+      while ParentEl<>nil do
+        begin
+        if ParentEl is TPasImplExceptOn then
+          begin
+          UseVariable(TPasVariable(TPasImplExceptOn(ParentEl).VarEl),rraRead,false);
+          break;
+          end;
+        ParentEl:=ParentEl.Parent;
+        end;
+      end;
+    UseExpr(TPasImplRaise(El).ExceptAddr);
+    end
+  else if C=TPasImplTry then
+    begin
+    // try..finally/except..else..end
+    UseImplBlock(TPasImplTry(El),false);
+    UseImplBlock(TPasImplTry(El).FinallyExcept,false);
+    UseImplBlock(TPasImplTry(El).ElseBranch,false);
+    end
+  else
+    RaiseNotSupported(20170307162715,El);
+end;
+
+procedure TPasAnalyzer.UseExpr(El: TPasExpr);
+var
+  Ref: TResolvedReference;
+  C: TClass;
+  Params: TPasExprArray;
+  i: Integer;
+  BuiltInProc: TResElDataBuiltInProc;
+  ParamResolved: TPasResolverResult;
+  Decl: TPasElement;
+begin
+  if El=nil then exit;
+  // expressions are not marked
+
+  Ref:=nil;
+  if El.CustomData is TResolvedReference then
+    begin
+    // this is a reference -> mark target
+    Ref:=TResolvedReference(El.CustomData);
+    Decl:=Ref.Declaration;
+    UseElement(Decl,Ref.Access,false);
+
+    if Resolver.IsNameExpr(El) then
+      begin
+      if Ref.WithExprScope<>nil then
+        begin
+        if Ref.WithExprScope.Scope is TPasRecordScope then
+          begin
+          // a record member was accessed -> access the record too
+          UseExprRef(Ref.WithExprScope.Expr,Ref.Access,false);
+          exit;
+          end;
+        end;
+      if (Decl is TPasVariable)
+          and (El.Parent is TBinaryExpr)
+          and (TBinaryExpr(El.Parent).right=El) then
+        begin
+        if ((Decl.Parent is TPasRecordType)
+              or (Decl.Parent is TPasVariant)) then
+          begin
+          // a record member was accessed -> access the record too
+          UseExprRef(TBinaryExpr(El.Parent).left,Ref.Access,false);
+          end;
+        end;
+      end;
+
+    if Decl is TPasUnresolvedSymbolRef then
+      begin
+      if Decl.CustomData is TResElDataBuiltInProc then
+        begin
+        BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
+        if BuiltInProc.BuiltIn=bfTypeInfo then
+          begin
+          Params:=(El.Parent as TParamsExpr).Params;
+          Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
+          {$IFDEF VerbosePasAnalyzer}
+          writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
+          {$ENDIF}
+          if ParamResolved.IdentEl is TPasFunction then
+            UsePublished(TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType)
+          else
+            UsePublished(ParamResolved.IdentEl);
+          end;
+        end;
+      end;
+
+    end;
+  UseExpr(El.format1);
+  UseExpr(El.format2);
+  C:=El.ClassType;
+  if (C=TPrimitiveExpr)
+      or (C=TSelfExpr)
+      or (C=TBoolConstExpr)
+      or (C=TInheritedExpr)
+      or (C=TNilExpr) then
+  else if C=TBinaryExpr then
+    begin
+    UseExpr(TBinaryExpr(El).left);
+    UseExpr(TBinaryExpr(El).right);
+    end
+  else if C=TUnaryExpr then
+    UseExpr(TUnaryExpr(El).Operand)
+  else if C=TParamsExpr then
+    begin
+    UseExpr(TParamsExpr(El).Value);
+    Params:=TParamsExpr(El).Params;
+    for i:=0 to length(Params)-1 do
+      UseExpr(Params[i]);
+    end
+  else if C=TArrayValues then
+    begin
+    Params:=TArrayValues(El).Values;
+    for i:=0 to length(Params)-1 do
+      UseExpr(Params[i]);
+    end
+  else
+    RaiseNotSupported(20170307085444,El);
+end;
+
+procedure TPasAnalyzer.UseExprRef(Expr: TPasExpr; Access: TResolvedRefAccess;
+  UseFull: boolean);
+var
+  Ref: TResolvedReference;
+  C: TClass;
+  Bin: TBinaryExpr;
+  Params: TParamsExpr;
+  ValueResolved: TPasResolverResult;
+begin
+  if (Expr.CustomData is TResolvedReference) then
+    begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    UseElement(Ref.Declaration,Access,UseFull);
+    end;
+
+  C:=Expr.ClassType;
+  if C=TBinaryExpr then
+    begin
+    Bin:=TBinaryExpr(Expr);
+    if Bin.OpCode in [eopSubIdent,eopNone] then
+      UseExprRef(Bin.right,Access,UseFull);
+    end
+  else if C=TParamsExpr then
+    begin
+    Params:=TParamsExpr(Expr);
+    case Params.Kind of
+    pekFuncParams:
+      if Resolver.IsTypeCast(Params) then
+        UseExprRef(Params.Params[0],Access,UseFull)
+      else
+        UseExprRef(Params.Value,Access,UseFull);
+    pekArrayParams:
+      begin
+      Resolver.ComputeElement(Params.Value,ValueResolved,[]);
+      if not Resolver.IsDynArray(ValueResolved.TypeEl) then
+        UseExprRef(Params.Value,Access,UseFull);
+      end;
+    pekSet: ;
+    else
+      RaiseNotSupported(20170403173817,Params);
+    end;
+    end
+  else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
+    // ok
+  else if (Access=rraRead)
+      and ((C=TPrimitiveExpr)
+        or (C=TNilExpr)
+        or (C=TBoolConstExpr)
+        or (C=TUnaryExpr)) then
+    // ok
+  else
+    begin
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.UseExprRef Expr=',GetObjName(Expr),' Access=',Access,' Declaration="',Expr.GetDeclaration(false),'"');
+    {$ENDIF}
+    RaiseNotSupported(20170306102158,Expr);
+    end;
+end;
+
+procedure TPasAnalyzer.UseProcedure(Proc: TPasProcedure);
+
+  procedure UseOverrides(CurProc: TPasProcedure);
+  var
+    OverrideList: TPAOverrideList;
+    i: Integer;
+    OverrideProc: TPasProcedure;
+  begin
+    OverrideList:=FindOverrideList(CurProc);
+    if OverrideList=nil then exit;
+    // Note: while traversing the OverrideList it may grow
+    i:=0;
+    while i<OverrideList.Count do
+      begin
+      OverrideProc:=TObject(OverrideList.Overrides[i]) as TPasProcedure;
+      UseProcedure(OverrideProc);
+      inc(i);
+      end;
+  end;
+
+var
+  ProcScope: TPasProcedureScope;
+  ImplProc: TPasProcedure;
+begin
+  // use declaration, not implementation
+  ProcScope:=Proc.CustomData as TPasProcedureScope;
+  if ProcScope.DeclarationProc<>nil then
+    exit; // skip implementation, Note:PasResolver always refers the declaration
+
+  if not MarkElementAsUsed(Proc) then exit;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseProcedure ',GetElModName(Proc));
+  {$ENDIF}
+  UseProcedureType(Proc.ProcType,false);
+
+  ImplProc:=Proc;
+  if ProcScope.ImplProc<>nil then
+    ImplProc:=ProcScope.ImplProc;
+  if ImplProc.Body<>nil then
+    UseImplBlock(ImplProc.Body.Body,false);
+
+  if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
+    AddOverride(ProcScope.OverriddenProc,Proc);
+
+  // mark overrides
+  if [pmOverride,pmVirtual]*Proc.Modifiers<>[] then
+    UseOverrides(Proc);
+end;
+
+procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;
+  Mark: boolean);
+var
+  i: Integer;
+  Arg: TPasArgument;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
+  {$ENDIF}
+  if Mark and not MarkElementAsUsed(ProcType) then exit;
+  for i:=0 to ProcType.Args.Count-1 do
+    begin
+    Arg:=TPasArgument(ProcType.Args[i]);
+    // Note: argument are marked when used in code
+    // mark argument type
+    UseType(Arg.ArgType,paumElement);
+    end;
+  if ProcType is TPasFunctionType then
+    UseType(TPasFunctionType(ProcType).ResultEl.ResultType,paumElement);
+end;
+
+procedure TPasAnalyzer.UseType(El: TPasType; Mode: TPAUseMode);
+var
+  C: TClass;
+  i: Integer;
+begin
+  if El=nil then exit;
+  C:=El.ClassType;
+  if Mode=paumAllExports then
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseType searching exports in ',GetElModName(El),' ...');
+    {$ENDIF}
+    if C=TPasRecordType then
+      UseRecordType(TPasRecordType(El),Mode)
+    else if C=TPasClassType then
+      UseClassType(TPasClassType(El),Mode);
+    end
+  else
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseType using ',GetElModName(El),' Mode=',Mode);
+    {$ENDIF}
+    if C=TPasUnresolvedSymbolRef then
+      begin
+      if (El.CustomData is TResElDataBaseType)
+          or (El.CustomData is TResElDataBuiltInProc) then
+      else
+        RaiseNotSupported(20170307101353,El);
+      end
+    else if (C=TPasAliasType)
+        or (C=TPasTypeAliasType)
+        or (C=TPasClassOfType) then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseType(TPasAliasType(El).DestType,Mode);
+      end
+    else if C=TPasArrayType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      for i:=0 to length(TPasArrayType(El).Ranges)-1 do
+        UseExpr(TPasArrayType(El).Ranges[i]);
+      UseType(TPasArrayType(El).ElType,Mode);
+      end
+    else if C=TPasRecordType then
+      UseRecordType(TPasRecordType(El),Mode)
+    else if C=TPasClassType then
+      UseClassType(TPasClassType(El),Mode)
+    else if C=TPasEnumType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      end
+    else if C=TPasPointerType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseType(TPasPointerType(El).DestType,Mode);
+      end
+    else if C=TPasRangeType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseExpr(TPasRangeType(El).RangeExpr);
+      end
+    else if C=TPasSetType then
+      begin
+      if not MarkElementAsUsed(El) then exit;
+      UseType(TPasSetType(El).EnumType,Mode);
+      end
+    else if C.InheritsFrom(TPasProcedureType) then
+      UseProcedureType(TPasProcedureType(El),true)
+    else
+      RaiseNotSupported(20170306170315,El);
+    end;
+end;
+
+procedure TPasAnalyzer.UseRecordType(El: TPasRecordType; Mode: TPAUseMode);
+// called by UseType
+var
+  i: Integer;
+begin
+  if Mode=paumAllExports then exit;
+  MarkElementAsUsed(El);
+  if (Mode=paumAllPublic) and not ElementVisited(El,Mode) then
+    for i:=0 to El.Members.Count-1 do
+      UseVariable(TObject(El.Members[i]) as TPasVariable,rraNone,true);
+end;
+
+procedure TPasAnalyzer.UseClassType(El: TPasClassType; Mode: TPAUseMode);
+// called by UseType
+var
+  i: Integer;
+  Member: TPasElement;
+  AllPublished, FirstTime: Boolean;
+  ProcScope: TPasProcedureScope;
+  ClassScope: TPasClassScope;
+  Ref: TResolvedReference;
+begin
+  FirstTime:=true;
+  case Mode of
+  paumAllExports: exit;
+  paumAllPublic:
+    begin
+    if MarkElementAsUsed(El) then
+      ElementVisited(El,Mode)
+    else
+      begin
+      if ElementVisited(El,Mode) then exit;
+      FirstTime:=false;
+      end;
+    end;
+  paumElement:
+    if not MarkElementAsUsed(El) then exit;
+  else
+    RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
+  end;
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseClassType ',GetElModName(El),' ',Mode,' First=',FirstTime);
+  {$ENDIF}
+  if El.IsForward then
+    begin
+    Ref:=El.CustomData as TResolvedReference;
+    UseClassType(Ref.Declaration as TPasClassType,Mode);
+    exit;
+    end;
+
+  ClassScope:=El.CustomData as TPasClassScope;
+  if FirstTime then
+    begin
+    UseType(ClassScope.DirectAncestor,paumElement);
+    UseType(El.HelperForType,paumElement);
+    UseExpr(El.GUIDExpr);
+    for i:=0 to El.Interfaces.Count-1 do
+      UseType(TPasType(El.Interfaces[i]),paumElement);
+    end;
+  // members
+  AllPublished:=(Mode<>paumAllExports);
+  for i:=0 to El.Members.Count-1 do
+    begin
+    Member:=TPasElement(El.Members[i]);
+    if FirstTime and (Member is TPasProcedure) then
+      begin
+      ProcScope:=Member.CustomData as TPasProcedureScope;
+      if TPasProcedure(Member).IsOverride and (ProcScope.OverriddenProc<>nil) then
+        begin
+        // this is an override
+        AddOverride(ProcScope.OverriddenProc,Member);
+        if ScopeModule<>nil then
+          begin
+          // when analyzingf a single module, all overrides are assumed to be called
+          UseElement(Member,rraNone,true);
+          continue;
+          end;
+        end;
+      end;
+    if AllPublished and (Member.Visibility=visPublished) then
+      begin
+      // include published
+      if not FirstTime then continue;
+      UsePublished(Member);
+      end
+    else if Mode=paumElement then
+      continue
+    else if IsModuleInternal(Member) then
+      // private or strict private
+      continue
+    else
+      ; // else: class is in unit interface, mark all non private members
+    UseElement(Member,rraNone,true);
+    end;
+end;
+
+procedure TPasAnalyzer.UseVariable(El: TPasVariable;
+  Access: TResolvedRefAccess; UseFull: boolean);
+var
+  Usage: TPAElement;
+  UseRead, UseWrite: boolean;
+
+  procedure UpdateVarAccess(IsRead, IsWrite: boolean);
+  begin
+    if IsRead then
+      case Usage.Access of
+        paiaNone: begin Usage.Access:=paiaRead; UseRead:=true; end;
+        paiaRead: ;
+        paiaWrite: begin Usage.Access:=paiaWriteRead; UseRead:=true; end;
+        paiaReadWrite: ;
+        paiaWriteRead: ;
+        else RaiseInconsistency(20170311182420,'');
+      end;
+    if IsWrite then
+      case Usage.Access of
+        paiaNone: begin Usage.Access:=paiaWrite; UseWrite:=true; end;
+        paiaRead: begin Usage.Access:=paiaReadWrite; UseWrite:=true; end;
+        paiaWrite: ;
+        paiaReadWrite: ;
+        paiaWriteRead: ;
+        else RaiseInconsistency(20170311182536,'');
+      end;
+  end;
+
+var
+  Prop: TPasProperty;
+  i: Integer;
+  IsRead, IsWrite, CanRead, CanWrite: Boolean;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.UseVariable ',GetElModName(El),' ',Access,' Full=',UseFull);
+  {$ENDIF}
+  if El.ClassType=TPasProperty then
+    Prop:=TPasProperty(El)
+  else
+    Prop:=nil;
+
+  IsRead:=false;
+  IsWrite:=false;
+  if UseFull then
+    if (Prop<>nil) then
+      begin
+      CanRead:=Resolver.GetPasPropertyGetter(Prop)<>nil;
+      CanWrite:=Resolver.GetPasPropertySetter(Prop)<>nil;
+      if CanRead then
+        begin
+        if CanWrite then
+          Access:=rraReadAndAssign
+        else
+          Access:=rraRead;
+        end
+      else
+        if CanWrite then
+          Access:=rraAssign
+        else
+          Access:=rraNone;
+      end
+    else
+      Access:=rraRead;
+  case Access of
+    rraNone: ;
+    rraRead: IsRead:=true;
+    rraAssign: IsWrite:=true;
+    rraReadAndAssign,
+    rraVarParam,
+    rraOutParam: begin IsRead:=true; IsWrite:=true; end;
+    rraParamToUnknownProc: RaiseInconsistency(20170307153439,'');
+  else
+    RaiseInconsistency(20170308120949,'');
+  end;
+
+  UseRead:=false;
+  UseWrite:=false;
+  if MarkElementAsUsed(El) then
+    begin
+    // first access of this variable
+    Usage:=FindElement(El);
+    // first set flags
+    if El.Expr<>nil then
+      Usage.Access:=paiaWrite;
+    UpdateVarAccess(IsRead,IsWrite);
+    // then use recursively
+    UseType(El.VarType,paumElement);
+    UseExpr(El.Expr);
+    UseExpr(El.LibraryName);
+    UseExpr(El.ExportName);
+    if Prop<>nil then
+      begin
+      for i:=0 to Prop.Args.Count-1 do
+        UseType(TPasArgument(Prop.Args[i]).ArgType,paumElement);
+      UseExpr(Prop.IndexExpr);
+      // ToDo: Prop.ImplementsFunc
+      // ToDo: Prop.DispIDExpr
+      // ToDo: Prop.StoredAccessor;
+      // ToDo: Prop.DefaultExpr;
+      end;
+    end
+  else
+    begin
+    Usage:=FindElement(El);
+    if Usage=nil then
+      exit; // element outside of scope
+    // var is accessed another time
+
+    // first update flags
+    UpdateVarAccess(IsRead,IsWrite);
+    end;
+  // then use recursively
+  if Prop<>nil then
+    begin
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseVariable Property=',Prop.FullName,
+      ' Ancestor=',GetElModName(Resolver.GetPasPropertyAncestor(Prop)),
+      ' UseRead=',UseRead,',Acc=',GetElModName(Resolver.GetPasPropertyGetter(Prop)),
+      ' UseWrite=',UseWrite,',Acc=',GetElModName(Resolver.GetPasPropertySetter(Prop)),
+      '');
+    {$ENDIF}
+    if UseRead then
+      UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
+    if UseWrite then
+      UseElement(Resolver.GetPasPropertySetter(Prop),rraAssign,false);
+    end;
+end;
+
+procedure TPasAnalyzer.UseArgument(El: TPasArgument; Access: TResolvedRefAccess
+  );
+var
+  Usage: TPAElement;
+  IsRead, IsWrite: Boolean;
+begin
+  IsRead:=false;
+  IsWrite:=false;
+  case Access of
+    rraNone: ;
+    rraRead: IsRead:=true;
+    rraAssign: IsWrite:=true;
+    rraReadAndAssign,
+    rraVarParam,
+    rraOutParam: begin IsRead:=true; IsWrite:=true; end;
+    rraParamToUnknownProc: RaiseInconsistency(20170308121031,'');
+  else
+    RaiseInconsistency(20170308121037,'');
+  end;
+  if MarkElementAsUsed(El) then
+    begin
+    // first time
+    Usage:=FindElement(El);
+    end
+  else
+    begin
+    // used again
+    Usage:=FindElement(El);
+    if Usage=nil then
+      RaiseNotSupported(20170308121928,El);
+    end;
+  UpdateAccess(IsWrite, IsRead, Usage);
+end;
+
+procedure TPasAnalyzer.UseResultElement(El: TPasResultElement;
+  Access: TResolvedRefAccess);
+var
+  IsRead, IsWrite: Boolean;
+  Usage: TPAElement;
+begin
+  IsRead:=false;
+  IsWrite:=false;
+  case Access of
+    rraNone: ;
+    rraRead: IsRead:=true;
+    rraAssign: IsWrite:=true;
+    rraReadAndAssign,
+    rraVarParam,
+    rraOutParam: begin IsRead:=true; IsWrite:=true; end;
+    rraParamToUnknownProc: RaiseInconsistency(20170308122319,'');
+  else
+    RaiseInconsistency(20170308122324,'');
+  end;
+  if MarkElementAsUsed(El) then
+    begin
+    // first time
+    Usage:=FindElement(El);
+    end
+  else
+    begin
+    // used again
+    Usage:=FindElement(El);
+    if Usage=nil then
+      RaiseNotSupported(20170308122333,El);
+    end;
+  UpdateAccess(IsWrite, IsRead, Usage);
+end;
+
+procedure TPasAnalyzer.EmitElementHints(El: TPasElement);
+begin
+  if El=nil then exit;
+  if El is TPasVariable then
+    EmitVariableHints(TPasVariable(El))
+  else if El is TPasType then
+    EmitTypeHints(TPasType(El))
+  else if El is TPasProcedure then
+    EmitProcedureHints(TPasProcedure(El))
+  else
+    RaiseInconsistency(20170312093126,'');
+end;
+
+procedure TPasAnalyzer.EmitSectionHints(Section: TPasSection);
+var
+  i: Integer;
+  UsedModule, aModule: TPasModule;
+  UsesClause: TPasUsesClause;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
+  {$ENDIF}
+  // initialization, program or library sections
+  aModule:=Section.GetModule;
+  UsesClause:=Section.UsesClause;
+  for i:=0 to length(UsesClause)-1 do
+    begin
+    if UsesClause[i].Module is TPasModule then
+      begin
+      UsedModule:=TPasModule(UsesClause[i].Module);
+      if CompareText(UsedModule.Name,'system')=0 then continue;
+      if FindNode(UsedModule)=nil then
+        EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
+          [UsedModule.Name,aModule.Name],aModule);
+      end;
+    end;
+
+  EmitDeclarationsHints(Section);
+end;
+
+procedure TPasAnalyzer.EmitDeclarationsHints(El: TPasDeclarations);
+var
+  i: Integer;
+  Decl: TPasElement;
+  Usage: TPAElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitDeclarationsHints ',GetElModName(El));
+  {$ENDIF}
+  for i:=0 to El.Declarations.Count-1 do
+    begin
+    Decl:=TPasElement(El.Declarations[i]);
+    if Decl is TPasVariable then
+      EmitVariableHints(TPasVariable(Decl))
+    else if Decl is TPasType then
+      EmitTypeHints(TPasType(Decl))
+    else if Decl is TPasProcedure then
+      EmitProcedureHints(TPasProcedure(Decl))
+    else
+      begin
+      Usage:=FindPAElement(Decl);
+      if Usage=nil then
+        begin
+        // declaration was never used
+        EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
+          sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
+        end;
+      end;
+    end;
+end;
+
+procedure TPasAnalyzer.EmitTypeHints(El: TPasType);
+var
+  C: TClass;
+  Usage: TPAElement;
+  i: Integer;
+  Member: TPasElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
+  {$ENDIF}
+  Usage:=FindPAElement(El);
+  if Usage=nil then
+    begin
+    // the whole type was never used
+    if (El.Visibility in [visPrivate,visStrictPrivate]) then
+      EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
+        sPAPrivateTypeXNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+    exit;
+    end;
+  // emit hints for sub elements
+  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
+  else if C=TPasClassType then
+    begin
+    if TPasClassType(El).IsForward then exit;
+    for i:=0 to TPasClassType(El).Members.Count-1 do
+      begin
+      Member:=TPasElement(TPasClassType(El).Members[i]);
+      EmitElementHints(Member);
+      end;
+    end;
+end;
+
+procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);
+var
+  Usage: TPAElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitVariableHints ',GetElModName(El));
+  {$ENDIF}
+  Usage:=FindPAElement(El);
+  if Usage=nil then
+    begin
+    // not used
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      begin
+      if El.ClassType=TPasConst then
+        EmitMessage(20170311234602,mtHint,nPAPrivateConstXNeverUsed,
+          sPAPrivateConstXNeverUsed,[El.FullName],El)
+      else if El.ClassType=TPasProperty then
+        EmitMessage(20170311234634,mtHint,nPAPrivatePropertyXNeverUsed,
+          sPAPrivatePropertyXNeverUsed,[El.FullName],El)
+      else
+        EmitMessage(20170311231412,mtHint,nPAPrivateFieldIsNeverUsed,
+          sPAPrivateFieldIsNeverUsed,[El.FullName],El);
+      end
+    else if El.ClassType=TPasVariable then
+      EmitMessage(20170311234201,mtHint,nPALocalVariableNotUsed,
+        sPALocalVariableNotUsed,[El.Name],El)
+    else
+      EmitMessage(20170314221334,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+    end
+  else if Usage.Access=paiaWrite then
+    begin
+    // write without read
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
+        sPAPrivateFieldIsAssignedButNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170311233825,mtHint,nPALocalVariableIsAssignedButNeverUsed,
+        sPALocalVariableIsAssignedButNeverUsed,[El.Name],El);
+    end;
+end;
+
+procedure TPasAnalyzer.EmitProcedureHints(El: TPasProcedure);
+var
+  Args: TFPList;
+  i: Integer;
+  Arg: TPasArgument;
+  Usage: TPAElement;
+  ProcScope: TPasProcedureScope;
+  PosEl: TPasElement;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
+  {$ENDIF}
+  ProcScope:=El.CustomData as TPasProcedureScope;
+  if (ProcScope.DeclarationProc=nil) and (FindNode(El)=nil) then
+    begin
+    // procedure never used
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
+        sPAPrivateMethodIsNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+    exit;
+    end;
+
+  // procedure was used
+
+  if [pmAbstract,pmAssembler,pmExternal]*El.Modifiers<>[] then exit;
+
+  if ProcScope.DeclarationProc=nil then
+    begin
+    // check parameters
+    Args:=El.ProcType.Args;
+    for i:=0 to Args.Count-1 do
+      begin
+      Arg:=TPasArgument(Args[i]);
+      Usage:=FindPAElement(Arg);
+      if (Usage=nil) or (Usage.Access=paiaNone) then
+        // parameter was never used
+        EmitMessage(20170312094401,mtHint,nPAParameterNotUsed,
+          sPAParameterNotUsed,[Arg.Name],Arg)
+      else
+        begin
+        // parameter was used
+        if (Usage.Access=paiaWrite) and (Arg.Access<>argOut) then
+          EmitMessage(20170312095348,mtHint,nPAValueParameterIsAssignedButNeverUsed,
+            sPAValueParameterIsAssignedButNeverUsed,[Arg.Name],Arg);
+        end;
+      end;
+    // check result
+    if (El is TPasFunction) then
+      begin
+      PosEl:=TPasFunction(El).FuncType.ResultEl;
+      if (ProcScope.ImplProc<>nil) and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
+        PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
+      Usage:=FindPAElement(TPasFunction(El).FuncType.ResultEl);
+      if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
+        // result was never used
+        EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+          sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
+      else
+        begin
+        // result was used
+        end;
+      end;
+    end;
+
+  if El.Body<>nil then
+    begin
+    // check declarations
+    EmitDeclarationsHints(El.Body);
+    // ToDo: emit hints for statements
+    end;
+end;
+
+constructor TPasAnalyzer.Create;
+var
+  m: TPAUseMode;
+begin
+  CreateTree;
+  for m in TPAUseMode do
+    FChecked[m]:=TAVLTree.Create;
+  FOverrideLists:=TAVLTree.Create(@ComparePAOverrideLists);
+end;
+
+destructor TPasAnalyzer.Destroy;
+var
+  m: TPAUseMode;
+begin
+  Clear;
+  FreeAndNil(FOverrideLists);
+  FreeAndNil(FUsedElements);
+  for m in TPAUseMode do
+    FreeAndNil(FChecked[m]);
+  inherited Destroy;
+end;
+
+procedure TPasAnalyzer.Clear;
+var
+  m: TPAUseMode;
+begin
+  FOverrideLists.FreeAndClear;
+  FUsedElements.FreeAndClear;
+  for m in TPAUseMode do
+    FChecked[m].Clear;
+end;
+
+procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
+var
+  Mode: TPAUseMode;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeModule START ',GetElModName(aModule));
+  {$ENDIF}
+  if Resolver=nil then
+    RaiseInconsistency(20170314223032,'TPasAnalyzer.AnalyzeModule missing Resolver');
+  if FUsedElements.Count>0 then
+    RaiseInconsistency(20170315153243,'');
+  ScopeModule:=aModule;
+  if (aModule is TPasProgram) or (aModule is TPasLibrary) then
+    Mode:=paumAllExports
+  else
+    Mode:=paumAllPublic;
+  UseModule(aModule,Mode);
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeModule END ',GetElModName(aModule));
+  {$ENDIF}
+end;
+
+procedure TPasAnalyzer.AnalyzeWholeProgram(aStartModule: TPasProgram);
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeWholeProgram START ',GetElModName(aStartModule));
+  {$ENDIF}
+  if Resolver=nil then
+    RaiseInconsistency(20170315153201,'TPasAnalyzer.AnalyzeWholeProgram missing Resolver');
+  if FUsedElements.Count>0 then
+    RaiseInconsistency(20170315153252,'');
+  ScopeModule:=nil;
+  UseModule(aStartModule,paumAllExports);
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.AnalyzeWholeProgram END ',GetElModName(aStartModule));
+  {$ENDIF}
+end;
+
+procedure TPasAnalyzer.EmitModuleHints(aModule: TPasModule);
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitModuleHints ',GetElModName(aModule));
+  {$ENDIF}
+  if aModule.ClassType=TPasProgram then
+    EmitSectionHints(TPasProgram(aModule).ProgramSection)
+  else if aModule.ClassType=TPasLibrary then
+    EmitSectionHints(TPasLibrary(aModule).LibrarySection)
+  else
+    begin
+    // unit
+    EmitSectionHints(aModule.InterfaceSection);
+    EmitSectionHints(aModule.ImplementationSection);
+    end;
+  //EmitBlockHints(aModule.InitializationSection);
+  //EmitBlockHints(aModule.FinalizationSection);
+end;
+
+function TPasAnalyzer.FindElement(El: TPasElement): TPAElement;
+var
+  Node: TAVLTreeNode;
+begin
+  Node:=FindNode(El);
+  if Node=nil then
+    Result:=nil
+  else
+    Result:=TPAElement(Node.Data);
+end;
+
+function TPasAnalyzer.IsUsed(El: TPasElement): boolean;
+var
+  ProcScope: TPasProcedureScope;
+begin
+  if not IsIdentifier(El) then exit(true);
+  if El is TPasProcedure then
+    begin
+    ProcScope:=El.CustomData as TPasProcedureScope;
+    if ProcScope.DeclarationProc<>nil then
+      El:=ProcScope.DeclarationProc;
+    end;
+  Result:=FindElement(El)<>nil;
+end;
+
+function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
+begin
+  Result:=FChecked[paumPublished].Find(El)<>nil;
+end;
+
+function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
+begin
+  if El=nil then
+    exit(true);
+  if El.ClassType=TInterfaceSection then
+    exit(false);
+  if IsExport(El) then exit(false);
+  case El.Visibility of
+  visPrivate,visStrictPrivate: exit(true);
+  visPublished: exit(false);
+  end;
+  Result:=IsModuleInternal(El.Parent);
+end;
+
+function TPasAnalyzer.IsExport(El: TPasElement): boolean;
+begin
+  if El is TPasVariable then
+    Result:=[vmExport,vmPublic]*TPasVariable(El).VarModifiers<>[]
+  else if El is TPasProcedure then
+    Result:=[pmExport,pmPublic]*TPasProcedure(El).Modifiers<>[]
+  else
+    Result:=false;
+end;
+
+function TPasAnalyzer.IsIdentifier(El: TPasElement): boolean;
+var
+  C: TClass;
+begin
+  C:=El.ClassType;
+  Result:=C.InheritsFrom(TPasType)
+      or C.InheritsFrom(TPasVariable)
+      or C.InheritsFrom(TPasProcedure)
+      or C.InheritsFrom(TPasModule);
+end;
+
+function TPasAnalyzer.IsImplBlockEmpty(El: TPasImplBlock): boolean;
+begin
+  Result:=true;
+  if (El=nil) or (El.Elements.Count=0) then exit;
+  Result:=false;
+end;
+
+procedure TPasAnalyzer.EmitMessage(const Id: int64;
+  const MsgType: TMessageType; MsgNumber: integer; Fmt: String;
+  const Args: array of const; PosEl: TPasElement);
+var
+  Msg: TPAMessage;
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  //writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
+  {$ENDIF}
+  Msg:=TPAMessage.Create;
+  Msg.Id:=Id;
+  Msg.MsgType:=MsgType;
+  Msg.MsgNumber:=MsgNumber;
+  Msg.MsgPattern:=Fmt;
+  Msg.MsgText:=SafeFormat(Fmt,Args);
+  CreateMsgArgs(Msg.Args,Args);
+  Msg.PosEl:=PosEl;
+  Msg.Filename:=PosEl.SourceFilename;
+  Resolver.UnmangleSourceLineNumber(PosEl.SourceLinenumber,Msg.Row,Msg.Col);
+  EmitMessage(Msg);
+end;
+
+procedure TPasAnalyzer.EmitMessage(Msg: TPAMessage);
+begin
+  {$IFDEF VerbosePasAnalyzer}
+  writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') ',Msg.MsgText);
+  {$ENDIF}
+  try
+    OnMessage(Self,Msg);
+  finally
+    Msg.Release;
+  end;
+end;
+
+end.
+
diff --git a/packages/fcl-passrc/src/paswrite.pp b/packages/fcl-passrc/src/paswrite.pp
index ab428aa00b..5a941c1e58 100644
--- a/packages/fcl-passrc/src/paswrite.pp
+++ b/packages/fcl-passrc/src/paswrite.pp
@@ -182,18 +182,28 @@ procedure TPasWriter.WriteSection(ASection: TPasSection);
 var
   i: Integer;
 begin
-  if ASection.UsesList.Count > 0 then
-  begin
-    wrt('uses ');
-    for i := 0 to ASection.UsesList.Count - 1 do
+  if ASection.UsesList.Count>0 then
     begin
-      if i > 0 then
-        wrt(', ');
-      wrt(TPasElement(ASection.UsesList[i]).Name);
-    end;
+    wrt('uses ');
+    if length(ASection.UsesClause)=ASection.UsesList.Count then
+      for i := 0 to length(ASection.UsesClause)-1 do
+        begin
+        if i > 0 then
+          wrt(', ');
+        wrt(ASection.UsesClause[i].Name);
+        if ASection.UsesClause[i].InFilename is TPrimitiveExpr then
+          wrt(' in '''+TPrimitiveExpr(ASection.UsesClause[i].InFilename).Value+'''');
+        end
+    else
+      for i := 0 to ASection.UsesList.Count - 1 do
+        begin
+        if i > 0 then
+          wrt(', ');
+        wrt(TPasElement(ASection.UsesList[i]).Name);
+        end;
     wrtln(';');
     wrtln;
-  end;
+    end;
 
   CurDeclSection := '';
 
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 50233da935..8cb0dfdc93 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -23,6 +23,61 @@ interface
 
 uses SysUtils, Classes, PasTree, PScanner;
 
+// message numbers
+const
+  nErrNoSourceGiven = 2001;
+  nErrMultipleSourceFiles = 2002;
+  nParserError = 2003;
+  nParserErrorAtToken = 2004;
+  nParserUngetTokenError = 2005;
+  nParserExpectTokenError = 2006;
+  nParserForwardNotInterface = 2007;
+  nParserExpectVisibility = 2008;
+  nParserStrangeVisibility = 2009;
+  nParserExpectToken2Error = 2010;
+  nParserExpectedCommaRBracket = 2011;
+  nParserExpectedCommaSemicolon = 2012;
+  nParserExpectedAssignIn = 2013;
+  nParserExpectedCommaColon = 2014;
+  nErrUnknownOperatorType = 2015;
+  nParserOnlyOneArgumentCanHaveDefault = 2016;
+  nParserExpectedLBracketColon = 2017;
+  nParserExpectedSemiColonEnd = 2018;
+  nParserExpectedConstVarID = 2019;
+  nParserExpectedNested = 2020;
+  nParserExpectedColonID = 2021;
+  nParserSyntaxError = 2022;
+  nParserTypeSyntaxError = 2023;
+  nParserArrayTypeSyntaxError = 2024;
+  nParserExpectedIdentifier = 2026;
+  nParserNotAProcToken = 2026;
+  nRangeExpressionExpected = 2027;
+  nParserExpectCase = 2028;
+  nParserHelperNotAllowed = 2029;
+  nLogStartImplementation = 2030;
+  nLogStartInterface = 2031;
+  nParserNoConstructorAllowed = 2032;
+  nParserNoFieldsAllowed = 2033;
+  nParserInvalidRecordVisibility = 2034;
+  nErrRecordConstantsNotAllowed = 2035;
+  nErrRecordMethodsNotAllowed = 2036;
+  nErrRecordPropertiesNotAllowed = 2037;
+  nErrRecordVisibilityNotAllowed = 2038;
+  nParserTypeNotAllowedHere = 2039;
+  nParserNotAnOperand = 2040;
+  nParserArrayPropertiesCannotHaveDefaultValue = 2041;
+  nParserDefaultPropertyMustBeArray = 2042;
+  nParserUnknownProcedureType = 2043;
+  nParserGenericArray1Element = 2044;
+  nParserGenericClassOrArray = 2045;
+  nParserDuplicateIdentifier = 2046;
+  nParserDefaultParameterRequiredFor = 2047;
+  nParserOnlyOneVariableCanBeInitialized = 2048;
+  nParserExpectedTypeButGot = 2049;
+  nParserPropertyArgumentsCanNotHaveDefaultValues = 2050;
+  nParserExpectedExternalClassName = 2051;
+
+// resourcestring patterns of messages
 resourcestring
   SErrNoSourceGiven = 'No source file specified';
   SErrMultipleSourceFiles = 'Please specify only one source file';
@@ -41,8 +96,6 @@ resourcestring
   SErrUnknownOperatorType = 'Unknown operator type: %s';
   SParserOnlyOneArgumentCanHaveDefault = 'A default value can only be assigned to 1 parameter';
   SParserExpectedLBracketColon = 'Expected "(" or ":"';
-  SParserExpectedLBracketSemicolon = 'Expected "(" or ";"';
-  SParserExpectedColonSemicolon = 'Expected ":" or ";"';
   SParserExpectedSemiColonEnd = 'Expected ";" or "End"';
   SParserExpectedConstVarID = 'Expected "const", "var" or identifier';
   SParserExpectedNested = 'Expected nested keyword';
@@ -50,9 +103,6 @@ resourcestring
   SParserSyntaxError = 'Syntax error';
   SParserTypeSyntaxError = 'Syntax error in type';
   SParserArrayTypeSyntaxError = 'Syntax error in array type';
-  SParserInterfaceTokenError = 'Invalid token in interface section of unit';
-  SParserImplementationTokenError = 'Invalid token in implementation section of unit';
-  SParserInvalidTypeDef = 'Invalid type definition';
   SParserExpectedIdentifier = 'Identifier expected';
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
@@ -60,7 +110,6 @@ resourcestring
   SParserHelperNotAllowed = 'Helper objects not allowed for "%s"';
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
-  SParsingUsedUnit = 'Parsing used unit "%s" with commandLine "%s"';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
   SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
@@ -68,8 +117,36 @@ resourcestring
   SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
   SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
   SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
+  SParserTypeNotAllowedHere = 'Type "%s" not allowed here';
+  SParserNotAnOperand = 'Not an operand: (%d : %s)';
+  SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value';
+  SParserDefaultPropertyMustBeArray = 'The default property must be an array property';
+  SParserUnknownProcedureType = 'Unknown procedure type "%d"';
+  SParserGenericArray1Element = 'Generic arrays can have only 1 template element';
+  SParserGenericClassOrArray = 'Generic can only be used with classes or arrays';
+  SParserDuplicateIdentifier = 'Duplicate identifier "%s"';
+  SParserDefaultParameterRequiredFor = 'Default parameter required for "%s"';
+  SParserOnlyOneVariableCanBeInitialized = 'Only one variable can be initialized';
+  SParserExpectedTypeButGot = 'Expected type, but got %s';
+  SParserPropertyArgumentsCanNotHaveDefaultValues = 'Property arguments can not have default values';
+  SParserExpectedExternalClassName = 'Expected external class name';
 
 type
+  TPasScopeType = (
+    stModule,  // e.g. unit, program, library
+    stUsesClause,
+    stTypeSection,
+    stTypeDef, // e.g. a TPasType
+    stConstDef, // e.g. a TPasConst
+    stProcedure, // also method, procedure, constructor, destructor, ...
+    stProcedureHeader,
+    stExceptOnExpr,
+    stExceptOnStatement,
+    stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
+    stAncestors // the list of ancestors and interfaces of a class
+    );
+  TPasScopeTypes = set of TPasScopeType;
+
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
   TPParserLogEvent = (pleInterface,pleImplementation);
   TPParserLogEvents = set of TPParserLogEvent;
@@ -87,6 +164,7 @@ type
   protected
     FPackage: TPasPackage;
     FInterfaceOnly : Boolean;
+    procedure SetCurrentParser(AValue: TPasParser); virtual;
   public
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; const ASourceFilename: String;
@@ -95,18 +173,23 @@ type
       AParent: TPasElement; AVisibility: TPasMemberVisibility;
       const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;overload;
       virtual; abstract;
+    function CreateElement(AClass: TPTreeElement; const AName: String;
+      AParent: TPasElement; AVisibility: TPasMemberVisibility;
+      const ASrcPos: TPasSourcePos): TPasElement; overload;
+      virtual;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
-      UseParentAsResultParent: Boolean; const ASourceFilename: String;
-      ASourceLinenumber: Integer): TPasFunctionType;
+      UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
+    procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     function FindModule(const AName: String): TPasModule; virtual;
+    function NeedArrayValues(El: TPasElement): boolean; virtual;
     property Package: TPasPackage read FPackage;
     property InterfaceOnly : Boolean Read FInterfaceOnly Write FInterFaceOnly;
-    Property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
-    Property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
-    Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
-    Property CurrentParser : TPasParser Read FCurrentParser;
-    Property NeedComments : Boolean Read FNeedComments Write FNeedComments;
+    property ScannerLogEvents : TPScannerLogEvents Read FScannerLogEvents Write FScannerLogEvents;
+    property ParserLogEvents : TPParserLogEvents Read FPParserLogEvents Write FPParserLogEvents;
+    property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
+    property CurrentParser : TPasParser Read FCurrentParser Write SetCurrentParser;
+    property NeedComments : Boolean Read FNeedComments Write FNeedComments;
   end;
 
   EParserError = class(Exception)
@@ -132,8 +215,24 @@ type
 
   TPasParser = class
   private
+    const FTokenRingSize = 32;
+    type
+      TTokenRec = record
+        Token: TToken;
+        AsString: String;
+        Comments: TStrings;
+        SourcePos: TPasSourcePos;
+      end;
+      PTokenRec = ^TTokenRec;
+  private
     FCurModule: TPasModule;
     FFileResolver: TBaseFileResolver;
+    FImplicitUses: TStrings;
+    FLastMsg: string;
+    FLastMsgArgs: TMessageArgs;
+    FLastMsgNumber: integer;
+    FLastMsgPattern: string;
+    FLastMsgType: TMessageType;
     FLogEvents: TPParserLogEvents;
     FOnLog: TPasParserLogHandler;
     FOptions: TPOptions;
@@ -141,21 +240,22 @@ type
     FEngine: TPasTreeContainer;
     FCurToken: TToken;
     FCurTokenString: String;
-    FCurComments : TStrings;
     FSavedComments : String;
     // UngetToken support:
-    FTokenBuffer: array[0..1] of TToken;
-    FTokenStringBuffer: array[0..1] of String;
-    FCommentsBuffer: array[0..1] of TStrings;
-    FTokenBufferIndex: Integer; // current index in FTokenBuffer
-    FTokenBufferSize: Integer; // maximum valid index in FTokenBuffer
+    FTokenRing: array[0..FTokenRingSize-1] of TTokenRec;
+    FTokenRingCur: Integer; // index of current token in FTokenBuffer
+    FTokenRingStart: Integer; // first valid ring index in FTokenBuffer, if FTokenRingStart=FTokenRingEnd the ring is empty
+    FTokenRingEnd: Integer; // first invalid ring index in FTokenBuffer
     FDumpIndent : String;
     function CheckOverloadList(AList: TFPList; AName: String; out OldMember: TPasElement): TPasOverloadedProc;
+    function DoCheckHint(Element: TPasElement): Boolean;
     procedure DumpCurToken(Const Msg : String; IndentAction : TIndentAction = iaNone);
-    function GetVariableModifiers(Out VarMods : TVariableModifiers; Out Libname,ExportName : string): string;
+    function GetCurrentModeSwitches: TModeSwitches;
+    Procedure SetCurrentModeSwitches(AValue: TModeSwitches);
+    function GetVariableModifiers(Parent: TPasElement; Out VarMods: TVariableModifiers; Out LibName, ExportName: TPasExpr; ExternalClass : Boolean): string;
     function GetVariableValueAndLocation(Parent : TPasElement; Out Value : TPasExpr; Out Location: String): Boolean;
     procedure HandleProcedureModifier(Parent: TPasElement; pm : TProcedureModifier);
-    procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
+    procedure HandleProcedureTypeModifier(ProcType: TPasProcedureType; ptm : TProcTypeModifier);
     procedure ParseClassLocalConsts(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseClassLocalTypes(AType: TPasClassType; AVisibility: TPasMemberVisibility);
     procedure ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full: Boolean);
@@ -164,9 +264,10 @@ type
     Function SaveComments : String;
     Function SaveComments(Const AValue : String) : String;
     function LogEvent(E : TPParserLogEvent) : Boolean; inline;
-    Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
-    Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
     function GetProcTypeFromToken(tk: TToken; IsClass: Boolean=False ): TProcType;
+    procedure ParseAsmBlock(AsmBlock: TPasImplAsmStatement); virtual;
     procedure ParseRecordFieldList(ARec: TPasRecordType; AEndToken: TToken; AllowMethods : Boolean);
     procedure ParseRecordVariantParts(ARec: TPasRecordType; AEndToken: TToken);
     function GetProcedureClass(ProcType : TProcType): TPTreeElement;
@@ -174,64 +275,104 @@ type
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
-    function CheckProcedureArgs(Parent: TPasElement; Args: TFPList; Mandatory: Boolean): boolean;
+    procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
+    function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
+    function CheckProcedureArgs(Parent: TPasElement;
+      Args: TFPList; // list of TPasArgument
+      Mandatory: Boolean): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
-    procedure ParseExc(const Msg: String);
-    procedure ParseExc(const Fmt: String; Args : Array of const);
+    procedure ParseExc(MsgNumber: integer; const Msg: String);
+    procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of const);
+    procedure ParseExcExpectedIdentifier;
+    procedure ParseExcSyntaxError;
+    procedure ParseExcTokenError(const Arg: string);
     function OpLevel(t: TToken): Integer;
     Function TokenToExprOp (AToken : TToken) : TExprOpCode;
     function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement): TPasElement;overload;
+    function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; const ASrcPos: TPasSourcePos): TPasElement;overload;
     function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;overload;
+    function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility; const ASrcPos: TPasSourcePos): TPasElement;overload;
+    function CreatePrimitiveExpr(AParent: TPasElement; AKind: TPasExprKind; const AValue: String): TPrimitiveExpr;
+    function CreateBoolConstExpr(AParent: TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean): TBoolConstExpr;
+    function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr;
+    procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
+      Element: TPasExpr; AOpCode: TExprOpCode);
+    procedure AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
+      Params: TParamsExpr);
+    {$IFDEF VerbosePasParser}
+    procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
+    {$ENDIF}
+    function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr;
+    function CreateArrayValues(AParent : TPasElement): TArrayValues;
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
-             UseParentAsResultParent: Boolean): TPasFunctionType;
+             UseParentAsResultParent: Boolean; const NamePos: TPasSourcePos): TPasFunctionType;
+    function CreateInheritedExpr(AParent : TPasElement): TInheritedExpr;
+    function CreateSelfExpr(AParent : TPasElement): TSelfExpr;
+    function CreateNilExpr(AParent : TPasElement): TNilExpr;
+    function CreateRecordValues(AParent : TPasElement): TRecordValues;
     Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
     Function IsCurTokenHint: Boolean; overload;
-    Function TokenIsCallingConvention(S : String; out CC : TCallingConvention) : Boolean; virtual;
-    Function TokenIsProcedureModifier(Parent : TPasElement; S : String; Out Pm : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsCallingConvention(const S : String; out CC : TCallingConvention) : Boolean; virtual;
+    Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
-    function ParseParams(AParent : TPasElement;paramskind: TPasExprKind): TParamsExpr;
+    function ParseParams(AParent : TPasElement;paramskind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr;
     procedure DoParseClassType(AType: TPasClassType);
-    function DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr=nil): TPasExpr;
-    function DoParseConstValueExpression(AParent : TPasElement): TPasExpr;
+    function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
+    function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
     function CheckPackMode: TPackMode;
+    function AddUseUnit(ASection: TPasSection; const NamePos: TPasSourcePos;
+      AUnitName : string; NameExpr: TPasExpr; InFileExpr: TPrimitiveExpr): TPasElement;
+    procedure CheckImplicitUsedUnits(ASection: TPasSection);
     // Overload handling
     procedure AddProcOrFunction(Decs: TPasDeclarations; AProc: TPasProcedure);
     function  CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement;
   public
     constructor Create(AScanner: TPascalScanner; AFileResolver: TBaseFileResolver;  AEngine: TPasTreeContainer);
     Destructor Destroy; override;
+    procedure SetLastMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const);
     // General parsing routines
     function CurTokenName: String;
     function CurTokenText: String;
     Function CurComments : TStrings;
+    function CurSourcePos: TPasSourcePos;
+    function HasToken: boolean;
     Function SavedComments : String;
     procedure NextToken; // read next non whitespace, non space
+    procedure ChangeToken(tk: TToken);
     procedure UngetToken;
     procedure CheckToken(tk: TToken);
+    procedure CheckTokens(tk: TTokens);
     procedure ExpectToken(tk: TToken);
+    procedure ExpectTokens(tk:  TTokens);
     function ExpectIdentifier: String;
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
     // Expression parsing
-    function isEndOfExp: Boolean;
+    function isEndOfExp(AllowEqual : Boolean = False; CheckHints : Boolean = True): Boolean;
+    function ExprToText(Expr: TPasExpr): String;
+    function ArrayExprToText(Expr: TPasExprArray): String;
     // Type declarations
+    function ResolveTypeReference(Name: string; Parent: TPasElement): TPasType;
     function ParseComplexType(Parent : TPasElement = Nil): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
-    function ParseType(Parent: TPasElement; Const TypeName : String = '';Full : Boolean = False): TPasType;
-    function ParseProcedureType(Parent: TPasElement; const TypeName: String; const PT: TProcType): TPasProcedureType;
-    function ParseStringType(Parent: TPasElement; const TypeName: String): TPasAliasType;
-    function ParseSimpleType(Parent: TPasElement; Const TypeName: String; IsFull : Boolean = False): TPasType;
-    function ParseAliasType(Parent: TPasElement; Const TypeName: String): TPasTypeAliasType;
-    function ParsePointerType(Parent: TPasElement; Const TypeName: String): TPasPointerType;
-    Function ParseArrayType(Parent : TPasElement; Const TypeName : String; PackMode : TPackMode) : TPasArrayType;
-    Function ParseFileType(Parent : TPasElement; Const TypeName  : String) : TPasFileType;
-    Function ParseRecordDecl(Parent: TPasElement; Const TypeName : string; const Packmode : TPackMode = pmNone) : TPasRecordType;
-    function ParseEnumType(Parent: TPasElement; const TypeName: String): TPasEnumType;
-    function ParseSetType(Parent: TPasElement; const TypeName: String ): TPasSetType;
-    function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasClassType;
-    Function ParseClassDecl(Parent: TPasElement; const AClassName: String;   AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
-    Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility) : TPasProperty;
-    function ParseRangeType(AParent: TPasElement; Const TypeName: String; Full : Boolean = True): TPasRangeType;
+    function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs: TFPList = nil): TPasType;
+    function ParseReferenceToProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasProcedureType;
+    function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType;
+    function ParseStringType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasAliasType;
+    function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
+    function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasTypeAliasType;
+    function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType;
+    function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType;
+    Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType;
+    Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName  : String) : TPasFileType;
+    Function ParseRecordDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName : string; const Packmode : TPackMode = pmNone) : TPasRecordType;
+    function ParseEnumType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
+    function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
+    function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasSpecializeType;
+    Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone; GenericArgs: TFPList = nil): TPasType;
+    Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility; IsClassField: boolean) : TPasProperty;
+    function ParseRangeType(AParent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; Full: Boolean = True): TPasRangeType;
     procedure ParseExportDecl(Parent: TPasElement; List: TFPList);
     // Constant declarations
     function ParseConstDecl(Parent: TPasElement): TPasConst;
@@ -244,6 +385,7 @@ type
     procedure ParseUnit(var Module: TPasModule);
     procedure ParseProgram(var Module: TPasModule; SkipHeader : Boolean = False);
     procedure ParseLibrary(var Module: TPasModule);
+    procedure ParseOptionalUsesList(ASection: TPasSection);
     procedure ParseUsesList(ASection: TPasSection);
     procedure ParseInterface;
     procedure ParseImplementation;
@@ -253,9 +395,12 @@ type
     procedure ParseStatement(Parent: TPasImplBlock;  out NewImplElement: TPasImplElement);
     procedure ParseLabels(AParent: TPasElement);
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
+    procedure ParseProcAsmBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
     function  ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
-    procedure ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
+    procedure ParseArgList(Parent: TPasElement;
+      Args: TFPList; // list of TPasArgument
+      EndToken: TToken);
     procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureBody(Parent: TPasElement);
     // Properties for external access
@@ -265,16 +410,32 @@ type
     property CurToken: TToken read FCurToken;
     property CurTokenString: String read FCurTokenString;
     Property Options : TPOptions Read FOptions Write SetOptions;
+    Property CurrentModeswitches : TModeSwitches Read GetCurrentModeSwitches Write SetCurrentModeSwitches;
     Property CurModule : TPasModule Read FCurModule;
     Property LogEvents : TPParserLogEvents Read FLogEvents Write FLogEvents;
     Property OnLog : TPasParserLogHandler Read FOnLog Write FOnLog;
+    property ImplicitUses: TStrings read FImplicitUses;
+    property LastMsg: string read FLastMsg write FLastMsg;
+    property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
+    property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
+    property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
+    property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
   end;
 
+Type
+  TParseSourceOption = (poUseStreams,poSkipDefaultDefs);
+  TParseSourceOptions = set of TParseSourceOption;
+function ParseSource(AEngine: TPasTreeContainer;
+                     const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+function ParseSource(AEngine: TPasTreeContainer;
+                     const FPCCommandLine, OSTarget, CPUTarget: String;
+                     UseStreams  : Boolean): TPasModule; deprecated;
 function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String;
-                     UseStreams  : Boolean = False): TPasModule;
+                     Options : TParseSourceOptions): TPasModule;
+                     
 Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
-Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean;
+Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
 Function TokenToAssignKind( tk : TToken) : TAssignKind;
 
@@ -332,9 +493,7 @@ begin
     end;
 end;
 
-
-Function IsModifier(S : String; Out Pm : TProcedureModifier) : Boolean;
-
+Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 
 Var
   P : TProcedureModifier;
@@ -368,8 +527,25 @@ begin
 end;
 
 function ParseSource(AEngine: TPasTreeContainer;
+  const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
+
+begin
+  Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[]);
+end;
+
+function ParseSource(AEngine: TPasTreeContainer;
+  const FPCCommandLine, OSTarget, CPUTarget: String; UseStreams : Boolean): TPasModule;
+
+begin
+  if UseStreams then
+    Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[poUseStreams])
+  else
+    Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[]);
+end;
+
+function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String;
-  UseStreams  : Boolean = False): TPasModule;
+  Options : TParseSourceOptions): TPasModule;
 var
   FileResolver: TFileResolver;
   Parser: TPasParser;
@@ -393,6 +569,8 @@ var
       case s[2] of
         'd': // -d define
           Scanner.AddDefine(UpperCase(Copy(s, 3, Length(s))));
+        'u': // -u undefine
+          Scanner.RemoveDefine(UpperCase(Copy(s, 3, Length(s))));
         'F': // -F
           if (length(s)>2) and (s[3] = 'i') then // -Fi include path
             FileResolver.AddIncludePath(Copy(s, 4, Length(s)));
@@ -400,10 +578,24 @@ var
           FileResolver.AddIncludePath(Copy(s, 3, Length(s)));
         'S': // -S mode
           if  (length(s)>2) then
-            case S[3] of
-              'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
-              'd','2' : Parser.Options:=Parser.Options+[po_delphi];
+            begin
+            l:=3;
+            While L<=Length(S) do
+              begin
+              case S[l] of
+                'c' : Scanner.Options:=Scanner.Options+[po_cassignments];
+                'd' : Scanner.SetCompilerMode('DELPHI');
+                '2' : Scanner.SetCompilerMode('OBJFPC');
+                'h' : ; // do nothing
+              end;
+              inc(l);
+              end;
             end;
+        'M' :
+           begin
+           delete(S,1,2);
+           Scanner.SetCompilerMode(S);
+           end;
       end;
     end else
       if Filename <> '' then
@@ -421,51 +613,52 @@ begin
   Parser := nil;
   try
     FileResolver := TFileResolver.Create;
-    FileResolver.UseStreams:=UseStreams;
+    FileResolver.UseStreams:=poUseStreams in Options;
     Scanner := TPascalScanner.Create(FileResolver);
-    Scanner.AddDefine('FPK');
-    Scanner.AddDefine('FPC');
     SCanner.LogEvents:=AEngine.ScannerLogEvents;
     SCanner.OnLog:=AEngine.Onlog;
-
-    // TargetOS
-    s := UpperCase(OSTarget);
-    Scanner.AddDefine(s);
-    if s = 'LINUX' then
-      Scanner.AddDefine('UNIX')
-    else if s = 'FREEBSD' then
-    begin
-      Scanner.AddDefine('BSD');
-      Scanner.AddDefine('UNIX');
-    end else if s = 'NETBSD' then
-    begin
-      Scanner.AddDefine('BSD');
-      Scanner.AddDefine('UNIX');
-    end else if s = 'SUNOS' then
-    begin
-      Scanner.AddDefine('SOLARIS');
-      Scanner.AddDefine('UNIX');
-    end else if s = 'GO32V2' then
-      Scanner.AddDefine('DPMI')
-    else if s = 'BEOS' then
-      Scanner.AddDefine('UNIX')
-    else if s = 'QNX' then
-      Scanner.AddDefine('UNIX')
-    else if s = 'AROS' then
-      Scanner.AddDefine('HASAMIGA')
-    else if s = 'MORPHOS' then
-      Scanner.AddDefine('HASAMIGA')
-    else if s = 'AMIGA' then
-      Scanner.AddDefine('HASAMIGA');
-
-    // TargetCPU
-    s := UpperCase(CPUTarget);
-    Scanner.AddDefine('CPU'+s);
-    if (s='x86_64') then
-      Scanner.AddDefine('CPU64')
-    else
-      Scanner.AddDefine('CPU32');
-
+    if not (poSkipDefaultDefs in Options) then
+      begin
+      Scanner.AddDefine('FPK');
+      Scanner.AddDefine('FPC');
+      // TargetOS
+      s := UpperCase(OSTarget);
+      Scanner.AddDefine(s);
+      if s = 'LINUX' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'FREEBSD' then
+      begin
+        Scanner.AddDefine('BSD');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'NETBSD' then
+      begin
+        Scanner.AddDefine('BSD');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'SUNOS' then
+      begin
+        Scanner.AddDefine('SOLARIS');
+        Scanner.AddDefine('UNIX');
+      end else if s = 'GO32V2' then
+        Scanner.AddDefine('DPMI')
+      else if s = 'BEOS' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'QNX' then
+        Scanner.AddDefine('UNIX')
+      else if s = 'AROS' then
+        Scanner.AddDefine('HASAMIGA')
+      else if s = 'MORPHOS' then
+        Scanner.AddDefine('HASAMIGA')
+      else if s = 'AMIGA' then
+        Scanner.AddDefine('HASAMIGA');
+
+      // TargetCPU
+      s := UpperCase(CPUTarget);
+      Scanner.AddDefine('CPU'+s);
+      if (s='X86_64') then
+        Scanner.AddDefine('CPU64')
+      else
+        Scanner.AddDefine('CPU32');
+      end;
     Parser := TPasParser.Create(Scanner, FileResolver, AEngine);
     Filename := '';
     Parser.LogEvents:=AEngine.ParserLogEvents;
@@ -503,6 +696,12 @@ end;
   TPasTreeContainer
   ---------------------------------------------------------------------}
 
+procedure TPasTreeContainer.SetCurrentParser(AValue: TPasParser);
+begin
+  if FCurrentParser=AValue then Exit;
+  FCurrentParser:=AValue;
+end;
+
 function TPasTreeContainer.CreateElement(AClass: TPTreeElement;
   const AName: String; AParent: TPasElement; const ASourceFilename: String;
   ASourceLinenumber: Integer): TPasElement;
@@ -511,14 +710,22 @@ begin
     ASourceLinenumber);
 end;
 
+function TPasTreeContainer.CreateElement(AClass: TPTreeElement;
+  const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASrcPos: TPasSourcePos): TPasElement;
+begin
+  Result := CreateElement(AClass, AName, AParent, AVisibility, ASrcPos.FileName,
+    ASrcPos.Row);
+end;
+
 function TPasTreeContainer.CreateFunctionType(const AName, AResultName: String;
   AParent: TPasElement; UseParentAsResultParent: Boolean;
-  const ASourceFilename: String; ASourceLinenumber: Integer): TPasFunctionType;
+  const ASrcPos: TPasSourcePos): TPasFunctionType;
 var
   ResultParent: TPasElement;
 begin
   Result := TPasFunctionType(CreateElement(TPasFunctionType, AName, AParent,
-    ASourceFilename, ASourceLinenumber));
+    visDefault, ASrcPos));
 
   if UseParentAsResultParent then
     ResultParent := AParent
@@ -527,14 +734,28 @@ begin
 
   TPasFunctionType(Result).ResultEl :=
     TPasResultElement(CreateElement(TPasResultElement, AResultName, ResultParent,
-    ASourceFilename, ASourceLinenumber));
+    visDefault, ASrcPos));
+end;
+
+procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType;
+  El: TPasElement);
+begin
+  if ScopeType=stModule then ;
+  if El=nil then ;
 end;
 
 function TPasTreeContainer.FindModule(const AName: String): TPasModule;
 begin
+  if AName='' then ;
   Result := nil;
 end;
 
+function TPasTreeContainer.NeedArrayValues(El: TPasElement): boolean;
+begin
+  Result:=false;
+  if El=nil then ;
+end;
+
 { ---------------------------------------------------------------------
   EParserError
   ---------------------------------------------------------------------}
@@ -552,16 +773,37 @@ end;
   TPasParser
   ---------------------------------------------------------------------}
 
-procedure TPasParser.ParseExc(const Msg: String);
+procedure TPasParser.ParseExc(MsgNumber: integer; const Msg: String);
 begin
-  raise EParserError.Create(Format(SParserErrorAtToken, [Msg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
+  ParseExc(MsgNumber,Msg,[]);
+end;
+
+procedure TPasParser.ParseExc(MsgNumber: integer; const Fmt: String;
+  Args: array of const);
+begin
+  {$IFDEF VerbosePasParser}
+  writeln('TPasParser.ParseExc Token="',CurTokenText,'"');
+  {$ENDIF}
+  SetLastMsg(mtError,MsgNumber,Fmt,Args);
+  raise EParserError.Create(SafeFormat(SParserErrorAtToken,
+    [FLastMsg, CurTokenName, Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn])
     {$ifdef addlocation}+' ('+inttostr(scanner.currow)+' '+inttostr(scanner.curcolumn)+')'{$endif},
     Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
 end;
 
-procedure TPasParser.ParseExc(const Fmt: String; Args: array of const);
+procedure TPasParser.ParseExcExpectedIdentifier;
+begin
+  ParseExc(nParserExpectedIdentifier,SParserExpectedIdentifier);
+end;
+
+procedure TPasParser.ParseExcSyntaxError;
+begin
+  ParseExc(nParserSyntaxError,SParserSyntaxError);
+end;
+
+procedure TPasParser.ParseExcTokenError(const Arg: string);
 begin
-  ParseExc(Format(Fmt,Args));
+  ParseExc(nParserExpectTokenError,SParserExpectTokenError,[Arg]);
 end;
 
 constructor TPasParser.Create(AScanner: TPascalScanner;
@@ -570,23 +812,30 @@ begin
   inherited Create;
   FScanner := AScanner;
   FFileResolver := AFileResolver;
+  FTokenRingCur:=High(FTokenRing);
   FEngine := AEngine;
-  FCommentsBuffer[0]:=TStringList.Create;
-  FCommentsBuffer[1]:=TStringList.Create;
   if Assigned(FEngine) then
     begin
-    FEngine.FCurrentParser:=Self;
+    FEngine.CurrentParser:=Self;
     If FEngine.NeedComments then
       FScanner.SkipComments:=Not FEngine.NeedComments;
     end;
+  FImplicitUses := TStringList.Create;
+  FImplicitUses.Add('System'); // system always implicitely first.
 end;
 
 destructor TPasParser.Destroy;
+var
+  i: Integer;
 begin
-  FreeAndNil(FCommentsBuffer[0]);
-  FreeAndNil(FCommentsBuffer[1]);
   if Assigned(FEngine) then
-    FEngine.FCurrentParser:=Nil;
+    begin
+    FEngine.CurrentParser:=Nil;
+    FEngine:=nil;
+    end;
+  FreeAndNil(FImplicitUses);
+  for i:=low(FTokenRing) to high(FTokenRing) do
+    FreeAndNil(FTokenRing[i].Comments);
   inherited Destroy;
 end;
 
@@ -610,7 +859,31 @@ end;
 
 function TPasParser.CurComments: TStrings;
 begin
-  Result:=FCurComments;
+  if FTokenRingStart=FTokenRingEnd then
+    Result:=nil
+  else
+    Result:=FTokenRing[FTokenRingCur].Comments;
+end;
+
+function TPasParser.CurSourcePos: TPasSourcePos;
+begin
+  if HasToken then
+    Result:=FTokenRing[FTokenRingCur].SourcePos
+  else
+    begin
+    if Scanner<>nil then
+      Result:=Scanner.CurSourcePos
+    else
+      Result:=Default(TPasSourcePos);
+    end;
+end;
+
+function TPasParser.HasToken: boolean;
+begin
+  if FTokenRingStart<FTokenRingEnd then
+    Result:=(FTokenRingCur>=FTokenRingStart) and (FTokenRingCur<FTokenRingEnd)
+  else
+    Result:=(FTokenRingCur>=FTokenRingStart) or (FTokenRingCur<FTokenRingEnd);
 end;
 
 function TPasParser.SavedComments: String;
@@ -621,78 +894,140 @@ end;
 procedure TPasParser.NextToken;
 
 Var
-  T : TStrings;
+  P: PTokenRec;
 begin
-  if FTokenBufferIndex < FTokenBufferSize then
-  begin
+  FTokenRingCur:=(FTokenRingCur+1) mod FTokenRingSize;
+  P:=@FTokenRing[FTokenRingCur];
+  if FTokenRingCur <> FTokenRingEnd then
+    begin
     // Get token from buffer
-    FCurToken := FTokenBuffer[FTokenBufferIndex];
-    FCurTokenString := FTokenStringBuffer[FTokenBufferIndex];
-    FCurComments:=FCommentsBuffer[FTokenBufferIndex];
-    Inc(FTokenBufferIndex);
-    //writeln('TPasParser.NextToken From Buf ',CurTokenText,' id=',FTokenBufferIndex);
-  end else
-  begin
-    { We have to fetch a new token. But first check, wether there is space left
-      in the token buffer.}
-    if FTokenBufferSize = 2 then
-      begin
-      FTokenBuffer[0] := FTokenBuffer[1];
-      FTokenStringBuffer[0] := FTokenStringBuffer[1];
-      T:=FCommentsBuffer[0];
-      FCommentsBuffer[0]:=FCommentsBuffer[1];
-      FCommentsBuffer[1]:=T;
-      Dec(FTokenBufferSize);
-      Dec(FTokenBufferIndex);
-      end;
+    //writeln('TPasParser.NextToken REUSE Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
+    FCurToken := P^.Token;
+    FCurTokenString := P^.AsString;
+    end
+  else
+    begin
     // Fetch new token
+    //writeln('TPasParser.NextToken FETCH Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
+    FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
+    if FTokenRingStart=FTokenRingEnd then
+      FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
     try
-      FCommentsBuffer[FTokenBufferSize].Clear;
+      if p^.Comments=nil then
+        p^.Comments:=TStringList.Create
+      else
+        p^.Comments.Clear;
       repeat
         FCurToken := Scanner.FetchToken;
         if FCurToken=tkComment then
-          FCommentsBuffer[FTokenBufferSize].Add(Scanner.CurTokenString);
+          p^.Comments.Add(Scanner.CurTokenString);
       until not (FCurToken in WhitespaceTokensToIgnore);
     except
       on e: EScannerError do
-        raise EParserError.Create(e.Message,
-          Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+        begin
+        if po_KeepScannerError in Options then
+          raise
+        else
+          begin
+          FLastMsgType := mtError;
+          FLastMsgNumber := Scanner.LastMsgNumber;
+          FLastMsgPattern := Scanner.LastMsgPattern;
+          FLastMsg := Scanner.LastMsg;
+          FLastMsgArgs := Scanner.LastMsgArgs;
+          raise EParserError.Create(e.Message,
+            Scanner.CurFilename, Scanner.CurRow, Scanner.CurColumn);
+          end;
+        end;
     end;
+    p^.Token:=FCurToken;
     FCurTokenString := Scanner.CurTokenString;
-    FTokenBuffer[FTokenBufferSize] := FCurToken;
-    FTokenStringBuffer[FTokenBufferSize] := FCurTokenString;
-    FCurComments:=FCommentsBuffer[FTokenBufferSize];
-    Inc(FTokenBufferSize);
-    Inc(FTokenBufferIndex);
-  //  writeln('TPasParser.NextToken New ',CurTokenText,' id=',FTokenBufferIndex,' comments = ',FCurComments.text);
-  end;
+    p^.AsString:=FCurTokenString;
+    p^.SourcePos:=Scanner.CurSourcePos;
+    end;
+  //writeln('TPasParser.NextToken END Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
+end;
+
+procedure TPasParser.ChangeToken(tk: TToken);
+var
+  Cur, Last: PTokenRec;
+  IsLast: Boolean;
+begin
+  //writeln('TPasParser.ChangeToken FTokenBufferSize=',FTokenRingStart,' FTokenBufferIndex=',FTokenRingCur);
+  IsLast:=((FTokenRingCur+1) mod FTokenRingSize)=FTokenRingEnd;
+  if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+    begin
+    // change last token '>>' into two '>'
+    Cur:=@FTokenRing[FTokenRingCur];
+    Cur^.Token:=tkGreaterThan;
+    Cur^.AsString:='>';
+    Last:=@FTokenRing[FTokenRingEnd];
+    Last^.Token:=tkGreaterThan;
+    Last^.AsString:='>';
+    if Last^.Comments<>nil then
+      Last^.Comments.Clear;
+    Last^.SourcePos:=Cur^.SourcePos;
+    inc(Last^.SourcePos.Column);
+    FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
+    if FTokenRingStart=FTokenRingEnd then
+      FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
+    FCurToken:=tkGreaterThan;
+    FCurTokenString:='>';
+    end
+  else
+    CheckToken(tk);
 end;
 
 procedure TPasParser.UngetToken;
 
+var
+  P: PTokenRec;
 begin
-  if FTokenBufferIndex = 0 then
-    ParseExc(SParserUngetTokenError)
-  else begin
-    Dec(FTokenBufferIndex);
-    if FTokenBufferIndex>0 then
-    begin
-      FCurToken := FTokenBuffer[FTokenBufferIndex-1];
-      FCurTokenString := FTokenStringBuffer[FTokenBufferIndex-1];
-      FCurComments:=FCommentsBuffer[FTokenBufferIndex-1];
-    end else begin
-      FCurToken := tkWhitespace;
-      FCurTokenString := '';
-      FCurComments.Clear;
-    end;
-    //writeln('TPasParser.UngetToken ',CurTokenText,' id=',FTokenBufferIndex);
-  end;
+  //writeln('TPasParser.UngetToken START Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
+  if FTokenRingStart = FTokenRingEnd then
+    ParseExc(nParserUngetTokenError,SParserUngetTokenError);
+  if FTokenRingCur>0 then
+    dec(FTokenRingCur)
+  else
+    FTokenRingCur:=High(FTokenRing);
+  P:=@FTokenRing[FTokenRingCur];
+  FCurToken := P^.Token;
+  FCurTokenString := P^.AsString;
+  //writeln('TPasParser.UngetToken END Start=',FTokenRingStart,' Cur=',FTokenRingCur,' End=',FTokenRingEnd,' Cur=',CurTokenString);
 end;
 
 procedure TPasParser.CheckToken(tk: TToken);
 begin
   if (CurToken<>tk) then
-    ParseExc(Format(SParserExpectTokenError, [TokenInfos[tk]]));
+    begin
+    {$IFDEF VerbosePasParser}
+    writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
+    {$ENDIF}
+    ParseExcTokenError(TokenInfos[tk]);
+    end;
+end;
+
+procedure TPasParser.CheckTokens(tk: TTokens);
+
+Var
+  S : String;
+  T : TToken;
+begin
+  if not (CurToken in tk) then
+    begin
+    {$IFDEF VerbosePasParser}
+    writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken);
+    {$ENDIF}
+    S:='';
+    For T in TToken do
+      if t in tk then
+        begin
+        if (S<>'') then
+          S:=S+' or ';
+        S:=S+TokenInfos[t];
+        end;
+    ParseExcTokenError(S);
+    end;
+
 end;
 
 
@@ -702,6 +1037,12 @@ begin
   CheckToken(tk);
 end;
 
+procedure TPasParser.ExpectTokens(tk: TTokens);
+begin
+  NextToken;
+  CheckTokens(tk);
+end;
+
 function TPasParser.ExpectIdentifier: String;
 begin
   ExpectToken(tkIdentifier);
@@ -710,7 +1051,7 @@ end;
 
 function TPasParser.CurTokenIsIdentifier(const S: String): Boolean;
 begin
-  Result:=(Curtoken=tkidentifier) and (CompareText(S,CurtokenText)=0);
+  Result:=(Curtoken=tkIdentifier) and (CompareText(S,CurtokenText)=0);
 end;
 
 
@@ -730,24 +1071,41 @@ begin
   Result:=IsCurTokenHint(dummy);
 end;
 
-function TPasParser.TokenIsCallingConvention(S: String; out
+function TPasParser.TokenIsCallingConvention(const S: String; out
   CC: TCallingConvention): Boolean;
 begin
   Result:=IsCallingConvention(S,CC);
 end;
 
-function TPasParser.TokenIsProcedureModifier(Parent: TPasElement; S: String;
-  out Pm: TProcedureModifier): Boolean;
+function TPasParser.TokenIsProcedureModifier(Parent: TPasElement;
+  const S: String; out PM: TProcedureModifier): Boolean;
 begin
-  Result:=IsModifier(S,PM);
-  if result and (pm in [pmPublic,pmForward]) then
+  Result:=IsProcModifier(S,PM);
+  if Result and (PM in [pmPublic,pmForward]) then
     begin
     While (Parent<>Nil) and Not ((Parent is TPasClassType) or (Parent is TPasRecordType)) do
-     Parent:=Parent.Parent;
+      Parent:=Parent.Parent;
     Result:=Not Assigned(Parent);
     end;
 end;
 
+function TPasParser.TokenIsProcedureTypeModifier(Parent: TPasElement;
+  const S: String; out PTM: TProcTypeModifier): Boolean;
+begin
+  if CompareText(S,ProcTypeModifiers[ptmVarargs])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmVarargs;
+    end
+  else if CompareText(S,ProcTypeModifiers[ptmStatic])=0 then
+    begin
+    Result:=true;
+    PTM:=ptmStatic;
+    end
+  else
+   Result:=false;
+  if Parent=nil then;
+end;
 
 function TPasParser.CheckHint(Element: TPasElement; ExpectSemiColon: Boolean
   ): TPasMemberHints;
@@ -755,7 +1113,7 @@ function TPasParser.CheckHint(Element: TPasElement; ExpectSemiColon: Boolean
 Var
   Found : Boolean;
   h : TPasMemberHint;
-  
+
 begin
   Result:=[];
   Repeat
@@ -769,7 +1127,7 @@ begin
         NextToken;
         if (Curtoken<>tkString) then
           UnGetToken
-        else
+        else if assigned(Element) then
           Element.HintMessage:=CurTokenString;
         end;
       end;
@@ -794,8 +1152,8 @@ begin
   if (Result<>pmNone) then
      begin
      NextToken;
-     if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass]) then
-       ParseExc(Format(SParserExpectTokenError,['ARRAY, RECORD, OBJECT or CLASS']))
+     if Not (CurToken in [tkArray, tkRecord, tkObject, tkClass, tkSet]) then
+       ParseExcTokenError('SET, ARRAY, RECORD, OBJECT or CLASS');
      end;
 end;
 
@@ -824,146 +1182,257 @@ begin
     AName:=SimpleTypeCaseNames[I];
 end;
 
-function TPasParser.ParseStringType(Parent: TPasElement; const TypeName: String
-  ): TPasAliasType;
+function TPasParser.ParseStringType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String): TPasAliasType;
 
 Var
-  S : String;
+  LengthAsText : String;
+  ok: Boolean;
+  Params: TParamsExpr;
+  LengthExpr: TPasExpr;
 
 begin
-  Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent));
+  Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent, NamePos));
+  ok:=false;
   try
     If (Result.Name='') then
       Result.Name:='string';
+    Result.Expr:=CreatePrimitiveExpr(Result,pekIdent,TypeName);
     NextToken;
+    LengthAsText:='';
     if CurToken=tkSquaredBraceOpen then
       begin
-      S:='';
+      Params:=TParamsExpr(CreateElement(TParamsExpr,'',Result));
+      Params.Value:=Result.Expr;
+      Result.Expr:=Params;
+      LengthAsText:='';
       NextToken;
-      While Not (Curtoken in [tkSquaredBraceClose,tkEOF]) do
-        begin
-        S:=S+CurTokenString;
-        NextToken;
-        end;
+      LengthExpr:=DoParseExpression(Result,nil,false);
+      Params.AddParam(LengthExpr);
+      CheckToken(tkSquaredBraceClose);
+      LengthAsText:=ExprToText(LengthExpr);
       end
     else
       UngetToken;
-    Result.DestType:=TPasStringType(CreateElement(TPasStringType,'string',Nil));
-    TPasStringType(Result.DestType).LengthExpr:=S;
-  except
-    FreeAndNil(Result);
-    Raise;
+    Result.DestType:=TPasStringType(CreateElement(TPasStringType,'string',Parent));
+    TPasStringType(Result.DestType).LengthExpr:=LengthAsText;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
 end;
 
 function TPasParser.ParseSimpleType(Parent: TPasElement;
-  const TypeName: String; IsFull: Boolean): TPasType;
+  const NamePos: TPasSourcePos; const TypeName: String; IsFull: Boolean
+  ): TPasType;
 
 Type
-  TSimpleTypeKind = (stkAlias,stkString,stkRange);
+  TSimpleTypeKind = (stkAlias,stkString,stkRange,stkSpecialize);
 
 Var
-  Ref: TPasElement;
+  Ref: TPasType;
   K : TSimpleTypeKind;
   Name : String;
-  SS : Boolean;
+  ST : TPasSpecializeType;
+  Expr: TPasExpr;
+
 begin
+  Result:=nil;
   Name := CurTokenString;
-  NextToken;
-  while CurToken=tkDot do
-    begin
-    ExpectIdentifier;
-    Name := Name+'.'+CurTokenString;
+  Expr:=nil;
+  Ref:=nil;
+  ST:=nil;
+  try
+    if IsFull then
+      Expr:=CreatePrimitiveExpr(Parent,pekIdent,Name);
     NextToken;
-    end;
-  // Current token is first token after identifier.
-  if IsFull then
-    begin
-    if (CurToken=tkSemicolon) or isCurTokenHint then // Type A = B;
-      K:=stkAlias
-    else if (CurToken=tkSquaredBraceOpen) then // Type A = String[12];
-      K:=stkString
-    else // Type A = A..B;
-      K:=stkRange;
-    UnGetToken;
-    end
-  else  if (CurToken=tkDotDot) then // Type A = B;
-    begin
-    K:=stkRange;
-    UnGetToken;
-    end
-  else
-    begin
-    UnGetToken;
-    K:=stkAlias;
-    if (LowerCase(Name)='string') then
-      K:=stkString;
-    end;
-  Case K of
-    stkString:
+    while CurToken=tkDot do
       begin
-      Result:=ParseStringType(Parent,TypeName);
+      ExpectIdentifier;
+      Name := Name+'.'+CurTokenString;
+      if IsFull then
+        AddToBinaryExprChain(Expr,CreatePrimitiveExpr(Parent,pekIdent,CurTokenString),eopSubIdent);
+      NextToken;
       end;
-    stkRange:
+
+    // Current token is first token after identifier.
+    if IsFull and (CurToken=tkSemicolon) or isCurTokenHint then // Type A = B;
       begin
-      UnGetToken;
-      Result:=ParseRangeType(Parent,TypeName,False);
-      end;
-    stkAlias:
-      begin
-      Ref:=Nil;
-      SS:=isSimpleTypeToken(Name);
-      if not SS then
-        Ref:=Engine.FindElement(Name);
-      if (Ref=Nil) then
-        Ref:=TPasUnresolvedTypeRef(CreateElement(TPasUnresolvedTypeRef,Name,Nil))
+      K:=stkAlias;
+      UnGetToken; // ToDo: dotted identifier
+      end
+    else if IsFull and (CurToken=tkSquaredBraceOpen) then
+      begin
+      if LowerCase(Name)='string' then // Type A = String[12]; shortstring
+        K:=stkString
       else
-        Ref.AddRef;
-      if isFull then
+        ParseExcSyntaxError;
+      UnGetToken; // ToDo: dotted identifier
+      end
+    else if (CurToken = tkLessThan) then // A = B<t>;
+      begin
+      K:=stkSpecialize;
+      end
+    else if (CurToken in [tkBraceOpen,tkDotDot]) then // A: B..C;
+      begin
+      K:=stkRange;
+      UnGetToken; // ToDo: dotted identifier
+      end
+    else
+      begin
+      if IsFull then
+        ParseExcTokenError(';');
+      K:=stkAlias;
+      if (not (po_resolvestandardtypes in Options)) and (LowerCase(Name)='string') then
+        K:=stkString;
+      UnGetToken; // ToDo: dotted identifier
+      end;
+
+    Case K of
+      stkString:
         begin
-        Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent));
-        TPasAliasType(Result).DestType:=Ref as TPasType;
-        end
-      else
-        Result:=Ref as TPasType
+        FreeAndNil(Expr);
+        Result:=ParseStringType(Parent,NamePos,TypeName);
+        end;
+      stkSpecialize:
+        begin
+        ST := TPasSpecializeType(CreateElement(TPasSpecializeType, TypeName, Parent, CurSourcePos));
+        Ref:=ResolveTypeReference(Name,ST);
+        ReadSpecializeArguments(ST);
+        ST.Expr:=Expr;
+        ST.DestType:=Ref;
+        Result:=ST;
+        ST:=Nil;
+        end;
+      stkRange:
+        begin
+        FreeAndNil(Expr);
+        UnGetToken; // move to '='
+        Result:=ParseRangeType(Parent,NamePos,TypeName,False);
+        end;
+      stkAlias:
+        begin
+        Ref:=ResolveTypeReference(Name,Parent);
+        if isFull then
+          begin
+          Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent, NamePos));
+          TPasAliasType(Result).DestType:=Ref;
+          TPasAliasType(Result).Expr:=Expr;
+          end
+        else
+          Result:=Ref;
+        end;
+    end;
+  finally
+    if Result=nil then
+      begin
+      Expr.Free;
+      ReleaseAndNil(TPasElement(Ref));
+      ST.Free;
       end;
   end;
 end;
 
 // On entry, we're on the TYPE token
-function TPasParser.ParseAliasType(Parent: TPasElement; const TypeName: String
-  ): TPasTypeAliasType;
+function TPasParser.ParseAliasType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String): TPasTypeAliasType;
+var
+  ok: Boolean;
 begin
-  Result := TPasTypeAliasType(CreateElement(TPasTypeAliasType, TypeName, Parent));
+  Result := TPasTypeAliasType(CreateElement(TPasTypeAliasType, TypeName, Parent, NamePos));
+  ok:=false;
   try
-    Result.DestType := ParseType(nil,'');
-  except
-    FreeAndNil(Result);
-    raise;
+    Result.DestType := ParseType(Result,NamePos,'');
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
+  end;
+end;
+
+function TPasParser.ParseTypeReference(Parent: TPasElement; NeedExpr: boolean;
+  out Expr: TPasExpr): TPasType;
+// returns either
+// a) TPasSpecializeType, Expr=nil
+// b) TPasUnresolvedTypeRef, Expr<>nil
+// c) TPasType, Expr<>nil
+var
+  Name: String;
+  IsSpecialize: Boolean;
+  ST: TPasSpecializeType;
+begin
+  Result:=nil;
+  Expr:=nil;
+  ST:=nil;
+  try
+    if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
+      begin
+      IsSpecialize:=true;
+      NextToken;
+      end
+    else
+      IsSpecialize:=false;
+    // read dotted identifier
+    CheckToken(tkIdentifier);
+    Name:=ReadDottedIdentifier(Parent,Expr,true);
+    // resolve type
+    Result:=ResolveTypeReference(Name,Parent);
+
+    if CurToken=tkLessThan then
+      begin
+      // specialize
+      ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',Parent));
+      ST.DestType:=Result;
+      Result:=nil;
+      ST.Expr:=Expr;
+      Expr:=nil;
+      // read nested specialize arguments
+      ReadSpecializeArguments(ST);
+      Result:=ST;
+      ST:=nil;
+      NextToken;
+      end
+    else if IsSpecialize then
+      CheckToken(tkLessThan)
+    else
+      begin
+      // simple type reference
+      if not NeedExpr then
+        ReleaseAndNil(TPasElement(Expr));
+      end;
+  finally
+    if ST<>nil then St.Release;
   end;
 end;
 
-function TPasParser.ParsePointerType(Parent: TPasElement; const TypeName: String
-  ): TPasPointerType;
+function TPasParser.ParsePointerType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String): TPasPointerType;
 
+var
+  ok: Boolean;
 begin
-  Result := TPasPointerType(CreateElement(TPasPointerType, TypeName, Parent));
+  Result := TPasPointerType(CreateElement(TPasPointerType, TypeName, Parent, NamePos));
+  ok:=false;
   Try
-    TPasPointerType(Result).DestType := ParseType(nil);
-  except
-    FreeAndNil(Result);
-    Raise;
+    TPasPointerType(Result).DestType := ParseType(Result,CurSourcePos);
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
 end;
 
-function TPasParser.ParseEnumType(Parent: TPasElement; const TypeName: String
-  ): TPasEnumType;
+function TPasParser.ParseEnumType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
 
 Var
   EnumValue: TPasEnumValue;
+  ok: Boolean;
 
 begin
-  Result := TPasEnumType(CreateElement(TPasEnumType, TypeName, Parent));
+  Result := TPasEnumType(CreateElement(TPasEnumType, TypeName, Parent, NamePos));
+  ok:=false;
   try
     while True do
       begin
@@ -982,44 +1451,54 @@ begin
         if CurToken = tkBraceClose then
           Break
         else if not (CurToken=tkComma) then
-          ParseExc(SParserExpectedCommaRBracket);
+          ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
         end
       else if not (CurToken=tkComma) then
-        ParseExc(SParserExpectedCommaRBracket)
+        ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket)
       end;
-  except
-    FreeAndNil(Result);
-    Raise;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
+  Engine.FinishScope(stTypeDef,Result);
 end;
 
-function TPasParser.ParseSetType(Parent: TPasElement; const TypeName: String
-  ): TPasSetType;
+function TPasParser.ParseSetType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
 
+var
+  ok: Boolean;
 begin
-  Result := TPasSetType(CreateElement(TPasSetType, TypeName, Parent));
+  Result := TPasSetType(CreateElement(TPasSetType, TypeName, Parent, NamePos));
+  Result.IsPacked:=AIsPacked;
+  ok:=false;
   try
     ExpectToken(tkOf);
-    Result.EnumType := ParseType(Result,'',False);
-  except
-    Result.Free;
-    raise;
+    Result.EnumType := ParseType(Result,CurSourcePos);
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
+  Engine.FinishScope(stTypeDef,Result);
 end;
 
-function TPasParser.ParseType(Parent: TPasElement; const TypeName: String;
-  Full: Boolean): TPasType;
+function TPasParser.ParseType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs : TFPList = Nil
+  ): TPasType;
 
 Const
   // These types are allowed only when full type declarations
-  FullTypeTokens = [tkGeneric,{tkSpecialize,}tkClass,tkInterface,tkType];
+  FullTypeTokens = [tkGeneric,{tkSpecialize,}tkClass,tkInterface,tkDispInterface,tkType];
   // Parsing of these types already takes care of hints
   NoHintTokens = [tkProcedure,tkFunction];
 var
   PM : TPackMode;
-  CH : Boolean; // Check hint ?
+  CH , isHelper,ok: Boolean; // Check hint ?
 begin
   Result := nil;
+  // NextToken and check pack mode
   Pm:=CheckPackMode;
   if Full then
     CH:=Not (CurToken in NoHintTokens)
@@ -1027,49 +1506,95 @@ begin
     begin
     CH:=False;
     if (CurToken in FullTypeTokens) then
-      ParseExc('Type '+CurtokenText+' not allowed here');
+      ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]);
     end;
+  ok:=false;
   Try
     case CurToken of
       // types only allowed when full
-      tkObject: Result := ParseClassDecl(Parent, TypeName, okObject,PM);
-      tkInterface: Result := ParseClassDecl(Parent, TypeName, okInterface);
+      tkObject: Result := ParseClassDecl(Parent, NamePos, TypeName, okObject,PM);
+      tkDispInterface:
+        Result := ParseClassDecl(Parent, NamePos, TypeName, okDispInterface);
+      tkInterface:
+        Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
-      tkClass: Result := ParseClassDecl(Parent, TypeName, okClass, PM);
-      tkType: Result:=ParseAliasType(Parent,TypeName);
+      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
+      tkType:
+        begin
+        NextToken;
+        isHelper:=CurTokenIsIdentifier('helper');
+        UnGetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okTypeHelper,PM)
+        else
+          Result:=ParseAliasType(Parent,NamePos,TypeName);
+        end;
       // Always allowed
-      tkIdentifier: Result:=ParseSimpleType(Parent,TypeName,Full);
-      tkCaret: Result:=ParsePointerType(Parent,TypeName);
-      tkFile: Result:=ParseFileType(Parent,TypeName);
-      tkArray: Result:=ParseArrayType(Parent,TypeName,pm);
-      tkBraceOpen: Result:=ParseEnumType(Parent,TypeName);
-      tkSet: Result:=ParseSetType(Parent,TypeName);
-      tkProcedure: Result:=ParseProcedureType(Parent,TypeName,ptProcedure);
-      tkFunction: Result:=ParseProcedureType(Parent,TypeName,ptFunction);
+      tkIdentifier:
+        begin
+        // Bug 31709: PReference = ^Reference;
+        // Checked in Delphi: ^Reference to procedure; is not allowed !!
+        if CurTokenIsIdentifier('reference') and Not (Parent is TPasPointerType) then
+          begin
+          CH:=False;
+          Result:=ParseReferencetoProcedureType(Parent,NamePos,TypeName)
+          end
+        else
+          Result:=ParseSimpleType(Parent,NamePos,TypeName,Full);
+        end;
+      tkCaret: Result:=ParsePointerType(Parent,NamePos,TypeName);
+      tkFile: Result:=ParseFileType(Parent,NamePos,TypeName);
+      tkArray: Result:=ParseArrayType(Parent,NamePos,TypeName,pm);
+      tkBraceOpen: Result:=ParseEnumType(Parent,NamePos,TypeName);
+      tkSet: Result:=ParseSetType(Parent,NamePos,TypeName,pm=pmPacked);
+      tkProcedure: Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
+      tkFunction: Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
       tkRecord:
         begin
         NextToken;
-        if (Curtoken=tkHelper) then
+        if CurTokenIsIdentifier('Helper') then
           begin
           UnGetToken;
-          Result:=ParseClassDecl(Parent,TypeName,okRecordHelper,PM);
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM);
           end
         else
           begin
           UnGetToken;
-          Result := ParseRecordDecl(Parent,TypeName,PM);
+          Result := ParseRecordDecl(Parent,NamePos,TypeName,PM);
           end;
         end;
+      tkNumber,tkMinus,tkChar:
+        begin
+        UngetToken;
+        Result:=ParseRangeType(Parent,NamePos,TypeName,Full);
+        end;
     else
-      UngetToken;
-      Result:=ParseRangeType(Parent,TypeName,Full);
+      ParseExcExpectedIdentifier;
     end;
     if CH then
       CheckHint(Result,True);
-  Except
-    FreeAndNil(Result);
-    Raise;
+    ok:=true;
+  finally
+    if not ok then
+      if Result<>nil then
+        Result.Release;
+  end;
+end;
+
+function TPasParser.ParseReferenceToProcedureType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String
+  ): TPasProcedureType;
+begin
+  if not CurTokenIsIdentifier('reference') then
+    ParseExcTokenError('reference');
+  ExpectToken(tkTo);
+  NextToken;
+  Case CurToken of
+   tkprocedure : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptProcedure);
+   tkfunction : Result:=ParseProcedureType(Parent,NamePos,TypeName,ptFunction);
+  else
+    ParseExcTokenError('procedure or function');
   end;
+  Result.IsReferenceTo:=True;
 end;
 
 function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType;
@@ -1085,25 +1610,29 @@ begin
       end;
     tkFunction:
       begin
-        Result := CreateFunctionType('', 'Result', Parent, False);
+        Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
         ParseProcedureOrFunctionHeader(Result, TPasFunctionType(Result), ptFunction, True);
         if CurToken = tkSemicolon then
           UngetToken;        // Unget semicolon
       end;
   else
     UngetToken;
-    Result := ParseType(Parent);
+    Result := ParseType(Parent,CurSourcePos);
   end;
 end;
 
-function TPasParser.ParseArrayType(Parent: TPasElement; const TypeName: String;
-  PackMode: TPackMode): TPasArrayType;
+function TPasParser.ParseArrayType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String; PackMode: TPackMode
+  ): TPasArrayType;
 
 Var
   S : String;
+  ok: Boolean;
+  RangeExpr: TPasExpr;
 
 begin
-  Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent));
+  Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent, NamePos));
+  ok:=false;
   try
     Result.PackMode:=PackMode;
     NextToken;
@@ -1113,12 +1642,23 @@ begin
         begin
           repeat
             NextToken;
-            if CurToken<>tkSquaredBraceClose then
-              S:=S+CurTokenText;
-          until CurToken = tkSquaredBraceClose;
+            if po_arrayrangeexpr in Options then
+              begin
+              RangeExpr:=DoParseExpression(Result);
+              Result.AddRange(RangeExpr);
+              end
+            else if CurToken<>tkSquaredBraceClose then
+               S:=S+CurTokenText;
+            if CurToken=tkSquaredBraceClose then
+              break
+            else if CurToken=tkComma then
+              continue
+            else if po_arrayrangeexpr in Options then
+              ParseExcTokenError(']');
+          until false;
           Result.IndexRange:=S;
           ExpectToken(tkOf);
-          Result.ElType := ParseType(nil);
+          Result.ElType := ParseType(Result,CurSourcePos);
         end;
       tkOf:
         begin
@@ -1127,82 +1667,197 @@ begin
           else
           begin
             UngetToken;
-              Result.ElType := ParseType(nil);
+            Result.ElType := ParseType(Result,CurSourcePos);
           end
         end
       else
-        ParseExc(SParserArrayTypeSyntaxError);
+        ParseExc(nParserArrayTypeSyntaxError,SParserArrayTypeSyntaxError);
     end;
-  except
-    FreeAndNil(Result);
-    Raise;
+    // TPasProcedureType parsing has eaten the semicolon;
+    // We know it was a local definition if the array def (result) is the parent
+    if (Result.ElType is TPasProcedureType) and (Result.ElType.Parent=Result) then
+      UnGetToken;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
+  Engine.FinishScope(stTypeDef,Result);
 end;
 
-function TPasParser.ParseFileType(Parent: TPasElement; const TypeName: String
-  ): TPasFileType;
-
-
+function TPasParser.ParseFileType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName: String): TPasFileType;
 begin
-  Result:=TPasFileType(CreateElement(TPasFileType, TypeName, Parent));
+  Result:=TPasFileType(CreateElement(TPasFileType, TypeName, Parent, NamePos));
   NextToken;
   If CurToken=tkOf then
-    Result.ElType := ParseType(nil)
-  else 
-   ungettoken;
+    Result.ElType := ParseType(Result,CurSourcePos)
+  else
+   UngetToken;
 end;
 
-function TPasParser.isEndOfExp:Boolean;
+function TPasParser.isEndOfExp(AllowEqual : Boolean = False; CheckHints : Boolean = True):Boolean;
 const
   EndExprToken = [
     tkEOF, tkBraceClose, tkSquaredBraceClose, tkSemicolon, tkComma, tkColon,
     tkdo, tkdownto, tkelse, tkend, tkof, tkthen, tkto
   ];
 begin
-  Result:=(CurToken in EndExprToken) or IsCurTokenHint;
+  Result:=(CurToken in EndExprToken) or (CheckHints and IsCurTokenHint);
+  if Not (Result or AllowEqual) then
+    Result:=(Curtoken=tkEqual);
+end;
+
+function TPasParser.ExprToText(Expr: TPasExpr): String;
+var
+  C: TClass;
+begin
+  C:=Expr.ClassType;
+  if C=TPrimitiveExpr then
+    Result:=TPrimitiveExpr(Expr).Value
+  else if C=TSelfExpr then
+    Result:='self'
+  else if C=TBoolConstExpr then
+    Result:=BoolToStr(TBoolConstExpr(Expr).Value,'true','false')
+  else if C=TNilExpr then
+    Result:='nil'
+  else if C=TInheritedExpr then
+    Result:='inherited'
+  else if C=TUnaryExpr then
+    Result:=OpcodeStrings[TUnaryExpr(Expr).OpCode]+ExprToText(TUnaryExpr(Expr).Operand)
+  else if C=TBinaryExpr then
+    begin
+    Result:=ExprToText(TBinaryExpr(Expr).left);
+    if OpcodeStrings[TBinaryExpr(Expr).OpCode]<>'' then
+      Result:=Result+OpcodeStrings[TBinaryExpr(Expr).OpCode]
+    else
+      Result:=Result+' ';
+    Result:=Result+ExprToText(TBinaryExpr(Expr).right)
+    end
+  else if C=TParamsExpr then
+    begin
+    case TParamsExpr(Expr).Kind of
+      pekArrayParams: Result:=ExprToText(TParamsExpr(Expr).Value)
+        +'['+ArrayExprToText(TParamsExpr(Expr).Params)+']';
+      pekFuncParams: Result:=ExprToText(TParamsExpr(Expr).Value)
+        +'('+ArrayExprToText(TParamsExpr(Expr).Params)+')';
+      pekSet: Result:='['+ArrayExprToText(TParamsExpr(Expr).Params)+']';
+      else ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[ExprKindNames[TParamsExpr(Expr).Kind]]);
+    end;
+    end
+  else
+    ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,['TPasParser.ExprToText: '+Expr.ClassName]);
+end;
+
+function TPasParser.ArrayExprToText(Expr: TPasExprArray): String;
+var
+  i: Integer;
+begin
+  Result:='';
+  for i:=0 to length(Expr)-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+ExprToText(Expr[i]);
+    end;
 end;
 
-function TPasParser.ParseParams(AParent: TPasElement;paramskind: TPasExprKind): TParamsExpr;
+function TPasParser.ResolveTypeReference(Name: string; Parent: TPasElement): TPasType;
+var
+  SS: Boolean;
+  Ref: TPasElement;
+begin
+  Ref:=Nil;
+  SS:=(not (po_resolvestandardtypes in FOptions)) and isSimpleTypeToken(Name);
+  if not SS then
+    begin
+    Ref:=Engine.FindElement(Name);
+    if Ref=nil then
+      begin
+      {$IFDEF VerbosePasResolver}
+      if po_resolvestandardtypes in FOptions then
+        begin
+        writeln('ERROR: TPasParser.ParseSimpleType resolver failed to raise an error');
+        ParseExcExpectedIdentifier;
+        end;
+      {$ENDIF}
+      end
+    else if not (Ref is TPasType) then
+      ParseExc(nParserExpectedTypeButGot,SParserExpectedTypeButGot,[Ref.ElementTypeName]);
+    end;
+  if (Ref=Nil) then
+    Result:=TPasUnresolvedTypeRef(CreateElement(TPasUnresolvedTypeRef,Name,Parent))
+  else
+    begin
+    Ref.AddRef;
+    Result:=TPasType(Ref);
+    end;
+end;
+
+function TPasParser.ParseParams(AParent: TPasElement; paramskind: TPasExprKind;
+  AllowFormatting: Boolean = False): TParamsExpr;
 var
   params  : TParamsExpr;
   p       : TPasExpr;
   PClose  : TToken;
+
 begin
   Result:=nil;
-  if paramskind in [pekArrayParams, pekSet] then begin
-    if CurToken<>tkSquaredBraceOpen then Exit;
+  if paramskind in [pekArrayParams, pekSet] then
+    begin
+    if CurToken<>tkSquaredBraceOpen then
+      ParseExc(nParserExpectTokenError,SParserExpectTokenError,['[']);
     PClose:=tkSquaredBraceClose;
-  end else begin
-    if CurToken<>tkBraceOpen then Exit;
+    end
+  else
+    begin
+    if CurToken<>tkBraceOpen then
+      ParseExc(nParserExpectTokenError,SParserExpectTokenError,['(']);
     PClose:=tkBraceClose;
-  end;
+    end;
 
-  params:=TParamsExpr.Create(AParent,paramskind);
+  params:=TParamsExpr(CreateElement(TParamsExpr,'',AParent));
   try
+    params.Kind:=paramskind;
     NextToken;
-    if not isEndOfExp then begin
+    if not isEndOfExp(false,false) then
+      begin
       repeat
-        p:=DoParseExpression(AParent);
-        if not Assigned(p) then Exit; // bad param syntax
+        p:=DoParseExpression(params);
+        if not Assigned(p) then
+          ParseExcSyntaxError;
         params.AddParam(p);
+        if (CurToken=tkColon) then
+          if Not AllowFormatting then
+            ParseExc(nParserExpectTokenError,SParserExpectTokenError,[','])
+          else
+            begin
+            NextToken;
+            p.format1:=DoParseExpression(p);
+            if (CurToken=tkColon) then
+              begin
+              NextToken;
+              p.format2:=DoParseExpression(p);
+              end;
+            end;
+        if not (CurToken in [tkComma, PClose]) then
+          ParseExc(nParserExpectTokenError,SParserExpectTokenError,[',']);
 
-        if not (CurToken in [tkComma, PClose]) then begin
-          Exit;
-        end;
-
-        if CurToken = tkComma then begin
+        if CurToken = tkComma then
+          begin
           NextToken;
-          if CurToken = PClose then begin
+          if CurToken = PClose then
+            begin
             //ErrorExpected(parser, 'identifier');
-            Exit;
+            ParseExcSyntaxError;
+            end;
           end;
-        end;
       until CurToken=PClose;
-    end;
+      end;
     NextToken;
     Result:=params;
   finally
-    if not Assigned(Result) then params.Free;
+    if not Assigned(Result) then params.Release;
   end;
 end;
 
@@ -1222,7 +1877,7 @@ begin
     tkLessEqualThan         : Result:=eopLessthanEqual;
     tkGreaterEqualThan      : Result:=eopGreaterThanEqual;
     tkPower                 : Result:=eopPower;
-    tkSymmetricalDifference : Result:=eopSymmetricalDifference;                                                                                              
+    tkSymmetricalDifference : Result:=eopSymmetricalDifference;
     tkIs                    : Result:=eopIs;
     tkAs                    : Result:=eopAs;
     tkSHR                   : Result:=eopSHR;
@@ -1237,147 +1892,257 @@ begin
     tkDot                   : Result:=eopSubIdent;
     tkCaret                 : Result:=eopDeref;
   else
-    ParseExc(format('Not an operand: (%d : %s)',[AToken,TokenInfos[AToken]]));
+    ParseExc(nParserNotAnOperand,SParserNotAnOperand,[AToken,TokenInfos[AToken]]);
   end;
 end;
- 
-function TPasParser.ParseExpIdent(AParent : TPasElement):TPasExpr;
+
+function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
+
+  Function IsWriteOrStr(P : TPasExpr) : boolean;
+
+  Var
+    N : String;
+  begin
+    Result:=P is TPrimitiveExpr;
+    if Result then
+      begin
+      N:=LowerCase(TPrimitiveExpr(P).Value);
+      // We should actually resolve this to system.NNN
+      Result:=(N='write') or (N='str') or (N='writeln');
+      end;
+  end;
+
+  Procedure HandleSelf(Var Last: TPasExpr);
+
+  Var
+    b       : TBinaryExpr;
+    optk    : TToken;
+
+  begin
+    NextToken;
+    if CurToken = tkDot then
+      begin // self.Write(EscapeText(AText));
+      optk:=CurToken;
+      NextToken;
+      b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
+      if not Assigned(b.right) then
+        begin
+        b.Release;
+        ParseExcExpectedIdentifier;
+        end;
+      Last:=b;
+      end;
+    UngetToken;
+  end;
+
+  function IsSpecialize: boolean;
+  var
+    LookAhead, i: Integer;
+
+    function Next: boolean;
+    begin
+      if LookAhead=FTokenRingSize then exit(false);
+      NextToken;
+      inc(LookAhead);
+      Result:=true;
+    end;
+
+  begin
+    Result:=false;
+    LookAhead:=0;
+    CheckToken(tkLessThan);
+    try
+      Next;
+      if not (CurToken in [tkIdentifier,tkself]) then exit;
+      while Next do
+        case CurToken of
+        tkDot:
+          begin
+          if not Next then exit;
+          if not (CurToken in [tkIdentifier,tkself,tktrue,tkfalse]) then exit;
+          end;
+        tkComma:
+          begin
+          if not Next then exit;
+          if not (CurToken in [tkIdentifier,tkself]) then exit;
+          end;
+        tkLessThan:
+          begin
+          // e.g. A<B<
+          // not a valid comparison, could be a specialization -> good enough
+          exit(true);
+          end;
+        tkGreaterThan:
+          begin
+          // e.g. A<B>
+          exit(true);
+          end;
+        else
+          exit;
+        end;
+    finally
+      for i:=1 to LookAhead do
+        UngetToken;
+    end;
+  end;
+
 var
-  x       : TPasExpr;
+  Last,func, Expr: TPasExpr;
   prm     : TParamsExpr;
-  u       : TUnaryExpr;
   b       : TBinaryExpr;
-  optk    : TToken;
+  ok, CanSpecialize: Boolean;
+  aName: String;
+  ISE: TInlineSpecializeExpr;
+  ST: TPasSpecializeType;
+
 begin
   Result:=nil;
+  CanSpecialize:=false;
+  aName:='';
   case CurToken of
-    tkString:           x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenString);
-    tkChar:             x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText);
-    tkNumber:           x:=TPrimitiveExpr.Create(AParent,pekNumber, CurTokenString);
-    tkIdentifier:       x:=TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText);
-    tkfalse, tktrue:    x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
-    tknil:              x:=TNilExpr.Create(Aparent);
-    tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
-    tkinherited:
+    tkString:           Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
+    tkChar:             Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
+    tkNumber:           Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
+    tkIdentifier:
       begin
-      //inherited; inherited function
-      x:=TInheritedExpr.Create(AParent);
-      NextToken;
-      if (CurToken=tkIdentifier) then
+      CanSpecialize:=true;
+      aName:=CurTokenText;
+      if CompareText(aName,'self')=0 then
         begin
-        b:=TBinaryExpr.Create(AParent,x, DoParseExpression(AParent), eopNone);
-        if not Assigned(b.right) then
-          begin
-          B.Free;
-          Exit; // error
-          end;
-        x:=b;
-        UngetToken;
+        Last:=CreateSelfExpr(AParent);
+        HandleSelf(Last);
         end
       else
-        UngetToken;
+        Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
       end;
-    tkself: begin
-      //x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText); //function(self);
-      x:=TSelfExpr.Create(AParent);
+    tkfalse, tktrue:    Last:=CreateBoolConstExpr(Aparent,pekBoolConst, CurToken=tktrue);
+    tknil:              Last:=CreateNilExpr(AParent);
+    tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
+    tkinherited:
+      begin
+      //inherited; inherited function
+      Last:=CreateInheritedExpr(AParent);
       NextToken;
-      if CurToken = tkDot then
-        begin // self.Write(EscapeText(AText));
-        optk:=CurToken;
-        NextToken;
-        b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
+      if (CurToken=tkIdentifier) then
+        begin
+        b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone);
         if not Assigned(b.right) then
           begin
-          B.Free;
-          Exit; // error
+          b.Release;
+          ParseExcExpectedIdentifier;
           end;
-         x:=b;
+        Last:=b;
         end;
       UngetToken;
-    end;
-    tkAt: begin
+      end;
+    tkself:
+      begin
+      CanSpecialize:=true;
+      aName:=CurTokenText;
+      Last:=CreateSelfExpr(AParent);
+      HandleSelf(Last);
+      end;
+    tkAt:
+      begin
+      // is this still needed?
       // P:=@function;
       NextToken;
-      if (length(CurTokenText)=0) or not (CurTokenText[1] in ['A'..'_']) then begin
+      if (length(CurTokenText)=0) or not (CurTokenText[1] in ['A'..'_']) then
+        begin
         UngetToken;
-        ParseExc(SParserExpectedIdentifier);
+        ParseExcExpectedIdentifier;
+        end;
+      Last:=CreatePrimitiveExpr(AParent,pekString, '@'+CurTokenText);
       end;
-      x:=TPrimitiveExpr.Create(AParent,pekString, '@'+CurTokenText);
-    end;
-    tkCaret: begin
+    tkCaret:
+      begin
+      // is this still needed?
       // ^A..^_ characters. See #16341
       NextToken;
-      if not (length(CurTokenText)=1) or not (CurTokenText[1] in ['A'..'_']) then begin
+      if not (length(CurTokenText)=1) or not (CurTokenText[1] in ['A'..'_']) then
+        begin
         UngetToken;
-        ParseExc(SParserExpectedIdentifier);
+        ParseExcExpectedIdentifier;
+        end;
+      Last:=CreatePrimitiveExpr(AParent,pekString, '^'+CurTokenText);
       end;
-      x:=TPrimitiveExpr.Create(AParent,pekString, '^'+CurTokenText);
-    end;
   else
-    ParseExc(SParserExpectedIdentifier);
+    ParseExcExpectedIdentifier;
   end;
 
-  if x.Kind<>pekSet then NextToken;
+  Result:=Last;
+  func:=Last;
+  
+  if Last.Kind<>pekSet then NextToken;
+  if not (Last.Kind in [pekIdent,pekSelf,pekNil]) then
+    exit;
 
+  ok:=false;
+  ISE:=nil;
   try
-    if x.Kind=pekIdent then
-      begin
-      while CurToken in [tkDot] do
+    repeat
+      case CurToken of
+      tkDot:
         begin
         NextToken;
-        if CurToken=tkIdentifier then
+        if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
           begin
-          b:=TBinaryExpr.Create(AParent,x, TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText), eopSubIdent);
+          aName:=aName+'.'+CurTokenString;
+          expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
+          AddToBinaryExprChain(Result,expr,eopSubIdent);
+          func:=expr;
           NextToken;
           end
         else
           begin
           UngetToken;
-          ParseExc(SParserExpectedIdentifier);
+          ParseExcExpectedIdentifier;
           end;
-        x:=b;
         end;
-      while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
-        case CurToken of
-          tkBraceOpen:
-            begin
-            prm:=ParseParams(AParent,pekFuncParams);
-            if not Assigned(prm) then Exit;
-            prm.Value:=x;
-            x:=prm;
-            end;
-          tkSquaredBraceOpen:
-            begin
-            prm:=ParseParams(AParent,pekArrayParams);
-            if not Assigned(prm) then Exit;
-            prm.Value:=x;
-            x:=prm;
-            end;
-          tkCaret:
-            begin
-            u:=TUnaryExpr.Create(AParent,x, TokenToExprOp(CurToken));
-            x:=u;
-            NextToken;
-            end;
+      tkBraceOpen,tkSquaredBraceOpen:
+        begin
+        if CurToken=tkBraceOpen then
+          prm:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(func))
+        else
+          prm:=ParseParams(AParent,pekArrayParams);
+        if not Assigned(prm) then Exit;
+        AddParamsToBinaryExprChain(Result,prm);
+        CanSpecialize:=false;
         end;
-      // Needed for TSDOBaseDataObjectClass(Self.ClassType).Create
-      if CurToken in [tkdot,tkas] then
+      tkCaret:
         begin
-        optk:=CurToken;
+        Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
         NextToken;
-        b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
-        if not Assigned(b.right) then
+        CanSpecialize:=false;
+        end;
+      tkLessThan:
+        if (not CanSpecialize) or not IsSpecialize then
+          break
+        else
           begin
-          b.free;
-          Exit; // error
+          // an inline specialization (e.g. A<B,C>)
+          ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent));
+          ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE));
+          ISE.DestType:=ST;
+          ReadSpecializeArguments(ST);
+          ST.DestType:=ResolveTypeReference(aName,ST);
+          ST.Expr:=Result;
+          Result:=ISE;
+          ISE:=nil;
+          CanSpecialize:=false;
+          NextToken;
           end;
-        x:=b;
+      else
+        break;
       end;
-    end;
-
-    Result:=x;
+    until false;
+    ok:=true;
   finally
-    if not Assigned(Result) then x.Free;
+    if not ok then
+      begin
+      Result.Release;
+      ISE.Free;
+      end;
   end;
 end;
 
@@ -1399,16 +2164,17 @@ begin
   end;
 end;
 
-function TPasParser.DoParseExpression(Aparent : TPaselement;InitExpr: TPasExpr): TPasExpr;
+function TPasParser.DoParseExpression(AParent : TPaselement;InitExpr: TPasExpr; AllowEqual : Boolean = True): TPasExpr;
 var
   expstack  : TFPList;
-  opstack   : TFPList;
+  opstack   : array of TToken;
+  opstackTop: integer;
   pcount    : Integer;
   x         : TPasExpr;
   i         : Integer;
   tempop    : TToken;
   NotBinary : Boolean;
-  
+
 const
   PrefixSym = [tkPlus, tkMinus, tknot, tkAt]; // + - not @
   BinaryOP  = [tkMul, tkDivision, tkdiv, tkmod,  tkDotDot,
@@ -1428,19 +2194,22 @@ const
 
   procedure PushOper(token: TToken); inline;
   begin
-    opstack.Add( Pointer(PtrInt(token)) );
+    inc(opstackTop);
+    if opstackTop=length(opstack) then
+      SetLength(opstack,length(opstack)*2+4);
+    opstack[opstackTop]:=token;
   end;
 
   function PeekOper: TToken; inline;
   begin
-    if opstack.Count>0 then Result:=TToken(PtrUInt(opstack[ opstack.Count-1]))
-    else Result:=tkEOF
+    if opstackTop>=0 then Result:=opstack[opstackTop]
+    else Result:=tkEOF;
   end;
 
   function PopOper: TToken; inline;
   begin
     Result:=PeekOper;
-    if Result<>tkEOF then opstack.Delete(opstack.Count-1);
+    if Result<>tkEOF then dec(opstackTop);
   end;
 
   procedure PopAndPushOperator;
@@ -1454,17 +2223,27 @@ const
     xright:=PopExp;
     xleft:=PopExp;
     if t=tkDotDot then
-      bin := TBinaryExpr.CreateRange(AParent,xleft, xright)
+      begin
+      bin:=CreateBinaryExpr(AParent,xleft,xright,eopNone);
+      bin.Kind:=pekRange;
+      end
     else
-      bin := TBinaryExpr.Create(AParent,xleft, xright, TokenToExprOp(t));
+      bin:=CreateBinaryExpr(AParent,xleft,xright,TokenToExprOp(t));
     expstack.Add(bin);
   end;
 
+Var
+  AllowedBinaryOps : Set of TToken;
+
 begin
+  AllowedBinaryOps:=BinaryOP;
+  if Not AllowEqual then
+    Exclude(AllowedBinaryOps,tkEqual);
   //DumpCurToken('Entry',iaIndent);
   Result:=nil;
   expstack := TFPList.Create;
-  opstack := TFPList.Create;
+  SetLength(opstack,4);
+  opstackTop:=-1;
   try
     repeat
       NotBinary:=True;
@@ -1472,7 +2251,7 @@ begin
       if not Assigned(InitExpr) then
         begin
         // the first part of the expression has been parsed externally.
-        // this is used by Constant Expresion parser (CEP) parsing only,
+        // this is used by Constant Expression parser (CEP) parsing only,
         // whenever it makes a false assuming on constant expression type.
         // i.e: SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
         //
@@ -1495,42 +2274,49 @@ begin
           begin
           NextToken;
           x:=DoParseExpression(AParent);
-          if CurToken<>tkBraceClose then
+          if (CurToken<>tkBraceClose) then
             begin
-            x.free;
-            Exit;
+            x.Release;
+            CheckToken(tkBraceClose);
             end;
           NextToken;
-          //     DumpCurToken('Here 1');
-               // for the expression like  (TObject(m)).Free;
-               if (x<>Nil) and (CurToken=tkDot) then
-                 begin
-                 NextToken;
-          //       DumpCurToken('Here 2');
-                 x:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(tkDot));
-          //       DumpCurToken('Here 3');
-                 end;
-
+          // for expressions like (ppdouble)^^;
+          while (x<>Nil) and (CurToken=tkCaret) do
+            begin
+            NextToken;
+            x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
+            end;
+          // for expressions like (TObject(m)).Free;
+          if (x<>Nil) and (CurToken=tkDot) then
+            begin
+            NextToken;
+            x:=CreateBinaryExpr(AParent,x, ParseExpIdent(AParent), TokenToExprOp(tkDot));
+            end;
+          // for expressions like (PChar(a)+10)[0];
+          if (x<>Nil) and (CurToken=tkSquaredBraceOpen) then
+            begin
+            x:=ParseParams(x,pekArrayParams,False);
+            end;
           end
         else
           begin
           x:=ParseExpIdent(AParent);
           end;
         if not Assigned(x) then
-          Exit;
+          ParseExcSyntaxError;
         expstack.Add(x);
 
         for i:=1 to pcount do
           begin
           tempop:=PopOper;
           x:=popexp;
-          if (tempop=tkMinus) and (X.Kind=pekRange) then
+          if (tempop=tkMinus) and (x.Kind=pekRange) then
             begin
-            TBinaryExpr(x).Left:=TUnaryExpr.Create(x, TBinaryExpr(X).left, eopSubtract);
+            TBinaryExpr(x).Left:=CreateUnaryExpr(x, TBinaryExpr(x).left, eopSubtract);
             expstack.Add(x);
             end
           else
-            expstack.Add( TUnaryExpr.Create(AParent, x, TokenToExprOp(tempop) ));
+            expstack.Add(CreateUnaryExpr(AParent, x, TokenToExprOp(tempop) ));
           end;
         end
       else
@@ -1538,27 +2324,33 @@ begin
         expstack.Add(InitExpr);
         InitExpr:=nil;
         end;
-      if (CurToken in BinaryOP) then
+      if (CurToken in AllowedBinaryOPs) then
         begin
         // Adjusting order of the operations
         NotBinary:=False;
         tempop:=PeekOper;
-        while (opstack.Count>0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
+        while (opstackTop>=0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
           PopAndPushOperator;
           tempop:=PeekOper;
         end;
         PushOper(CurToken);
         NextToken;
         end;
-     // Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
-    until NotBinary or isEndOfExp;
+       //Writeln('Bin ',NotBinary ,' or EOE ',isEndOfExp, ' Ex ',Assigned(x),' stack ',ExpStack.Count);
+    until NotBinary or isEndOfExp(AllowEqual, NotBinary);
 
-    if not NotBinary then ParseExc(SParserExpectedIdentifier);
+    if not NotBinary then ParseExcExpectedIdentifier;
 
-    while opstack.Count>0 do PopAndPushOperator;
+    while opstackTop>=0 do PopAndPushOperator;
 
     // only 1 expression should be on the stack, at the end of the correct expression
-    if expstack.Count=1 then Result:=TPasExpr(expstack[0]);
+    if expstack.Count<>1 then
+      ParseExcSyntaxError;
+    if expstack.Count=1 then
+      begin
+      Result:=TPasExpr(expstack[0]);
+      Result.Parent:=AParent;
+      end;
 
   finally
     {if Not Assigned(Result) then
@@ -1568,9 +2360,9 @@ begin
     if not Assigned(Result) then begin
       // expression error!
       for i:=0 to expstack.Count-1 do
-        TObject(expstack[i]).Free;
+        TPasExpr(expstack[i]).Release;
     end;
-    opstack.Free;
+    SetLength(opstack,0);
     expstack.Free;
   end;
 end;
@@ -1578,80 +2370,124 @@ end;
 
 function GetExprIdent(p: TPasExpr): String;
 begin
-  if Assigned(p) and (p is TPrimitiveExpr) and (p.Kind=pekIdent) then
+  Result:='';
+  if not Assigned(p) then exit;
+  if (p.ClassType=TPrimitiveExpr) and (p.Kind=pekIdent) then
     Result:=TPrimitiveExpr(p).Value
-  else
-    Result:='';
+  else if (p.ClassType=TSelfExpr) then
+    Result:='Self';
 end;
 
 function TPasParser.DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
+
+  function lastfield:boolean;
+
+  begin
+    result:= CurToken<>tkSemicolon;
+    if not result then
+     begin
+       nexttoken;
+       if curtoken=tkbraceclose then
+         result:=true
+       else
+         ungettoken;
+     end;
+  end;
+
+  procedure ReadArrayValues(x : TPasExpr);
+  var
+    a: TArrayValues;
+  begin
+    Result:=nil;
+    a:=nil;
+    try
+      a:=CreateArrayValues(AParent);
+      if x<>nil then
+        begin
+        a.AddValues(x);
+        x:=nil;
+        end;
+      repeat
+        NextToken;
+        a.AddValues(DoParseConstValueExpression(AParent));
+      until CurToken<>tkComma;
+      Result:=a;
+    finally
+      if Result=nil then
+        begin
+        a.Free;
+        x.Free;
+        end;
+    end;
+  end;
+
 var
   x : TPasExpr;
   n : AnsiString;
   r : TRecordValues;
-  a : TArrayValues;
-
-function lastfield:boolean;
-
-begin
-  result:= CurToken<>tkSemicolon;
-  if not result then
-   begin
-     nexttoken;
-     if curtoken=tkbraceclose then
-       result:=true
-     else
-       ungettoken;
-   end; 
-end;
-
 begin
   if CurToken <> tkBraceOpen then
     Result:=DoParseExpression(AParent)
   else begin
-    NextToken;
-    x:=DoParseConstValueExpression(Aparent);
-    case CurToken of
-      tkComma: // array of values (a,b,c);
-        begin
-          a:=TArrayValues.Create(AParent);
-          a.AddValues(x);
-          repeat
-            NextToken;
-            x:=DoParseConstValueExpression(AParent);
-            a.AddValues(x);
-          until CurToken<>tkComma;
-          Result:=a;
-        end;
+    Result:=nil;
+    if Engine.NeedArrayValues(AParent) then
+      ReadArrayValues(nil)
+    else
+      begin
+      NextToken;
+      x:=DoParseConstValueExpression(AParent);
+      case CurToken of
+        tkComma: // array of values (a,b,c);
+          ReadArrayValues(x);
 
-      tkColon: // record field (a:xxx;b:yyy;c:zzz);
-        begin
-          n:=GetExprIdent(x);
-          x.Free;
-          r:=TRecordValues.Create(AParent);
-          NextToken;
-          x:=DoParseConstValueExpression(AParent);
-          r.AddField(n, x);
-          if not lastfield then
-            repeat
-              n:=ExpectIdentifier;
-              ExpectToken(tkColon);
+        tkColon: // record field (a:xxx;b:yyy;c:zzz);
+          begin
+            r:=nil;
+            try
+              n:=GetExprIdent(x);
+              ReleaseAndNil(TPasElement(x));
+              r:=CreateRecordValues(AParent);
               NextToken;
               x:=DoParseConstValueExpression(AParent);
-              r.AddField(n, x)
-            until lastfield; // CurToken<>tkSemicolon;
-          Result:=r;
-        end;
-    else
-      // Binary expression!  ((128 div sizeof(longint)) - 3);       ;
-      Result:=DoParseExpression(AParent,x);
-      if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
-      NextToken;
-      if CurToken <> tkSemicolon then // the continue of expresion
-        Result:=DoParseExpression(AParent,Result);
-      Exit;
-    end;
-    if CurToken<>tkBraceClose then ParseExc(SParserExpectedCommaRBracket);
+              r.AddField(n, x);
+              x:=nil;
+              if not lastfield then
+                repeat
+                  n:=ExpectIdentifier;
+                  ExpectToken(tkColon);
+                  NextToken;
+                  x:=DoParseConstValueExpression(AParent);
+                  r.AddField(n, x);
+                  x:=nil;
+                until lastfield; // CurToken<>tkSemicolon;
+              Result:=r;
+            finally
+              if Result=nil then
+                begin
+                r.Free;
+                x.Free;
+                end;
+            end;
+          end;
+      else
+        // Binary expression!  ((128 div sizeof(longint)) - 3);
+        Result:=DoParseExpression(AParent,x);
+        if CurToken<>tkBraceClose then
+          begin
+          ReleaseAndNil(TPasElement(Result));
+          ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
+          end;
+        NextToken;
+        if CurToken <> tkSemicolon then // the continue of expression
+          Result:=DoParseExpression(AParent,Result);
+        Exit;
+      end;
+      end;
+    if CurToken<>tkBraceClose then
+      begin
+      ReleaseAndNil(TPasElement(Result));
+      ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
+      end;
     NextToken;
   end;
 end;
@@ -1674,7 +2510,7 @@ begin
         Result:=TPasOverloadedProc(OldMember)
       else
         begin
-        Result:=TPasOverloadedProc.Create(AName, OldMember.Parent);
+        Result:=TPasOverloadedProc(CreateElement(TPasOverloadedProc, AName, OldMember.Parent));
         Result.Visibility:=OldMember.Visibility;
         Result.Overloads.Add(OldMember);
         Result.SourceFilename:=OldMember.SourceFilename;
@@ -1698,7 +2534,10 @@ var
 begin
   With Decs do
     begin
-    OverloadedProc:=CheckOverloadList(Functions,AProc.Name,OldMember);
+    if not (po_nooverloadedprocs in Options) then
+      OverloadedProc:=CheckOverloadList(Functions,AProc.Name,OldMember)
+    else
+      OverloadedProc:=nil;
     If (OverloadedProc<>Nil) then
       begin
       OverLoadedProc.Overloads.Add(AProc);
@@ -1717,7 +2556,7 @@ begin
     end;
 end;
 
-// Return the parent of a function declaration. This is APArent,
+// Return the parent of a function declaration. This is AParent,
 // except when AParent is a class, and the function is overloaded.
 // Then the parent is the overload object.
 function TPasParser.CheckIfOverloaded(AParent: TPasElement; const AName: String): TPasElement;
@@ -1727,7 +2566,7 @@ var
 
 begin
   Result:=AParent;
-  If AParent is TPasClassType then
+  If (not (po_nooverloadedprocs in Options)) and (AParent is TPasClassType) then
     begin
     OverloadedProc:=CheckOverLoadList(TPasClassType(AParent).Members,AName,Member);
     If (OverloadedProc<>Nil) then
@@ -1749,9 +2588,9 @@ begin
     tkLibrary:
       ParseLibrary(Module);
   else
-    ungettoken;
+    UngetToken;
     ParseProgram(Module,True);
-  //    ParseExc(Format(SParserExpectTokenError, ['unit']));
+  //    ParseExcTokenError('unit');
   end;
 end;
 
@@ -1764,27 +2603,29 @@ begin
   AUnitName := ExpectIdentifier;
   NextToken;
   while CurToken = tkDot do
-  begin
+    begin
     ExpectIdentifier;
     AUnitName := AUnitName + '.' + CurTokenString;
     NextToken;
-  end;
+    end;
   UngetToken;
   Module := TPasModule(CreateElement(TPasModule, AUnitName,
     Engine.Package));
   FCurModule:=Module;
   try
     if Assigned(Engine.Package) then
-    begin
+      begin
       Module.PackageName := Engine.Package.Name;
       Engine.Package.Modules.Add(Module);
-    end;
+      Module.AddRef;
+      end;
     CheckHint(Module,True);
 //    ExpectToken(tkSemicolon);
     ExpectToken(tkInterface);
     If LogEvent(pleInterface) then
-      DoLog(SLogStartInterface );
+      DoLog(mtInfo,nLogStartInterface,SLogStartInterface);
     ParseInterface;
+    Engine.FinishScope(stModule,Module);
   finally
     FCurModule:=nil;
   end;
@@ -1802,7 +2643,17 @@ begin
   if SkipHeader then
     N:=ChangeFileExt(Scanner.CurFilename,'')
   else
+    begin
     N:=ExpectIdentifier;
+    NextToken;
+    while CurToken = tkDot do
+      begin
+      ExpectIdentifier;
+      N := N + '.' + CurTokenString;
+      NextToken;
+      end;
+    UngetToken;
+    end;
   Module := nil;
   PP:=TPasProgram(CreateElement(TPasProgram, N, Engine.Package));
   Module :=PP;
@@ -1821,31 +2672,44 @@ begin
         PP.InputFile:=ExpectIdentifier;
         NextToken;
         if Not (CurToken in [tkBraceClose,tkComma]) then
-          ParseExc(SParserExpectedCommaRBracket);
+          ParseExc(nParserExpectedCommaRBracket,SParserExpectedCommaRBracket);
         If (CurToken=tkComma) then
           PP.OutPutFile:=ExpectIdentifier;
         ExpectToken(tkBraceClose);
         NextToken;
         end;
       if (CurToken<>tkSemicolon) then
-        ParseExc(Format(SParserExpectTokenError,[';']));
+        ParseExcTokenError(';');
       end;
     Section := TProgramSection(CreateElement(TProgramSection, '', CurModule));
     PP.ProgramSection := Section;
+    ParseOptionalUsesList(Section);
     ParseDeclarations(Section);
+    Engine.FinishScope(stModule,Module);
   finally
     FCurModule:=nil;
   end;
 end;
 
+// Starts after the "library" token
 procedure TPasParser.ParseLibrary(var Module: TPasModule);
 Var
   PP : TPasLibrary;
   Section : TLibrarySection;
+  N: String;
 
 begin
+  N:=ExpectIdentifier;
+  NextToken;
+  while CurToken = tkDot do
+    begin
+    ExpectIdentifier;
+    N := N + '.' + CurTokenString;
+    NextToken;
+    end;
+  UngetToken;
   Module := nil;
-  PP:=TPasLibrary(CreateElement(TPasLibrary, ExpectIdentifier, Engine.Package));
+  PP:=TPasLibrary(CreateElement(TPasLibrary, N, Engine.Package));
   Module :=PP;
   FCurModule:=Module;
   try
@@ -1856,15 +2720,30 @@ begin
     end;
     NextToken;
     if (CurToken<>tkSemicolon) then
-        ParseExc(Format(SParserExpectTokenError,[';']));
+        ParseExcTokenError(';');
     Section := TLibrarySection(CreateElement(TLibrarySection, '', CurModule));
     PP.LibrarySection := Section;
+    ParseOptionalUsesList(Section);
     ParseDeclarations(Section);
+    Engine.FinishScope(stModule,Module);
   finally
     FCurModule:=nil;
   end;
 end;
 
+procedure TPasParser.ParseOptionalUsesList(ASection: TPasSection);
+// checks if next token is Uses keyword and reads the uses list
+begin
+  NextToken;
+  if CurToken=tkuses then
+    ParseUsesList(ASection)
+  else begin
+    CheckImplicitUsedUnits(ASection);
+    Engine.FinishScope(stUsesClause,ASection);
+    UngetToken;
+  end;
+end;
+
 // Starts after the "interface" token
 procedure TPasParser.ParseInterface;
 var
@@ -1872,7 +2751,8 @@ var
 begin
   Section := TInterfaceSection(CreateElement(TInterfaceSection, '', CurModule));
   CurModule.InterfaceSection := Section;
-  ParseDeclarations(Section);
+  ParseOptionalUsesList(Section);
+  ParseDeclarations(Section); // this also parses the Implementation section
 end;
 
 // Starts after the "implementation" token
@@ -1882,6 +2762,7 @@ var
 begin
   Section := TImplementationSection(CreateElement(TImplementationSection, '', CurModule));
   CurModule.ImplementationSection := Section;
+  ParseOptionalUsesList(Section);
   ParseDeclarations(Section);
 end;
 
@@ -1970,17 +2851,29 @@ begin
       else
         Result:=ptOperator;
   else
-    ParseExc(SParserNotAProcToken);
+    ParseExc(nParserNotAProcToken,SParserNotAProcToken);
   end;
 end;
 
 procedure TPasParser.ParseDeclarations(Declarations: TPasDeclarations);
 var
   CurBlock: TDeclType;
+
+  procedure SetBlock(NewBlock: TDeclType);
+  begin
+    if CurBlock=NewBlock then exit;
+    if CurBlock=declType then
+      Engine.FinishScope(stTypeSection,Declarations);
+    CurBlock:=NewBlock;
+    Scanner.SetForceCaret(NewBlock=declType);
+  end;
+
+var
   ConstEl: TPasConst;
   ResStrEl: TPasResString;
   TypeEl: TPasType;
   ClassEl: TPasClassType;
+  ArrEl : TPasArrayType;
   List: TFPList;
   i,j: Integer;
   VarEl: TPasVariable;
@@ -1988,6 +2881,10 @@ var
   PropEl : TPasProperty;
   TypeName: String;
   PT : TProcType;
+  NamePos: TPasSourcePos;
+  ok: Boolean;
+  Proc: TPasProcedure;
+  RecordEl: TPasRecordType;
 
 begin
   CurBlock := declNone;
@@ -1999,7 +2896,7 @@ begin
       tkend:
         begin
         If (CurModule is TPasProgram) and (CurModule.InitializationSection=Nil) then
-          ParseExc(Format(SParserExpectTokenError,['begin']));
+          ParseExcTokenError('begin');
         ExpectToken(tkDot);
         break;
         end;
@@ -2009,7 +2906,8 @@ begin
           If Not Engine.InterfaceOnly then
             begin
             If LogEvent(pleImplementation) then
-              DoLog(SLogStartImplementation);
+              DoLog(mtInfo,nLogStartImplementation,SLogStartImplementation);
+            SetBlock(declNone);
             ParseImplementation;
             end;
           break;
@@ -2018,6 +2916,7 @@ begin
         if (Declarations is TInterfaceSection)
         or ((Declarations is TImplementationSection) and not (Declarations is TProgramSection)) then
           begin
+          SetBlock(declNone);
           ParseInitialization;
           break;
           end;
@@ -2025,44 +2924,47 @@ begin
         if (Declarations is TInterfaceSection)
         or ((Declarations is TImplementationSection) and not (Declarations is TProgramSection)) then
           begin
+          SetBlock(declNone);
           ParseFinalization;
           break;
           end;
       tkUses:
-        if Declarations is TPasSection then
-          ParseUsesList(TPasSection(Declarations))
+        if Declarations.ClassType=TInterfaceSection then
+          ParseExcTokenError(TokenInfos[tkimplementation])
+        else if Declarations is TPasSection then
+          ParseExcTokenError(TokenInfos[tkend])
         else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       tkConst:
-        CurBlock := declConst;
+        SetBlock(declConst);
       tkexports:
-        CurBlock := declExports;
+        SetBlock(declExports);
       tkResourcestring:
-        CurBlock := declResourcestring;
+        SetBlock(declResourcestring);
       tkType:
-        CurBlock := declType;
+        SetBlock(declType);
       tkVar:
-        CurBlock := declVar;
+        SetBlock(declVar);
       tkThreadVar:
-        CurBlock := declThreadVar;
+        SetBlock(declThreadVar);
       tkProperty:
-        CurBlock := declProperty;
+        SetBlock(declProperty);
       tkProcedure, tkFunction, tkConstructor, tkDestructor,tkOperator:
         begin
+        SetBlock(declNone);
         SaveComments;
         pt:=GetProcTypeFromToken(CurToken);
         AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
-        CurBlock := declNone;
         end;
       tkClass:
         begin
+          SetBlock(declNone);
           SaveComments;
           NextToken;
           If CurToken in [tkprocedure,tkFunction,tkConstructor, tkDestructor] then
             begin
             pt:=GetProcTypeFromToken(CurToken,True);
             AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt));
-            CurBlock := declNone;
             end
           else
             ExpectToken(tkprocedure);
@@ -2085,11 +2987,13 @@ begin
               end;
             declType:
               begin
-                TypeEl := ParseTypeDecl(Declarations);
-                if Assigned(TypeEl) then        // !!!
+              TypeEl := ParseTypeDecl(Declarations);
+              // Scanner.SetForceCaret(OldForceCaret); // It may have been switched off
+              if Assigned(TypeEl) then        // !!!
                 begin
                   Declarations.Declarations.Add(TypeEl);
-                  if TypeEl.ClassType = TPasClassType then
+                  if (TypeEl.ClassType = TPasClassType)
+                      and (not (po_keepclassforward in Options)) then
                   begin
                     // Remove previous forward declarations, if necessary
                     for i := 0 to Declarations.Classes.Count - 1 do
@@ -2119,12 +3023,14 @@ begin
               begin
               List := TFPList.Create;
               try
+                ok:=false;
                 try
                   ParseExportDecl(Declarations, List);
-                except
-                  for i := 0 to List.Count - 1 do
-                    TPasExportSymbol(List[i]).Release;
-                  raise;
+                  ok:=true;
+                finally
+                  if not ok then
+                    for i := 0 to List.Count - 1 do
+                      TPasExportSymbol(List[i]).Release;
                 end;
                 for i := 0 to List.Count - 1 do
                 begin
@@ -2140,135 +3046,293 @@ begin
               begin
                 List := TFPList.Create;
                 try
-                  try
-                    ParseVarDecl(Declarations, List);
-                  except
-                    for i := 0 to List.Count - 1 do
-                      TPasVariable(List[i]).Release;
-                    raise;
-                  end;
+                  ParseVarDecl(Declarations, List);
                   for i := 0 to List.Count - 1 do
                   begin
                     VarEl := TPasVariable(List[i]);
+                    Engine.FinishScope(stDeclaration,VarEl);
                     Declarations.Declarations.Add(VarEl);
                     Declarations.Variables.Add(VarEl);
                   end;
+                  CheckToken(tkSemicolon);
                 finally
                   List.Free;
                 end;
               end;
             declProperty:
               begin
-              PropEl:=ParseProperty(Declarations,CurtokenString,visDefault);
+              PropEl:=ParseProperty(Declarations,CurtokenString,visDefault,false);
               Declarations.Declarations.Add(PropEl);
-              Declarations.properties.add(PropEl);
+              Declarations.Properties.Add(PropEl);
               end;
           else
-            ParseExc(SParserSyntaxError);
+            ParseExcSyntaxError;
           end;
         end;
       tkGeneric:
         begin
           if CurBlock <> declType then
-            ParseExc(SParserSyntaxError);
+            ParseExcSyntaxError;
           TypeName := ExpectIdentifier;
-          ClassEl := TPasClassType(Engine.CreateElement(TPasClassType,TypeName,Declarations, Scanner.CurFilename, Scanner.CurRow));
-          ClassEl.ObjKind:=okGeneric;
+          NamePos:=CurSourcePos;
+          List:=TFPList.Create;
           try
-            ReadGenericArguments(ClassEl.GenericTemplateTypes,ClassEl);
-          Except
+            ReadGenericArguments(List,Nil);
+            ExpectToken(tkEqual);
+            NextToken;
+            Case CurToken of
+              tkObject,
+              tkClass :
+                 begin
+                 ClassEl := TPasClassType(CreateElement(TPasClassType,
+                   TypeName, Declarations, NamePos));
+                 ClassEl.SetGenericTemplates(List);
+                 NextToken;
+                 DoParseClassType(ClassEl);
+                 Declarations.Declarations.Add(ClassEl);
+                 Declarations.Classes.Add(ClassEl);
+                 CheckHint(classel,True);
+                 Engine.FinishScope(stTypeDef,ClassEl);
+                 end;
+              tkRecord:
+                begin
+                RecordEl := TPasRecordType(CreateElement(TPasRecordType,
+                  TypeName, Declarations, NamePos));
+                RecordEl.SetGenericTemplates(List);
+                NextToken;
+                ParseRecordFieldList(RecordEl,tkend,true);
+                Declarations.Declarations.Add(RecordEl);
+                Declarations.Classes.Add(RecordEl);
+                CheckHint(RecordEl,True);
+                Engine.FinishScope(stTypeDef,RecordEl);
+                end;
+              tkArray:
+                 begin
+                 if List.Count<>1 then
+                   ParseExc(nParserGenericArray1Element,sParserGenericArray1Element);
+                 ArrEl:=TPasArrayType(ParseArrayType(Declarations,NamePos,TypeName,pmNone));
+                 CheckHint(ArrEl,True);
+                 ArrEl.ElType.Release;
+                 ArrEl.ElType:=TPasGenericTemplateType(List[0]);
+                 Declarations.Declarations.Add(ArrEl);
+                 Declarations.Types.Add(ArrEl);
+                 Engine.FinishScope(stTypeDef,ArrEl);
+                 end;
+            else
+              ParseExc(nParserGenericClassOrArray,SParserGenericClassOrArray);
+            end;
+          finally
             List.Free;
-            Raise;
           end;
-          ExpectToken(tkEqual);
-          ExpectToken(tkClass);
-          NextToken;
-          DoParseClassType(ClassEl);
-          Declarations.Declarations.Add(ClassEl);
-          Declarations.Classes.Add(ClassEl);
-          CheckHint(classel,True);
         end;
       tkbegin:
         begin
         if Declarations is TProcedureBody then
           begin
+          Proc:=Declarations.Parent as TPasProcedure;
+          if pmAssembler in Proc.Modifiers then
+            ParseExc(nParserExpectTokenError,SParserExpectTokenError,['asm']);
+          SetBlock(declNone);
           ParseProcBeginBlock(TProcedureBody(Declarations));
           break;
           end
         else if (Declarations is TInterfaceSection)
         or (Declarations is TImplementationSection) then
           begin
+          SetBlock(declNone);
           ParseInitialization;
           break;
           end
         else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
+        end;
+      tkasm:
+        begin
+        if Declarations is TProcedureBody then
+          begin
+          Proc:=Declarations.Parent as TPasProcedure;
+          // Assembler keyword is optional in Delphi mode (bug 31690)
+          if not ((pmAssembler in Proc.Modifiers) or (msDelphi in CurrentModeswitches)) then
+            ParseExc(nParserExpectTokenError,SParserExpectTokenError,['begin']);
+          SetBlock(declNone);
+          ParseProcAsmBlock(TProcedureBody(Declarations));
+          break;
+          end
+        else
+          ParseExcSyntaxError;
         end;
       tklabel:
         begin
+          SetBlock(declNone);
           if not (Declarations is TInterfaceSection) then
             ParseLabels(Declarations);
         end;
     else
-      ParseExc(SParserSyntaxError);
+      ParseExcSyntaxError;
     end;
   end;
+  SetBlock(declNone);
 end;
 
-// Starts after the "uses" token
-procedure TPasParser.ParseUsesList(ASection: TPasSection);
+function TPasParser.AddUseUnit(ASection: TPasSection;
+  const NamePos: TPasSourcePos; AUnitName: string; NameExpr: TPasExpr;
+  InFileExpr: TPrimitiveExpr): TPasElement;
 
-  function CheckUnit(AUnitName : string):TPasElement;
+  procedure CheckDuplicateInUsesList(AUnitName : string; UsesClause: TPasUsesClause);
+  var
+    i: Integer;
   begin
-    result := Engine.FindModule(AUnitName);  // should we resolve module here when "IN" filename is not known yet?
-    if Assigned(result) then
-      result.AddRef
+    if UsesClause=nil then exit;
+    for i:=0 to length(UsesClause)-1 do
+      if CompareText(AUnitName,UsesClause[i].Name)=0 then
+        ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
+  end;
+
+var
+  UnitRef: TPasElement;
+  UsesUnit: TPasUsesUnit;
+begin
+  Result:=nil;
+  UsesUnit:=nil;
+  try
+    {$IFDEF VerbosePasParser}
+    writeln('TPasParser.AddUseUnit AUnitName=',AUnitName,' CurModule.Name=',CurModule.Name);
+    {$ENDIF}
+    if CompareText(AUnitName,CurModule.Name)=0 then
+      begin
+      if CompareText(AUnitName,'System')=0 then
+        exit; // for compatibility ignore implicit use of system in system
+      ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
+      end;
+    CheckDuplicateInUsesList(AUnitName,ASection.UsesClause);
+    if ASection.ClassType=TImplementationSection then
+      CheckDuplicateInUsesList(AUnitName,CurModule.InterfaceSection.UsesClause);
+
+    UnitRef := Engine.FindModule(AUnitName);  // should we resolve module here when "IN" filename is not known yet?
+    if Assigned(UnitRef) then
+      UnitRef.AddRef
     else
-      Result := TPasType(CreateElement(TPasUnresolvedUnitRef, AUnitName,
-        ASection));
-    ASection.UsesList.Add(Result);
+      UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
+        AUnitName, ASection));
+
+    UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
+    Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);
+    if InFileExpr<>nil then
+      begin
+      if UnitRef is TPasModule then
+        begin
+        if TPasModule(UnitRef).Filename='' then
+          TPasModule(UnitRef).Filename:=InFileExpr.Value;
+        end
+      else if UnitRef is TPasUnresolvedUnitRef then
+        TPasUnresolvedUnitRef(UnitRef).FileName:=InFileExpr.Value;
+      end;
+  finally
+    if Result=nil then
+      begin
+      if UsesUnit<>nil then
+        UsesUnit.Release;
+      if NameExpr<>nil then
+        NameExpr.Release;
+      if InFileExpr<>nil then
+        InFileExpr.Release;
+      end;
   end;
+end;
 
+procedure TPasParser.CheckImplicitUsedUnits(ASection: TPasSection);
 var
-  AUnitName: String;
-  Element: TPasElement;
+  i: Integer;
+  NamePos: TPasSourcePos;
 begin
-  If not (Asection.ClassType=TImplementationSection) Then // interface,program,library,package
-    Element:=CheckUnit('System'); // system always implicitely first.    
-  Repeat
-    AUnitName := ExpectIdentifier; 
-    NextToken;
-    while CurToken = tkDot do
+  If not (ASection.ClassType=TImplementationSection) Then // interface,program,library,package
     begin
-      ExpectIdentifier;
-      AUnitName := AUnitName + '.' + CurTokenString;
-      NextToken;
+    // load implicit units, like 'System'
+    NamePos:=CurSourcePos;
+    for i:=0 to ImplicitUses.Count-1 do
+      AddUseUnit(ASection,NamePos,ImplicitUses[i],nil,nil);
     end;
-    Element := CheckUnit(AUnitName);
-    if (CurToken=tkin) then
-      begin
-      ExpectToken(tkString);
-      if (Element is TPasModule) and (TPasmodule(Element).filename='')  then
-        TPasModule(Element).FileName:=curtokenstring
-      else if (Element is TPasUnresolvedUnitRef) then
-        TPasUnresolvedUnitRef(Element).FileName:=curtokenstring;
+end;
+
+// Starts after the "uses" token
+procedure TPasParser.ParseUsesList(ASection: TPasSection);
+var
+  AUnitName, aName: String;
+  NameExpr: TPasExpr;
+  InFileExpr: TPrimitiveExpr;
+  FreeExpr: Boolean;
+  NamePos: TPasSourcePos;
+begin
+  CheckImplicitUsedUnits(ASection);
+
+  NameExpr:=nil;
+  InFileExpr:=nil;
+  FreeExpr:=true;
+  try
+    Repeat
+      FreeExpr:=true;
+      AUnitName := ExpectIdentifier;
+      NamePos:=CurSourcePos;
+      NameExpr:=CreatePrimitiveExpr(ASection,pekString,AUnitName);
       NextToken;
+      while CurToken = tkDot do
+      begin
+        ExpectIdentifier;
+        aName:=CurTokenString;
+        AUnitName := AUnitName + '.' + aName;
+        AddToBinaryExprChain(NameExpr,CreatePrimitiveExpr(ASection,pekString,aName),eopSubIdent);
+        NextToken;
       end;
+      if (CurToken=tkin) then
+        begin
+        ExpectToken(tkString);
+        InFileExpr:=CreatePrimitiveExpr(ASection,pekString,CurTokenString);
+        NextToken;
+        end;
+      FreeExpr:=false;
+      AddUseUnit(ASection,NamePos,AUnitName,NameExpr,InFileExpr);
+      InFileExpr:=nil;
+      NameExpr:=nil;
+
+      if Not (CurToken in [tkComma,tkSemicolon]) then
+        ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
+    Until (CurToken=tkSemicolon);
+  finally
+    if FreeExpr then
+      begin
+      NameExpr.Release;
+      InFileExpr.Release;
+      end;
+  end;
 
-    if Not (CurToken in [tkComma,tkSemicolon]) then
-      ParseExc(SParserExpectedCommaSemicolon);
-  Until (CurToken=tkSemicolon);
+  Engine.FinishScope(stUsesClause,ASection);
 end;
 
 // Starts after the variable name
 function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst;
+
+var
+  OldForceCaret,ok: Boolean;
+
 begin
   SaveComments;
   Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent));
+  if Parent is TPasClassType then
+    Include(Result.VarModifiers,vmClass);
+  ok:=false;
   try
     NextToken;
     if CurToken = tkColon then
-      Result.VarType := ParseType(nil)
+      begin
+      OldForceCaret:=Scanner.SetForceCaret(True);
+      try
+        Result.VarType := ParseType(Result,CurSourcePos);
+      finally
+        Scanner.SetForceCaret(OldForceCaret);
+      end;
+{      if Result.VarType is TPasRangeType then
+        Ungettoken; // Range type stops on token after last range token}
+      end
     else
       UngetToken;
     ExpectToken(tkEqual);
@@ -2276,26 +3340,32 @@ begin
     Result.Expr:=DoParseConstValueExpression(Result);
     UngetToken;
     CheckHint(Result,True);
-  except
-    Result.Free;
-    raise;
+    ok:=true;
+  finally
+    if not ok then
+      ReleaseAndNil(TPasElement(Result));
   end;
+  Engine.FinishScope(stConstDef,Result);
 end;
 
 // Starts after the variable name
 function TPasParser.ParseResourcestringDecl(Parent: TPasElement): TPasResString;
+var
+  ok: Boolean;
 begin
   SaveComments;
   Result := TPasResString(CreateElement(TPasResString, CurTokenString, Parent));
+  ok:=false;
   try
     ExpectToken(tkEqual);
     NextToken; // skip tkEqual
     Result.Expr:=DoParseConstValueExpression(Result);
     UngetToken;
     CheckHint(Result,True);
-  except
-    Result.Free;
-    raise;
+    ok:=true;
+  finally
+    if not ok then
+      ReleaseAndNil(TPasElement(Result));
   end;
 end;
 
@@ -2311,39 +3381,144 @@ begin
     List.Add(CreateElement(TPasGenericTemplateType,N,Parent));
     NextToken;
     if not (CurToken in [tkComma, tkGreaterThan]) then
-      ParseExc(Format(SParserExpectToken2Error,
-        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]));
+      ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
   until CurToken = tkGreaterThan;
 end;
 
+procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
+
+Var
+  Name : String;
+  Ref: TPasType;
+  IsNested: Boolean;
+  NestedSpec: TPasSpecializeType;
+  Expr: TPasExpr;
+
+begin
+  CheckToken(tkLessThan);
+  NextToken;
+  Expr:=nil;
+  Ref:=nil;
+  NestedSpec:=nil;
+  try
+    repeat
+      if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
+        begin
+        IsNested:=true;
+        NextToken;
+        end
+      else
+        IsNested:=false;
+      // read dotted identifier
+      CheckToken(tkIdentifier);
+      Expr:=nil;
+      Name:=ReadDottedIdentifier(Spec,Expr,true);
+
+      if CurToken=tkLessThan then
+        begin
+        // nested specialize
+        // resolve type
+        Ref:=ResolveTypeReference(Name,Spec);
+        // create nested specialize
+        NestedSpec:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',Spec));
+        NestedSpec.DestType:=Ref;
+        Ref:=nil;
+        NestedSpec.Expr:=Expr;
+        Expr:=nil;
+        // read nested specialize arguments
+        ReadSpecializeArguments(NestedSpec);
+        // add nested specialize
+        Spec.AddParam(NestedSpec);
+        NestedSpec:=nil;
+        NextToken;
+        end
+      else if IsNested then
+        CheckToken(tkLessThan)
+      else
+        begin
+        // simple type reference
+        Spec.AddParam(Expr);
+        Expr:=nil;
+        end;
+
+      if CurToken=tkComma then
+        begin
+        NextToken;
+        continue;
+        end
+      else if CurToken=tkshr then
+        begin
+        ChangeToken(tkGreaterThan);
+        break;
+        end
+      else if CurToken=tkGreaterThan then
+        break
+      else
+        ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+          [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
+    until false;
+  finally
+    Expr.Free;
+    if Ref<>nil then Ref.Release;
+    if NestedSpec<>nil then NestedSpec.Release;
+  end;
+end;
+
+function TPasParser.ReadDottedIdentifier(Parent: TPasElement; out
+  Expr: TPasExpr; NeedAsString: boolean): String;
+begin
+  Expr:=nil;
+  if NeedAsString then
+    Result := CurTokenString
+  else
+    Result:='';
+  CheckToken(tkIdentifier);
+  Expr:=CreatePrimitiveExpr(Parent,pekIdent,Result);
+  NextToken;
+  while CurToken=tkDot do
+    begin
+    ExpectIdentifier;
+    if NeedAsString then
+      Result := Result+'.'+CurTokenString;
+    AddToBinaryExprChain(Expr,CreatePrimitiveExpr(Parent,pekIdent,CurTokenString),eopSubIdent);
+    NextToken;
+    end;
+end;
+
 // Starts after the type name
 function TPasParser.ParseRangeType(AParent: TPasElement;
-  const TypeName: String; Full: Boolean): TPasRangeType;
+  const NamePos: TPasSourcePos; const TypeName: String; Full: Boolean
+  ): TPasRangeType;
 
 Var
   PE : TPasExpr;
+  ok: Boolean;
 
 begin
-  Result := TPasRangeType(CreateElement(TPasRangeType, TypeName, AParent));
+  Result := TPasRangeType(CreateElement(TPasRangeType, TypeName, AParent, NamePos));
+  ok:=false;
   try
     if Full then
       begin
       If not (CurToken=tkEqual) then
-        ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkEqual]]));
+        ParseExcTokenError(TokenInfos[tkEqual]);
       end;
     NextToken;
-    PE:=DoParseExpression(Result,Nil);
+    PE:=DoParseExpression(Result,Nil,False);
     if not ((PE is TBinaryExpr) and (TBinaryExpr(PE).Kind=pekRange)) then
       begin
-      FreeAndNil(PE);
-      ParseExc(SRangeExpressionExpected);
+      PE.Release;
+      ParseExc(nRangeExpressionExpected,SRangeExpressionExpected);
       end;
     Result.RangeExpr:=PE as TBinaryExpr;
     UngetToken;
-  except
-    FreeAndNil(Result);
-    raise;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
+  Engine.FinishScope(stTypeDef,Result);
 end;
 
 // Starts after Exports, on first identifier.
@@ -2368,39 +3543,36 @@ begin
       E.ExportName:=DoParseExpression(E,Nil)
       end;
     if not (CurToken in [tkComma,tkSemicolon]) then
-      ParseExc(SParserExpectedCommaSemicolon);
+      ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon);
   until (CurToken=tkSemicolon);
 end;
 
 function TPasParser.ParseSpecializeType(Parent: TPasElement;
-  const TypeName: String): TPasClassType;
+  const TypeName: String): TPasSpecializeType;
 
 begin
-  Result := TPasClassType(Engine.CreateElement(TPasClassType, TypeName, Parent, Scanner.CurFilename, Scanner.CurRow));
-  try
-    Result.ObjKind := okSpecialize;
-    Result.AncestorType := ParseType(nil);
-    Result.IsShortDefinition:=True;
-    ReadGenericArguments(TPasClassType(Result).GenericTemplateTypes,Result);
-  except
-    FreeAndNil(Result);
-    Raise;
-  end;
+  NextToken;
+  Result:=ParseSimpleType(Parent,CurSourcePos,TypeName) as TPasSpecializeType;
 end;
 
 function TPasParser.ParseProcedureType(Parent: TPasElement;
-  const TypeName: String; const PT: TProcType): TPasProcedureType;
+  const NamePos: TPasSourcePos; const TypeName: String; const PT: TProcType
+  ): TPasProcedureType;
 
+var
+  ok: Boolean;
 begin
   if PT in [ptFunction,ptClassFunction] then
-    Result := CreateFunctionType(TypeName, 'Result', Parent, False)
+    Result := CreateFunctionType(TypeName, 'Result', Parent, False, NamePos)
   else
-    Result := TPasProcedureType(CreateElement(TPasProcedureType, TypeName, Parent));
+    Result := TPasProcedureType(CreateElement(TPasProcedureType, TypeName, Parent, NamePos));
+  ok:=false;
   try
     ParseProcedureOrFunctionHeader(Result, TPasProcedureType(Result), PT, True);
-  except
-    FreeAndNil(Result);
-    raise;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
 end;
 
@@ -2408,10 +3580,28 @@ function TPasParser.ParseTypeDecl(Parent: TPasElement): TPasType;
 
 var
   TypeName: String;
+  NamePos: TPasSourcePos;
+  OldForceCaret : Boolean;
+  List : TFPList;
+
 begin
   TypeName := CurTokenString;
-  ExpectToken(tkEqual);
-  Result:=ParseType(Parent,TypeName,True);
+  NamePos:=CurSourcePos;
+  List:=Nil;
+  OldForceCaret:=Scanner.SetForceCaret(True);
+  try
+    NextToken;
+    if (CurToken=tkLessThan) and (msDelphi in CurrentModeswitches) then
+      List:=TFPList.Create;
+    UnGetToken; // ReadGenericArguments starts at <
+    if Assigned(List) then
+      ReadGenericArguments(List,Parent);
+    ExpectToken(tkEqual);
+    Result:=ParseType(Parent,NamePos,TypeName,True,List);
+  finally
+    Scanner.SetForceCaret(OldForceCaret);
+    List.Free;
+  end;
 end;
 
 function TPasParser.GetVariableValueAndLocation(Parent: TPasElement; out
@@ -2433,28 +3623,32 @@ begin
     ExpectIdentifier;
     Location:=CurTokenText;
     NextToken;
-    if CurToken=tkDot then
+    While CurToken=tkDot do
       begin
       ExpectIdentifier;
       Location:=Location+'.'+CurTokenText;
-      end
-    else
-      UnGetToken;
+      NextToken;
+      end;
+    UnGetToken;
     end
   else
     UngetToken;
 end;
 
-function TPasParser.GetVariableModifiers(out VarMods: TVariableModifiers; out
-  Libname, ExportName: string): string;
+function TPasParser.GetVariableModifiers(Parent: TPasElement; out
+  VarMods: TVariableModifiers; out LibName, ExportName: TPasExpr;
+  ExternalClass: Boolean): string;
 
 Var
   S : String;
+  ExtMod: TVariableModifier;
 begin
   Result := '';
+  LibName := nil;
+  ExportName := nil;
   VarMods := [];
   NextToken;
-  If CurTokenIsIdentifier('cvar') then
+  If CurTokenIsIdentifier('cvar') and not ExternalClass then
     begin
     Result:=';cvar';
     Include(VarMods,vmcvar);
@@ -2462,111 +3656,166 @@ begin
     NextToken;
     end;
   s:=LowerCase(CurTokenText);
-  if Not ((s='external') or (s='public') or (s='export')) then
-    UngetToken
+  if s='external' then
+    ExtMod:=vmExternal
+  else if (s='public') and not externalclass then
+    ExtMod:=vmPublic
+  else if (s='export') and not externalclass then
+    ExtMod:=vmExport
   else
     begin
-    if s='external' then
-      Include(VarMods,vmexternal)
-    else if (s='public') then
-      Include(varMods,vmpublic)
-    else if (s='export') then
-      Include(varMods,vmexport);
-    Result:=Result+';'+CurTokenText;
-    NextToken;
-    if (Curtoken<>tksemicolon) then
-      begin
-      if (s='external') then
-        begin
-        Include(VarMods,vmexternal);
-        if (CurToken in [tkString,tkIdentifier])
-            and Not (CurTokenIsIdentifier('name')) then
-          begin
-          Result := Result + ' ' + CurTokenText;
-          LibName:=CurTokenText;
-          NextToken;
-          end;
-        end;
-      if CurTokenIsIdentifier('name') then
-        begin
-        Result := Result + ' name ';
-        NextToken;
-        if (CurToken in [tkString,tkIdentifier]) then
-          Result := Result + CurTokenText
-        else
-          ParseExc(SParserSyntaxError);
-        ExportName:=CurTokenText;
-        NextToken;
-        end
-      else
-        ParseExc(SParserSyntaxError);
-      end;
+    UngetToken;
+    exit;
     end;
+  Include(varMods,ExtMod);
+  Result:=Result+';'+CurTokenText;
+
+  NextToken;
+  if not (CurToken in [tkString,tkIdentifier]) then
+    begin
+    if (CurToken=tkSemicolon) and (ExtMod in [vmExternal,vmPublic]) then
+      exit;
+    ParseExcSyntaxError;
+    end;
+  // export name exportname;
+  // public;
+  // public name exportname;
+  // external;
+  // external libname;
+  // external libname name exportname;
+  // external name exportname;
+  if (ExtMod=vmExternal) and (CurToken in [tkString,tkIdentifier])
+      and Not (CurTokenIsIdentifier('name')) and not ExternalClass then
+    begin
+    Result := Result + ' ' + CurTokenText;
+    LibName:=DoParseExpression(Parent);
+    end;
+  if not CurTokenIsIdentifier('name') then
+    ParseExcSyntaxError;
+  NextToken;
+  if not (CurToken in [tkChar,tkString,tkIdentifier]) then
+    ParseExcTokenError(TokenInfos[tkString]);
+  Result := Result + ' ' + CurTokenText;
+  ExportName:=DoParseExpression(Parent);
 end;
 
 
 // Full means that a full variable declaration is being parsed.
-procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList; AVisibility: TPasMemberVisibility; Full : Boolean);
+procedure TPasParser.ParseVarList(Parent: TPasElement; VarList: TFPList;
+  AVisibility: TPasMemberVisibility; Full : Boolean);
+// on Exception the VarList is restored, no need to Release the new elements
 
 var
-  VarNames: TStringList;
-  i: Integer;
-  Value : TPasExpr;
+  i, OldListCount: Integer;
+  Value , aLibName, aExpName: TPasExpr;
   VarType: TPasType;
   VarEl: TPasVariable;
   H : TPasMemberHints;
-  varmods: TVariableModifiers;
-  D,Mods,Loc,alibname,aexpname : string;
+  VarMods: TVariableModifiers;
+  D,Mods,Loc: string;
+  OldForceCaret,ok,ExternalClass: Boolean;
 
 begin
-  VarNames := TStringList.Create;
+  Value:=Nil;
+  aLibName:=nil;
+  aExpName:=nil;
+  OldListCount:=VarList.Count;
+  ok:=false;
   try
     D:=SaveComments; // This means we support only one comment per 'list'.
+    VarEl:=nil;
     Repeat
-      VarNames.Add(CurTokenString);
+      // create the TPasVariable here, so that SourceLineNumber is correct
+      VarEl:=TPasVariable(CreateElement(TPasVariable,CurTokenString,Parent,AVisibility));
+      VarList.Add(VarEl);
       NextToken;
       if Not (CurToken in [tkComma,tkColon]) then
-        ParseExc(SParserExpectedCommaColon);
+        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
       if CurToken=tkComma then
         ExpectIdentifier;
     Until (CurToken=tkColon);
-    If Full then
-      VarType := ParseComplexType(Nil)
-    else
-      VarType := ParseComplexType(Parent);
-    Value:=Nil;
+    OldForceCaret:=Scanner.SetForceCaret(True);
+    try
+      VarType := ParseComplexType(VarEl);
+    finally
+      Scanner.SetForceCaret(OldForceCaret);
+    end;
+    // read type
+    for i := OldListCount to VarList.Count - 1 do
+      begin
+      VarEl:=TPasVariable(VarList[i]);
+      // Writeln(VarEl.Name, AVisibility);
+      VarEl.VarType := VarType;
+      //VarType.Parent := VarEl; // this is wrong for references
+      if (i>OldListCount) then
+        VarType.AddRef;
+      end;
+
     H:=CheckHint(Nil,False);
     If Full then
       GetVariableValueAndLocation(Parent,Value,Loc);
-    H:=H+CheckHint(Nil,Full);
-    if full then
-      Mods:=GetVariableModifiers(varmods,alibname,aexpname)
+    if (Value<>nil) and (VarList.Count>OldListCount+1) then
+      ParseExc(nParserOnlyOneVariableCanBeInitialized,SParserOnlyOneVariableCanBeInitialized);
+    TPasVariable(VarList[OldListCount]).Expr:=Value;
+    Value:=nil;
+
+    // Note: external members are allowed for non external classes too
+    ExternalClass:=(msExternalClass in CurrentModeSwitches)
+                    and (Parent is TPasClassType);
+
+    H:=H+CheckHint(Nil,False);
+    if Full or Externalclass then
+      begin
+      NextToken;
+      If Curtoken<>tkSemicolon then
+        UnGetToken;
+      Mods:=GetVariableModifiers(Parent,VarMods,aLibName,aExpName,ExternalClass);
+      if (mods='') and (CurToken<>tkSemicolon) then
+        NextToken;
+      end
     else
+      begin
       NextToken;
+      VarMods:=[];
+      Mods:='';
+      end;
     SaveComments(D);
-    for i := 0 to VarNames.Count - 1 do
+
+    // connect
+    for i := OldListCount to VarList.Count - 1 do
       begin
-      // Writeln(VarNames[i], AVisibility);
-      VarEl:=TPasVariable(CreateElement(TPasVariable,VarNames[i],Parent,AVisibility));
-      VarEl.VarType := VarType;
+      VarEl:=TPasVariable(VarList[i]);
+      // Writeln(VarEl.Name, AVisibility);
       // Procedure declaration eats the hints.
-      if Assigned(VarType) and (VarType is TPasprocedureType) then
+      if Assigned(VarType) and (VarType is TPasProcedureType) then
         VarEl.Hints:=VarType.Hints
       else
         VarEl.Hints:=H;
-      Varel.Modifiers:=Mods;
-      Varel.VarModifiers:=VarMods;
-      if (i=0) then
-        VarEl.Expr:=Value;
+      VarEl.Modifiers:=Mods;
+      VarEl.VarModifiers:=VarMods;
       VarEl.AbsoluteLocation:=Loc;
-      VarEl.LibraryName:=alibName;
-      VarEl.ExportName:=aexpname;
-      if (i>0) then
-        VarType.AddRef;
-      VarList.Add(VarEl);
+      if aLibName<>nil then
+        begin
+        VarEl.LibraryName:=aLibName;
+        aLibName.AddRef;
+        end;
+      if aExpName<>nil then
+        begin
+        VarEl.ExportName:=aExpName;
+        aExpName.AddRef;
+        end;
       end;
+    ok:=true;
   finally
-    VarNames.Free;
+    if aLibName<>nil then aLibName.Release;
+    if aExpName<>nil then aExpName.Release;
+    if not ok then
+      begin
+        if Value<>nil then Value.Release;
+        for i:=OldListCount to VarList.Count-1 do
+          TPasElement(VarList[i]).Release;
+        VarList.Count:=OldListCount;
+      end;
   end;
 end;
 
@@ -2596,19 +3845,31 @@ begin
   Result:=E in FLogEvents;
 end;
 
-procedure TPasParser.DoLog(const Msg: String; SkipSourceInfo: Boolean);
+procedure TPasParser.SetLastMsg(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const);
 begin
-  If Assigned(FOnLog) then
-    if SkipSourceInfo or not assigned(scanner) then
-      FOnLog(Self,Msg)
-    else
-      FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,SCanner.CurRow,Msg]));
+  FLastMsgType := MsgType;
+  FLastMsgNumber := MsgNumber;
+  FLastMsgPattern := Fmt;
+  FLastMsg := SafeFormat(Fmt,Args);
+  CreateMsgArgs(FLastMsgArgs,Args);
 end;
 
-procedure TPasParser.DoLog(const Fmt: String; Args: array of const;
-  SkipSourceInfo: Boolean);
+procedure TPasParser.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Msg: String; SkipSourceInfo: Boolean);
 begin
-  DoLog(Format(Fmt,Args),SkipSourceInfo);
+  DoLog(MsgType,MsgNumber,Msg,[],SkipSourceInfo);
+end;
+
+procedure TPasParser.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const; SkipSourceInfo: Boolean);
+begin
+  SetLastMsg(MsgType,MsgNumber,Fmt,Args);
+  If Assigned(FOnLog) then
+    if SkipSourceInfo or not assigned(scanner) then
+      FOnLog(Self,FLastMsg)
+    else
+      FOnLog(Self,Format('%s(%d) : %s',[Scanner.CurFilename,Scanner.CurRow,FLastMsg]));
 end;
 
 procedure TPasParser.ParseInlineVarDecl(Parent: TPasElement; List: TFPList;
@@ -2622,121 +3883,133 @@ begin
   if ClosingBrace then
    include(tt,tkBraceClose);
   if not (CurToken in tt) then
-    ParseExc(SParserExpectedSemiColonEnd);
+    ParseExc(nParserExpectedSemiColonEnd,SParserExpectedSemiColonEnd);
 end;
 
 // Starts after the variable name
 procedure TPasParser.ParseVarDecl(Parent: TPasElement; List: TFPList);
 
 begin
-  ParseVarList(Parent,list,visDefault,True);
+  ParseVarList(Parent,List,visDefault,True);
 end;
 
 // Starts after the opening bracket token
 procedure TPasParser.ParseArgList(Parent: TPasElement; Args: TFPList; EndToken: TToken);
 var
-  ArgNames: TStringList;
-  IsUntyped: Boolean;
+  IsUntyped, ok, LastHadDefaultValue: Boolean;
   Name : String;
   Value : TPasExpr;
-  i: Integer;
+  i, OldArgCount: Integer;
   Arg: TPasArgument;
   Access: TArgumentAccess;
   ArgType: TPasType;
 begin
-  ArgNames := TStringList.Create;
-  try
+  LastHadDefaultValue := false;
+  while True do
+  begin
+    OldArgCount:=Args.Count;
+    Access := argDefault;
+    IsUntyped := False;
+    ArgType := nil;
     while True do
     begin
-      ArgNames.Clear;
-      Access := argDefault;
-      IsUntyped := False;
-      ArgType := nil;
-      while True do
+      NextToken;
+      if CurToken = tkConst then
       begin
+        Access := argConst;
+        Name := ExpectIdentifier;
+      end else if CurToken = tkConstRef then
+      begin
+        Access := argConstref;
+        Name := ExpectIdentifier;
+      end else if CurToken = tkVar then
+      begin
+        Access := ArgVar;
+        Name := ExpectIdentifier;
+      end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then
+      begin
+        Access := ArgOut;
+        Name := ExpectIdentifier;
+      end else if CurToken = tkIdentifier then
+        Name := CurTokenString
+      else
+        ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID);
+      Arg := TPasArgument(CreateElement(TPasArgument, Name, Parent));
+      Arg.Access := Access;
+      Args.Add(Arg);
+      NextToken;
+      if CurToken = tkColon then
+        break
+      else if ((CurToken = tkSemicolon) or (CurToken = tkBraceClose)) and
+        (Access <> argDefault) then
+      begin
+        // found an untyped const or var argument
+        UngetToken;
+        IsUntyped := True;
+        break
+      end
+      else if CurToken <> tkComma then
+        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
+    end;
+    Value:=Nil;
+    if not IsUntyped then
+      begin
+      Arg := TPasArgument(Args[0]);
+      ArgType := ParseType(Arg,CurSourcePos);
+      ok:=false;
+      try
         NextToken;
-        if CurToken = tkConst then
-        begin
-          Access := argConst;
-          Name := ExpectIdentifier;
-        end else if CurToken = tkConstRef then
-        begin
-          Access := argConstref;
-          Name := ExpectIdentifier;
-        end else if CurToken = tkVar then
-        begin
-          Access := ArgVar;
-          Name := ExpectIdentifier;
-        end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then
-        begin
-          Access := ArgOut;
-          Name := ExpectIdentifier;
-        end else if CurToken = tkIdentifier then
-          Name := CurTokenString
-        else
-          ParseExc(SParserExpectedConstVarID);
-        ArgNames.Add(Name);
-        NextToken;
-        if CurToken = tkColon then
-          break
-        else if ((CurToken = tkSemicolon) or (CurToken = tkBraceClose)) and
-          (Access <> argDefault) then
-        begin
-          // found an untyped const or var argument
-          UngetToken;
-          IsUntyped := True;
-          break
-        end
-        else if CurToken <> tkComma then
-          ParseExc(SParserExpectedCommaColon);
-      end;
-      Value:=Nil;
-      if not IsUntyped then
-        begin
-        ArgType := ParseType(nil);
-        try
-          NextToken;
-          if CurToken = tkEqual then
+        if CurToken = tkEqual then
+          begin
+          if (Args.Count>OldArgCount+1) then
             begin
-            if (ArgNames.Count>1) then
-              begin
-              FreeAndNil(ArgType);
-              ParseExc(SParserOnlyOneArgumentCanHaveDefault);
-              end;
-            NextToken;
-            Value := DoParseExpression(Parent,Nil);
-            // After this, we're on ), which must be unget.
+            ArgType.Release;
+            ArgType:=nil;
+            ParseExc(nParserOnlyOneArgumentCanHaveDefault,SParserOnlyOneArgumentCanHaveDefault);
             end;
-          UngetToken;
-        except
-          FreeAndNil(ArgType);
-          Raise;
-        end;
-        end;
-
-      for i := 0 to ArgNames.Count - 1 do
-      begin
-        Arg := TPasArgument(CreateElement(TPasArgument, ArgNames[i], Parent));
-        Arg.Access := Access;
-        Arg.ArgType := ArgType;
-        if (i > 0) and Assigned(ArgType) then
-          ArgType.AddRef;
-        Arg.ValueExpr := Value;
-        Value:=Nil; // Only the first gets a value. OK, since Var A,B : Integer = 1 is not allowed.
-        Args.Add(Arg);
+          if Parent is TPasProperty then
+            ParseExc(nParserPropertyArgumentsCanNotHaveDefaultValues,
+              SParserPropertyArgumentsCanNotHaveDefaultValues);
+          NextToken;
+          Value := DoParseExpression(Parent,Nil);
+          // After this, we're on ), which must be unget.
+          LastHadDefaultValue:=true;
+          end
+        else if LastHadDefaultValue then
+          ParseExc(nParserDefaultParameterRequiredFor,
+            SParserDefaultParameterRequiredFor,[TPasArgument(Args[OldArgCount]).Name]);
+        UngetToken;
+        ok:=true;
+      finally
+        if (not ok) and (ArgType<>nil) then
+          ArgType.Release;
+      end;
       end;
 
-      NextToken;
-      if (CurToken = tkIdentifier) and (LowerCase(CurTokenString) = 'location') then
+    for i := OldArgCount to Args.Count - 1 do
+    begin
+      Arg := TPasArgument(Args[i]);
+      Arg.ArgType := ArgType;
+      if Assigned(ArgType) then
         begin
-          NextToken; // remove 'location'
-          NextToken; // remove register
+        if (i > OldArgCount) then
+          ArgType.AddRef;
         end;
-      if CurToken = EndToken then
-        break;
+      Arg.ValueExpr := Value;
+      Value:=Nil; // Only the first gets a value. OK, since Var A,B : Integer = 1 is not allowed.
     end;
-  finally
-    ArgNames.Free;
+
+    for i := OldArgCount to Args.Count - 1 do
+      Engine.FinishScope(stDeclaration,TPasArgument(Args[i]));
+
+    NextToken;
+    if (CurToken = tkIdentifier) and (LowerCase(CurTokenString) = 'location') then
+      begin
+        NextToken; // remove 'location'
+        NextToken; // remove register
+      end;
+    if CurToken = EndToken then
+      break;
   end;
 end;
 
@@ -2746,16 +4019,10 @@ function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
 
 begin
   NextToken;
-  Result:=(Curtoken=tkbraceOpen);
-  if not Result then
-    begin
-    if Mandatory then
-      ParseExc(SParserExpectedLBracketColon)
-    else
-      UngetToken;
-    end
-  else
+  case CurToken of
+  tkBraceOpen:
     begin
+    Result:=true;
     NextToken;
     if (CurToken<>tkBraceClose) then
       begin
@@ -2763,30 +4030,48 @@ begin
       ParseArgList(Parent, Args, tkBraceClose);
       end;
     end;
+  tkSemicolon,tkColon,tkof,tkis,tkIdentifier:
+    begin
+    Result:=false;
+    if Mandatory then
+      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
+    else
+      UngetToken;
+    end
+  else
+    ParseExcTokenError(';');
+  end;
 end;
 
-procedure TPasParser.HandleProcedureModifier(Parent: TPasElement;pm : TProcedureModifier);
+procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
 
 Var
   Tok : String;
   P : TPasProcedure;
   E : TPasExpr;
 
-begin
-  if parent is TPasProcedure then
-    P:=TPasProcedure(Parent);
-  if Assigned(P) then
+  procedure AddModifier;
+  begin
+    if pm in P.Modifiers then
+      ParseExcSyntaxError;
     P.AddModifier(pm);
-  if (pm=pmExternal) then
+  end;
+
+begin
+  P:=TPasProcedure(Parent);
+  if pm<>pmPublic then
+    AddModifier;
+  Case pm of
+  pmExternal:
     begin
     NextToken;
     if CurToken in [tkString,tkIdentifier] then
       begin
-      // extrenal libname
+      // external libname
       // external libname name XYZ
       // external name XYZ
       Tok:=UpperCase(CurTokenString);
-      if Not ((curtoken=tkIdentifier) and (Tok='NAME')) then
+      if Not ((CurToken=tkIdentifier) and (Tok='NAME')) then
         begin
         E:=DoParseExpression(Parent);
         if Assigned(P) then
@@ -2797,11 +4082,11 @@ begin
       else
         begin
         Tok:=UpperCase(CurTokenString);
-        if ((curtoken=tkIdentifier) and (Tok='NAME')) then
+        if ((CurToken=tkIdentifier) and (Tok='NAME')) then
           begin
           NextToken;
-          if not (CurToken in [tkString,tkIdentifier]) then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkString]]));
+          if not (CurToken in [tkChar,tkString,tkIdentifier]) then
+            ParseExcTokenError(TokenInfos[tkString]);
           E:=DoParseExpression(Parent);
           if Assigned(P) then
             P.LibrarySymbolName:=E;
@@ -2810,84 +4095,136 @@ begin
       end
     else
       UngetToken;
-    end
-  else if (pm = pmPublic) then
+    end;
+  pmPublic:
     begin
     NextToken;
-    { Should be token Name,
-      if not we're in a class and the public section starts }
-    If (Uppercase(CurTokenString)<>'NAME') then
+    If not CurTokenIsIdentifier('name') then
       begin
-      UngetToken;
-      UngetToken;
+      if P.Parent is TPasClassType then
+        begin
+        // public section starts
+        UngetToken;
+        UngetToken;
+        exit;
+        end;
+      AddModifier;
+      CheckToken(tkSemicolon);
       exit;
       end
     else
       begin
+      AddModifier;
       NextToken;  // Should be export name string.
       if not (CurToken in [tkString,tkIdentifier]) then
-        ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkString]]));
+        ParseExcTokenError(TokenInfos[tkString]);
       E:=DoParseExpression(Parent);
-      if parent is TPasProcedure then
+      if Parent is TPasProcedure then
         TPasProcedure(Parent).PublicName:=E;
       if (CurToken <> tkSemicolon) then
-        ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+        ParseExcTokenError(TokenInfos[tkSemicolon]);
       end;
-    end
-  else if (pm=pmForward) then
+    end;
+  pmForward:
     begin
     if (Parent.Parent is TInterfaceSection) then
        begin
-       ParseExc(SParserForwardNotInterface);
+       ParseExc(nParserForwardNotInterface,SParserForwardNotInterface);
        UngetToken;
        end;
-    end
-  else if (pm=pmMessage) then
+    end;
+  pmMessage:
     begin
     Repeat
       NextToken;
       If CurToken<>tkSemicolon then
         begin
-        if parent is TPasProcedure then
+        if Parent is TPasProcedure then
           TPasProcedure(Parent).MessageName:=CurtokenString;
-        If (CurToken=tkString) and (parent is TPasProcedure) then
+        If (CurToken=tkString) and (Parent is TPasProcedure) then
           TPasProcedure(Parent).Messagetype:=pmtString;
         end;
     until CurToken = tkSemicolon;
     UngetToken;
     end;
+  pmDispID:
+    begin
+    TPasProcedure(Parent).DispIDExpr:=DoParseExpression(Parent,Nil);
+    if CurToken = tkSemicolon then
+      UngetToken;
+    end;
+  end; // Case
+end;
+
+procedure TPasParser.HandleProcedureTypeModifier(ProcType: TPasProcedureType;
+  ptm: TProcTypeModifier);
+begin
+  if ptm in ProcType.Modifiers then
+    ParseExcSyntaxError;
+  Include(ProcType.Modifiers,ptm);
 end;
 
 // Next token is expected to be a "(", ";" or for a function ":". The caller
 // will get the token after the final ";" as next token.
-procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
-  Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
 
-  procedure ConsumeSemi;
-  begin
-    NextToken;
-    if (CurToken <> tksemicolon) and IsCurTokenHint then
-      ungettoken;
-  end;
+function TPasParser.DoCheckHint(Element : TPasElement): Boolean;
 
-  function DoCheckHint : Boolean;
+var
+  ahint : TPasMemberHint;
 
-  var
-    ahint : TPasMemberHint;
-  begin
+begin
   Result:= IsCurTokenHint(ahint);
   if Result then  // deprecated,platform,experimental,library, unimplemented etc
     begin
-    element.hints:=element.hints+[ahint];
+    Element.Hints:=Element.Hints+[ahint];
     if aHint=hDeprecated then
       begin
-      nextToken;
+      NextToken;
       if (CurToken<>tkString) then
-        UnGetToken
+        UngetToken
       else
-        element.HintMessage:=curtokenstring;
+        Element.HintMessage:=CurTokenString;
       end;
     end;
+end;
+
+procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
+  Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
+
+  Function FindInSection(AName : String;ASection : TPasSection) : Boolean;
+
+  Var
+    I : integer;
+    Cn,FN : String;
+    CT : TPasClassType;
+
+  begin
+    I:=ASection.Functions.Count-1;
+    While (I>=0) and (CompareText(TPasElement(ASection.Functions[I]).Name,AName)<>0) do
+      Dec(I);
+    Result:=I<>-1;
+    I:=Pos('.',AName);
+    if (Not Result) and (I>0) then
+      begin
+      CN:=Copy(AName,1,I-1);
+      FN:=AName;
+      Delete(FN,1,I);
+      I:=ASection.Classes.Count-1;
+      While Not Result and (I>=0) do
+        begin
+        CT:=TPasClassType(ASection.Classes[i]);
+        if CompareText(CT.Name,CN)=0 then
+          Result:=CT.FindMember(TPasFunction, FN)<>Nil;
+        Dec(I);
+        end;
+      end;
+  end;
+
+  procedure ConsumeSemi;
+  begin
+    NextToken;
+    if (CurToken <> tkSemicolon) and IsCurTokenHint then
+      UngetToken;
   end;
 
 Var
@@ -2895,63 +4232,104 @@ Var
   CC : TCallingConvention;
   PM : TProcedureModifier;
   Done: Boolean;
+  ResultEl: TPasResultElement;
+  OK,IsProc : Boolean;
+  PTM: TProcTypeModifier;
+  ModCount: Integer;
+  LastToken: TToken;
 
 begin
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
-  CheckProcedureArgs(Parent,Element.Args,ProcType in [ptOperator,ptClassOperator]);
+  CheckProcedureArgs(Element,Element.Args,ProcType in [ptOperator,ptClassOperator]);
+  IsProc:=Parent is TPasProcedure;
   case ProcType of
     ptFunction,ptClassFunction:
       begin
-      ExpectToken(tkColon);
-      TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
+      NextToken;
+      if CurToken = tkColon then
+        begin
+        ResultEl:=TPasFunctionType(Element).ResultEl;
+        ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
+        end
+      // In Delphi mode, the implementation in the implementation section can be
+      // without result as it was declared
+      // We actually check if the function exists in the interface section.
+      else if (msDelphi in CurrentModeswitches) and
+              (Assigned(CurModule.ImplementationSection) or
+               (CurModule is TPasProgram)) then
+        begin
+        if Assigned(CurModule.InterfaceSection) then
+          OK:=FindInSection(Parent.Name,CurModule.InterfaceSection)
+        else if (CurModule is TPasProgram) and Assigned(TPasProgram(CurModule).ProgramSection) then
+          OK:=FindInSection(Parent.Name,TPasProgram(CurModule).ProgramSection);
+        if Not OK then
+          CheckToken(tkColon)
+        else
+          begin
+          CheckToken(tkSemiColon);
+          UngetToken;
+          end;
+        end
+      else
+        begin
+        // Raise error
+        CheckToken(tkColon);
+        end;
       end;
     ptOperator,ptClassOperator:
       begin
       NextToken;
+      ResultEl:=TPasFunctionType(Element).ResultEl;
       if (CurToken=tkIdentifier) then
         begin
-        TPasFunctionType(Element).ResultEl.Name := CurTokenName;
+        ResultEl.Name := CurTokenName;
         ExpectToken(tkColon);
         end
       else
         if (CurToken=tkColon) then
-          TPasFunctionType(Element).ResultEl.Name := 'Result'
+          ResultEl.Name := 'Result'
         else
-          ParseExc(SParserExpectedColonID);
-        TPasFunctionType(Element).ResultEl.ResultType := ParseType(Parent)
+          ParseExc(nParserExpectedColonID,SParserExpectedColonID);
+        ResultEl.ResultType := ParseType(ResultEl,CurSourcePos);
       end;
   end;
   if OfObjectPossible then
     begin
     NextToken;
-    if (curToken =tkOf) then
+    if (CurToken = tkOf) then
       begin
       ExpectToken(tkObject);
       Element.IsOfObject := True;
-      end 
-    else if (curToken = tkIs) then
+      end
+    else if (CurToken = tkIs) then
       begin
       expectToken(tkIdentifier);
       if (lowerCase(CurTokenString)<>'nested') then
-        ParseExc(SParserExpectedNested);
-      Element.isNested:=True;
+        ParseExc(nParserExpectedNested,SParserExpectedNested);
+      Element.IsNested:=True;
       end
     else
-      UnGetToken;  
-    end;  
-  NextToken;
-  if CurToken = tkEqual then
-    begin
-    // for example: const p: procedure = nil;
-    UngetToken;
-    exit;
-    end
-  else
-    UngetToken;
+      UnGetToken;
+    end;
+  ModCount:=0;
   Repeat
+    inc(ModCount);
+    // Writeln(modcount, curtokentext);
+    LastToken:=CurToken;
     NextToken;
-    If TokenisCallingConvention(CurTokenString,cc) then
+    if (ModCount in [1,2,3]) and (CurToken = tkEqual) then
+      begin
+      // for example: const p: procedure = nil;
+      UngetToken;
+      exit;
+      end;
+    If CurToken=tkSemicolon then
+      begin
+      if LastToken=tkSemicolon then
+        ParseExcSyntaxError;
+      end
+    else if TokenIsCallingConvention(CurTokenString,cc) then
       begin
       Element.CallingConvention:=Cc;
       if cc = ccSysCall then
@@ -2968,10 +4346,14 @@ begin
           NextToken; // remove offset
           end;
       end;
-      ExpectToken(tkSemicolon);
+      ExpectTokens([tkSemicolon,tkEqual]);
+      if curtoken=tkEqual then
+        ungettoken;
       end
-    else if TokenIsProcedureModifier(Parent,CurTokenString,pm) then
-      HandleProcedureModifier(Parent,Pm)
+    else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
+      HandleProcedureTypeModifier(Element,PTM)
     else if (CurToken=tklibrary) then // library is a token and a directive.
       begin
       Tok:=UpperCase(CurTokenString);
@@ -2984,29 +4366,46 @@ begin
         ExpectToken(tkSemicolon);
         end;
       end
-    else if DoCheckHint then
-      consumesemi
+    else if DoCheckHint(Element) then
+      ConsumeSemi
+    else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
+      begin
+      ExpectToken(tkColon);
+      ExpectToken(tkString);
+      if (Parent is TPasProcedure) then
+        (Parent as TPasProcedure).AliasName:=CurTokenText;
+      ExpectToken(tkSemicolon);
+      end
     else if (CurToken = tkSquaredBraceOpen) then
       begin
       repeat
         NextToken
       until CurToken = tkSquaredBraceClose;
       ExpectToken(tkSemicolon);
-      end;
+      end
+    else
+      CheckToken(tkSemicolon);
     Done:=(CurToken=tkSemiColon);
     if Done then
       begin
       NextToken;
-      Done:=Not ((Curtoken=tkSquaredBraceOpen) or TokenIsProcedureModifier(Parent,CurtokenString,Pm) or IscurtokenHint() or TokenisCallingConvention(CurTokenString,cc));
+      Done:=Not ((Curtoken=tkSquaredBraceOpen) or
+                  TokenIsProcedureModifier(Parent,CurtokenString,PM) or
+                  TokenIsProcedureTypeModifier(Parent,CurtokenString,PTM) or
+                  IsCurTokenHint() or
+                  TokenIsCallingConvention(CurTokenString,cc) or
+                  (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
 //      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
       end;
+
 //    Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
   Until Done;
-  if DoCheckHint then  // deprecated,platform,experimental,library, unimplemented etc
+  if DoCheckHint(Element) then  // deprecated,platform,experimental,library, unimplemented etc
     ConsumeSemi;
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
+  Engine.FinishScope(stProcedureHeader,Element);
   if (Parent is TPasProcedure)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
@@ -3014,6 +4413,8 @@ begin
      or (Parent.Parent is TProcedureBody))
   then
     ParseProcedureBody(Parent);
+  if Parent is TPasProcedure then
+    Engine.FinishScope(stProcedure,Parent);
 end;
 
 // starts after the semicolon
@@ -3030,48 +4431,69 @@ end;
 
 
 function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
-  AVisibility: TPasMemberVisibility): TPasProperty;
-
-  procedure MaybeReadFullyQualifiedIdentifier(Var r : String);
-
-  begin
-    while True do
-      begin
-      NextToken;
-      if CurToken = tkDot then
-        begin
-        ExpectIdentifier;
-        R:=R + '.' + CurTokenString;
-        end
-      else
-        break;
-      end;
-  end;
+  AVisibility: TPasMemberVisibility; IsClassField: boolean): TPasProperty;
 
-  function GetAccessorName: String;
+  function GetAccessorName(aParent: TPasElement; out Expr: TPasExpr): String;
+  var
+    Params: TParamsExpr;
+    Param: TPasExpr;
   begin
     ExpectIdentifier;
     Result := CurTokenString;
-    MaybeReadFullyQualifiedIdentifier(Result);
+    Expr := CreatePrimitiveExpr(aParent,pekIdent,CurTokenString);
+
+    // read .subident.subident...
+    repeat
+      NextToken;
+      if CurToken <> tkDot then break;
+      ExpectIdentifier;
+      Result := Result + '.' + CurTokenString;
+      AddToBinaryExprChain(Expr,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
+    until false;
+
+    // read optional array index
     if CurToken <> tkSquaredBraceOpen then
       UnGetToken
     else
       begin
       Result := Result + '[';
+      Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
+      Params.Kind:=pekArrayParams;
+      AddParamsToBinaryExprChain(Expr,Params);
       NextToken;
-      if CurToken in [tkIdentifier, tkNumber] then
-        Result := Result + CurTokenString;
+      case CurToken of
+        tkChar:             Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
+        tkNumber:           Param:=CreatePrimitiveExpr(aParent,pekNumber, CurTokenString);
+        tkIdentifier:       Param:=CreatePrimitiveExpr(aParent,pekIdent, CurTokenText);
+        tkfalse, tktrue:    Param:=CreateBoolConstExpr(aParent,pekBoolConst, CurToken=tktrue);
+      else
+        ParseExcExpectedIdentifier;
+      end;
+      Params.AddParam(Param);
+      Result := Result + CurTokenString;
       ExpectToken(tkSquaredBraceClose);
       Result := Result + ']';
       end;
+    repeat
+      NextToken;
+      if CurToken <> tkDot then
+        begin
+        UngetToken;
+        break;
+        end;
+      ExpectIdentifier;
+      Result := Result + '.' + CurTokenString;
+      AddToBinaryExprChain(Expr,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
+    until false;
   end;
 
 var
-  isArray : Boolean;
-  h   : TPasMemberHint;
-
+  isArray , ok: Boolean;
 begin
   Result:=TPasProperty(CreateElement(TPasProperty,AName,Parent,AVisibility));
+  if IsClassField then
+    Include(Result.VarModifiers,vmClass);
+  ok:=false;
   try
     NextToken;
     isArray:=CurToken=tkSquaredBraceOpen;
@@ -3082,7 +4504,7 @@ begin
       end;
     if CurToken = tkColon then
       begin
-      Result.VarType := ParseType(Result);
+      Result.VarType := ParseType(Result,CurSourcePos);
       NextToken;
       end;
     if CurTokenIsIdentifier('INDEX') then
@@ -3092,17 +4514,28 @@ begin
       end;
     if CurTokenIsIdentifier('READ') then
       begin
-      Result.ReadAccessorName := GetAccessorName;
+      Result.ReadAccessorName := GetAccessorName(Result,Result.ReadAccessor);
       NextToken;
       end;
     if CurTokenIsIdentifier('WRITE') then
       begin
-      Result.WriteAccessorName := GetAccessorName;
+      Result.WriteAccessorName := GetAccessorName(Result,Result.WriteAccessor);
+      NextToken;
+      end;
+    if CurTokenIsIdentifier('READONLY') then
+      begin
+      Result.DispIDReadOnly:=True;
+      NextToken;
+      end;
+    if CurTokenIsIdentifier('DISPID') then
+      begin
+      NextToken;
+      Result.DispIDExpr := DoParseExpression(Result,Nil);
       NextToken;
       end;
     if CurTokenIsIdentifier('IMPLEMENTS') then
       begin
-      Result.ImplementsName := GetAccessorName;
+      Result.ImplementsName := GetAccessorName(Result,Result.ImplementsFunc);
       NextToken;
       end;
     if CurTokenIsIdentifier('STORED') then
@@ -3113,15 +4546,18 @@ begin
       else if CurToken = tkFalse then
         Result.StoredAccessorName := 'False'
       else if CurToken = tkIdentifier then
-        Result.StoredAccessorName := CurTokenString
+        begin
+        UngetToken;
+        Result.StoredAccessorName := GetAccessorName(Result,Result.StoredAccessor);
+        end
       else
-        ParseExc(SParserSyntaxError);
+        ParseExcSyntaxError;
       NextToken;
       end;
     if CurTokenIsIdentifier('DEFAULT') then
       begin
       if isArray then
-        ParseExc('Array properties cannot have default value');
+        ParseExc(nParserArrayPropertiesCannotHaveDefaultValue,SParserArrayPropertiesCannotHaveDefaultValue);
       NextToken;
       Result.DefaultExpr := DoParseExpression(Result);
 //      NextToken;
@@ -3129,6 +4565,8 @@ begin
     else if CurtokenIsIdentifier('NODEFAULT') then
       begin
       Result.IsNodefault:=true;
+      if Result.DefaultExpr<>nil then
+        ParseExcSyntaxError;
       NextToken;
       end;
     // Here the property ends. There can still be a 'default'
@@ -3137,7 +4575,7 @@ begin
     if CurTokenIsIdentifier('DEFAULT') then
       begin
       if (Result.VarType<>Nil) and (not isArray) then
-        ParseExc('The default property must be an array property');
+        ParseExc(nParserDefaultPropertyMustBeArray,SParserDefaultPropertyMustBeArray);
       NextToken;
       if CurToken = tkSemicolon then
         begin
@@ -3146,18 +4584,16 @@ begin
         end
       end;
     // Handle hints
-    while IsCurTokenHint(h) do
-      begin
-      Result.Hints:=Result.Hints+[h];
+    while DoCheckHint(Result) do
       NextToken;
-      if CurToken=tkSemicolon then
-        NextToken;
-      end;
-    UngetToken;
-  except
-    FreeAndNil(Result);
-    Raise;
+    if Result.Hints=[] then
+      UngetToken;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
+  Engine.FinishScope(stDeclaration,Result);
 end;
 
 // Starts after the "begin" token
@@ -3166,7 +4602,6 @@ var
   BeginBlock: TPasImplBeginBlock;
   SubBlock: TPasImplElement;
 begin
-
   BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
   Parent.Body := BeginBlock;
   repeat
@@ -3186,14 +4621,70 @@ begin
 //  writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
 end;
 
-procedure TPasParser.ParseAsmBlock(AsmBlock : TPasImplAsmStatement);
+procedure TPasParser.ParseProcAsmBlock(Parent: TProcedureBody);
+var
+  AsmBlock: TPasImplAsmStatement;
+begin
+  AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
+  Parent.Body:=AsmBlock;
+  ParseAsmBlock(AsmBlock);
+  ExpectToken(tkSemicolon);
+end;
+
+procedure TPasParser.ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
+
+Var
+  LastToken : TToken;
+  p: PTokenRec;
+
+  Function atEndOfAsm : Boolean;
+
+  begin
+    Result:=(CurToken=tkEnd) and (LastToken<>tkAt);
+  end;
 
 begin
-  NextToken;
-  While CurToken<>tkEnd do
+  if po_asmwhole in Options then
     begin
-    AsmBlock.Tokens.Add(CurTokenText);
+    FTokenRingCur:=0;
+    FTokenRingStart:=0;
+    FTokenRingEnd:=1;
+    p:=@FTokenRing[0];
+    p^.Comments.Clear;
+    repeat
+      Scanner.ReadNonPascalTillEndToken(true);
+      case Scanner.CurToken of
+      tkLineEnding:
+        AsmBlock.Tokens.Add(Scanner.CurTokenString);
+      tkend:
+        begin
+        p^.Token := tkend;
+        p^.AsString := Scanner.CurTokenString;
+        break;
+        end
+      else
+        begin
+        // missing end
+        p^.Token := tkEOF;
+        p^.AsString := '';
+        break;
+        end;
+      end;
+    until false;
+    FCurToken := p^.Token;
+    FCurTokenString := p^.AsString;
+    CheckToken(tkend);
+    end
+  else
+    begin
+    LastToken:=tkEOF;
     NextToken;
+    While Not atEndOfAsm do
+      begin
+      AsmBlock.Tokens.Add(CurTokenText);
+      LastToken:=CurToken;
+      NextToken;
+      end;
     end;
   // NextToken; // Eat end.
   // Do not consume end. Current token will normally be end;
@@ -3222,6 +4713,8 @@ var
 
   function CloseBlock: boolean; // true if parent reached
   begin
+    if CurBlock.ClassType=TPasImplExceptOn then
+      Engine.FinishScope(stExceptOnStatement,CurBlock);
     CurBlock:=CurBlock.Parent as TPasImplBlock;
     Result:=CurBlock=Parent;
   end;
@@ -3243,14 +4736,16 @@ var
   end;
 
 var
-  VarName: String;
   SubBlock: TPasImplElement;
   CmdElem: TPasImplElement;
-  left: TPasExpr;
-  right: TPasExpr;
-  el : TPasImplElement;
+  left, right: TPasExpr;
+  El : TPasImplElement;
   ak : TAssignKind;
   lt : TLoopType;
+  ok: Boolean;
+  SrcPos: TPasSourcePos;
+  Name: String;
+  TypeEl: TPasType;
 
 begin
   NewImplElement:=nil;
@@ -3258,34 +4753,37 @@ begin
   while True do
   begin
     NextToken;
-    //WriteLn(i,'Token=',CurTokenText);
+    // WriteLn({$IFDEF VerbosePasParser}i,{$ENDIF}' Token=',CurTokenText);
     case CurToken of
-    tkasm :
+    tkasm:
       begin
-      el:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
-      ParseAsmBlock(TPasImplAsmStatement(el));
-      CurBlock.AddElement(el);
-      NewImplElement:=El;
+      El:=TPasImplElement(CreateElement(TPasImplAsmStatement,'',CurBlock));
+      ParseAsmBlock(TPasImplAsmStatement(El));
+      CurBlock.AddElement(El);
+      if NewImplElement=nil then NewImplElement:=CurBlock;
+      if CloseStatement(False) then
+        break;
       end;
     tkbegin:
       begin
-      el:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock));
-      CreateBlock(TPasImplBeginBlock(el));
+      El:=TPasImplElement(CreateElement(TPasImplBeginBlock,'',CurBlock));
+      CreateBlock(TPasImplBeginBlock(El));
       end;
     tkrepeat:
       begin
-      el:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock));
-      CreateBlock(TPasImplRepeatUntil(el));
+      El:=TPasImplRepeatUntil(CreateElement(TPasImplRepeatUntil,'',CurBlock));
+      CreateBlock(TPasImplRepeatUntil(El));
       end;
     tkIf:
       begin
         NextToken;
         Left:=DoParseExpression(CurBlock);
-        UNgettoken;
-        el:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
-        TPasImplIfElse(el).ConditionExpr:=Left;
+        UngetToken;
+        El:=TPasImplIfElse(CreateElement(TPasImplIfElse,'',CurBlock));
+        TPasImplIfElse(El).ConditionExpr:=Left;
+        Left.Parent:=El;
         //WriteLn(i,'IF Condition="',Condition,'" Token=',CurTokenText);
-        CreateBlock(TPasImplIfElse(el));
+        CreateBlock(TPasImplIfElse(El));
         ExpectToken(tkthen);
       end;
     tkelse:
@@ -3293,8 +4791,8 @@ begin
       begin
         if TPasImplIfElse(CurBlock).IfBranch=nil then
         begin
-        el:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock));
-        CurBlock.AddElement(el);
+        El:=TPasImplCommand(CreateElement(TPasImplCommand,'', CurBlock));
+        CurBlock.AddElement(El);
         end;
         if TPasImplIfElse(CurBlock).ElseBranch<>nil then
         begin
@@ -3307,9 +4805,24 @@ begin
           CloseBlock;
           CloseStatement(false);
         end;
+        // Case ... else without semicolon in front.
+      end else if (CurBlock is TPasImplCaseStatement) then
+      begin
+        UngetToken;
+        CloseStatement(False);
+        exit;
       end else if (CurBlock is TPasImplWhileDo) then
       begin
-        //if .. then while .. do smt else ..
+        CloseBlock;
+        UngetToken;
+      end else if (CurBlock is TPasImplForLoop) then
+      begin
+        //if .. then for .. do smt else ..
+        CloseBlock;
+        UngetToken;
+      end else if (CurBlock is TPasImplWithDo) then
+      begin
+        //if .. then with .. do smt else ..
         CloseBlock;
         UngetToken;
       end else if (CurBlock is TPasImplRaise) then
@@ -3317,90 +4830,111 @@ begin
         //if .. then Raise Exception else ..
         CloseBlock;
         UngetToken;
+      end else if (CurBlock is TPasImplAsmStatement) then
+      begin
+        //if .. then asm end else ..
+        CloseBlock;
+        UngetToken;
       end else if (CurBlock is TPasImplTryExcept) then
       begin
         CloseBlock;
-        el:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock));
-        TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(el);
-        CurBlock:=TPasImplTryExceptElse(el);
+        El:=TPasImplTryExceptElse(CreateElement(TPasImplTryExceptElse,'',CurBlock));
+        TPasImplTry(CurBlock).ElseBranch:=TPasImplTryExceptElse(El);
+        CurBlock:=TPasImplTryExceptElse(El);
       end else
-        ParseExc(SParserSyntaxError);
+        ParseExcSyntaxError;
     tkwhile:
       begin
         // while Condition do
         NextToken;
-        left:=DoParseExpression(Parent);
-        ungettoken;
+        left:=DoParseExpression(CurBlock);
+        UngetToken;
         //WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
-        el:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
-        TPasImplWhileDo(el).ConditionExpr:=left;
-        CreateBlock(TPasImplWhileDo(el));
+        El:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock));
+        TPasImplWhileDo(El).ConditionExpr:=left;
+        CreateBlock(TPasImplWhileDo(El));
         ExpectToken(tkdo);
       end;
     tkgoto:
       begin
-        nexttoken;
+        NextToken;
         curblock.AddCommand('goto '+curtokenstring);
-        expecttoken(tkSemiColon);
+        // expecttoken(tkSemiColon);
       end;
     tkfor:
       begin
         // for VarName := StartValue to EndValue do
         // for VarName in Expression do
-        ExpectIdentifier;
-        VarName:=CurTokenString;
-        NextToken;
-        Left:=Nil;
-        Right:=Nil;
-        if Not (CurToken in [tkAssign,tkIn]) then
-          ParseExc(SParserExpectedAssignIn);
-        if (CurToken=tkAssign) then
-          lt:=ltNormal
-        else
-          lt:=ltin;
-        NextToken;
-        Left:=DoParseExpression(Parent);
+        El:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
+        ok:=false;
         Try
+          ExpectIdentifier;
+          Left:=CreatePrimitiveExpr(El,pekIdent,CurTokenString);
+          TPasImplForLoop(El).VariableName:=Left;
+          repeat
+            NextToken;
+            case CurToken of
+              tkAssign:
+                begin
+                lt:=ltNormal;
+                break;
+                end;
+              tkin:
+                begin
+                lt:=ltIn;
+                break;
+                end;
+              tkDot:
+                begin
+                ExpectIdentifier;
+                AddToBinaryExprChain(Left,
+                  CreatePrimitiveExpr(El,pekIdent,CurTokenString), eopSubIdent);
+                TPasImplForLoop(El).VariableName:=Left;
+                end;
+            else
+              ParseExc(nParserExpectedAssignIn,SParserExpectedAssignIn);
+            end;
+          until false;
+          NextToken;
+          TPasImplForLoop(El).StartExpr:=DoParseExpression(El);
           if (Lt=ltNormal) then
             begin
             if Not (CurToken in [tkTo,tkDownTo]) then
-              ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkTo]]));
+              ParseExcTokenError(TokenInfos[tkTo]);
             if CurToken=tkdownto then
               Lt:=ltDown;
             NextToken;
-            Right:=DoParseExpression(Parent);
+            TPasImplForLoop(El).EndExpr:=DoParseExpression(El);
             end;
+          TPasImplForLoop(El).LoopType:=lt;
           if (CurToken<>tkDo) then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkDo]]));
-        except
-          FreeAndNil(Left);
-          FreeAndNil(Right);
-          Raise;
+            ParseExcTokenError(TokenInfos[tkDo]);
+          ok:=true;
+        finally
+          if not ok then
+            El.Release;
         end;
-        el:=TPasImplForLoop(CreateElement(TPasImplForLoop,'',CurBlock));
-        TPasImplForLoop(el).VariableName:=VarName;
-        TPasImplForLoop(el).StartExpr:=Left;
-        TPasImplForLoop(el).EndExpr:=Right;
-        TPasImplForLoop(el).LoopType:=lt;
-        CreateBlock(TPasImplForLoop(el));
+        CreateBlock(TPasImplForLoop(El));
         //WriteLn(i,'FOR "',VarName,'" := ',StartValue,' to ',EndValue,' Token=',CurTokenText);
       end;
     tkwith:
       begin
         // with Expr do
         // with Expr, Expr do
+        SrcPos:=CurSourcePos;
         NextToken;
-        Left:=DoParseExpression(Parent);
+        Left:=DoParseExpression(CurBlock);
         //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
-        el:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock));
-        TPasImplWithDo(el).AddExpression(Left);
-        CreateBlock(TPasImplWithDo(el));
+        El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
+        TPasImplWithDo(El).AddExpression(Left);
+        Left.Parent:=El;
+        CreateBlock(TPasImplWithDo(El));
         repeat
           if CurToken=tkdo then break;
           if CurToken<>tkComma then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkdo]]));
+            ParseExcTokenError(TokenInfos[tkdo]);
           NextToken;
-          Left:=DoParseExpression(Parent);
+          Left:=DoParseExpression(CurBlock);
           //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
           TPasImplWithDo(CurBlock).AddExpression(Left);
         until false;
@@ -3408,13 +4942,14 @@ begin
     tkcase:
       begin
         NextToken;
-        Left:=DoParseExpression(Parent);
+        Left:=DoParseExpression(CurBlock);
         UngetToken;
         //writeln(i,'CASE OF Expr="',Expr,'" Token=',CurTokenText);
         ExpectToken(tkof);
-        el:=TPasImplCaseOf(CreateElement(TPasImplCaseOf,'',CurBlock));
-        TPasImplCaseOf(el).CaseExpr:=Left;
-        CreateBlock(TPasImplCaseOf(el));
+        El:=TPasImplCaseOf(CreateElement(TPasImplCaseOf,'',CurBlock));
+        TPasImplCaseOf(El).CaseExpr:=Left;
+        Left.Parent:=El;
+        CreateBlock(TPasImplCaseOf(El));
         repeat
           NextToken;
           //writeln(i,'CASE OF Token=',CurTokenText);
@@ -3422,37 +4957,46 @@ begin
           tkend:
             begin
             if CurBlock.Elements.Count=0 then
-              ParseExc(SParserExpectCase);
+              ParseExc(nParserExpectCase,SParserExpectCase);
             break; // end without else
             end;
           tkelse:
             begin
               // create case-else block
-              el:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
-              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(el);
-              CreateBlock(TPasImplCaseElse(el));
+              El:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
+              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(El);
+              CreateBlock(TPasImplCaseElse(El));
               break;
             end
           else
             // read case values
-            repeat
-              Left:=DoParseExpression(Parent);
-              //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
-              if CurBlock is TPasImplCaseStatement then
-                TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
-              else
-                begin
-                el:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
-                TPasImplCaseStatement(el).AddExpression(Left);
-                CurBlock.AddElement(el);
-                CurBlock:=TPasImplCaseStatement(el);
-                end;
-              //writeln(i,'CASE after value Token=',CurTokenText);
-              if (CurToken=tkComma) then
-                NextToken
-              else if (CurToken<>tkColon) then
-                ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkComma]]))
-            until Curtoken=tkColon;
+            if (curToken=tkIdentifier) and (LowerCase(CurtokenString)='otherwise') then
+              begin
+              // create case-else block
+              El:=TPasImplCaseElse(CreateElement(TPasImplCaseElse,'',CurBlock));
+              TPasImplCaseOf(CurBlock).ElseBranch:=TPasImplCaseElse(El);
+              CreateBlock(TPasImplCaseElse(El));
+              break;
+              end
+            else
+              repeat
+                Left:=DoParseExpression(CurBlock);
+                //writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
+                if CurBlock is TPasImplCaseStatement then
+                  TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
+                else
+                  begin
+                  El:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
+                  TPasImplCaseStatement(El).AddExpression(Left);
+                  CurBlock.AddElement(El);
+                  CurBlock:=TPasImplCaseStatement(El);
+                  end;
+                //writeln(i,'CASE after value Token=',CurTokenText);
+                if (CurToken=tkComma) then
+                  NextToken
+                else if (CurToken<>tkColon) then
+                  ParseExcTokenError(TokenInfos[tkComma]);
+              until Curtoken=tkColon;
             // read statement
             ParseStatement(CurBlock,SubBlock);
             CloseBlock;
@@ -3460,7 +5004,7 @@ begin
             begin
               NextToken;
               if not (CurToken in [tkSemicolon,tkelse,tkend]) then
-                ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+                ParseExcTokenError(TokenInfos[tkSemicolon]);
               if CurToken<>tkSemicolon then
                 UngetToken;
             end;
@@ -3474,8 +5018,8 @@ begin
       end;
     tktry:
       begin
-      el:=TPasImplTry(CreateElement(TPasImplTry,'',Curblock));
-      CreateBlock(TPasImplTry(el));
+      El:=TPasImplTry(CreateElement(TPasImplTry,'',CurBlock));
+      CreateBlock(TPasImplTry(El));
       end;
     tkfinally:
       begin
@@ -3486,11 +5030,11 @@ begin
         end;
         if CurBlock is TPasImplTry then
         begin
-          el:=TPasImplTryFinally(CreateElement(TPasImplTryFinally,'',Curblock));
-          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryFinally(el);
-          CurBlock:=TPasImplTryFinally(el);
+          El:=TPasImplTryFinally(CreateElement(TPasImplTryFinally,'',CurBlock));
+          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryFinally(El);
+          CurBlock:=TPasImplTryFinally(El);
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkexcept:
       begin
@@ -3502,56 +5046,26 @@ begin
         if CurBlock is TPasImplTry then
         begin
           //writeln(i,'EXCEPT');
-          el:=TPasImplTryExcept(CreateElement(TPasImplTryExcept,'',CurBlock));
-          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryExcept(el);
-          CurBlock:=TPasImplTryExcept(el);
+          El:=TPasImplTryExcept(CreateElement(TPasImplTryExcept,'',CurBlock));
+          TPasImplTry(CurBlock).FinallyExcept:=TPasImplTryExcept(El);
+          CurBlock:=TPasImplTryExcept(El);
         end else
-          ParseExc(SParserSyntaxError);
-      end;
-    tkon:
-      begin
-        // in try except:
-        // on E: Exception do
-        // on Exception do
-        if CurBlock is TPasImplTryExcept then
-        begin
-          NextToken;
-          Left:=Nil;
-          Right:=DoParseExpression(Parent);
-          //writeln(i,'ON t=',TypeName,' Token=',CurTokenText);
-  //        NextToken;
-          if CurToken=tkColon then
-            begin
-            NextToken;
-            Left:=Right;
-            Right:=DoParseExpression(Parent);
-            //writeln(i,'ON v=',VarName,' t=',TypeName,' Token=',CurTokenText);
-            end;
-//          else
-          UngetToken;
-          el:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
-          TPasImplExceptOn(el).VarExpr:=Left;
-          TPasImplExceptOn(el).TypeExpr:=Right;
-          CurBlock.AddElement(el);
-          CurBlock:=TPasImplExceptOn(el);
-          ExpectToken(tkDo);
-        end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkraise:
       begin
-      el:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
-      CreateBlock(TPasImplRaise(el));
+      El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
+      CreateBlock(TPasImplRaise(El));
       NextToken;
-      If Curtoken=tkSemicolon then
+      If Curtoken in [tkElse,tkEnd,tkSemicolon] then
         UnGetToken
       else
         begin
-        TPasImplRaise(el).ExceptObject:=DoParseExpression(el);
+        TPasImplRaise(El).ExceptObject:=DoParseExpression(El);
         if (CurToken=tkIdentifier) and (Uppercase(CurtokenString)='AT') then
           begin
           NextToken;
-          TPasImplRaise(el).ExceptAddr:=DoParseExpression(el);
+          TPasImplRaise(El).ExceptAddr:=DoParseExpression(El);
           end;
         if Curtoken in [tkSemicolon,tkEnd] then
           UngetToken
@@ -3579,10 +5093,12 @@ begin
           if CloseBlock then break; // close try
           if CloseStatement(false) then break;
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
     tkSemiColon:
       if CloseStatement(true) then break;
+    tkFinalization:
+      if CloseStatement(true) then break;
     tkuntil:
       begin
         if CloseStatement(true) then
@@ -3593,57 +5109,108 @@ begin
         if CurBlock is TPasImplRepeatUntil then
         begin
           NextToken;
-          Left:=DoParseExpression(Parent);
+          Left:=DoParseExpression(CurBlock);
           UngetToken;
           TPasImplRepeatUntil(CurBlock).ConditionExpr:=Left;
           //WriteLn(i,'UNTIL Condition="',Condition,'" Token=',CurTokenString);
           if CloseBlock then break;
         end else
-          ParseExc(SParserSyntaxError);
+          ParseExcSyntaxError;
       end;
-    else
-      left:=DoParseExpression(nil);
-      case CurToken of
-        tkAssign,
-        tkAssignPlus,
-        tkAssignMinus,
-        tkAssignMul,
-        tkAssignDivision:
+    tkEOF:
+      CheckToken(tkend);
+    tkAt,tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
+      begin
+// This should in fact not be checked here.
+//      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
+//        ParseExc;
+      // On is usable as an identifier
+      if lowerCase(CurTokenText)='on' then
         begin
-          // assign statement
-          Ak:=TokenToAssignKind(CurToken);
-          NextToken;
-          right:=DoParseExpression(nil); // this may solve TPasImplWhileDo.AddElement BUG
-          el:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
-          TPasImplAssign(el).left:=Left;
-          TPasImplAssign(el).right:=Right;
-          TPasImplAssign(el).Kind:=ak;
-          CurBlock.AddElement(el);
-          CmdElem:=TPasImplAssign(el);
+          // in try except:
+          // on E: Exception do
+          // on Exception do
+          if CurBlock is TPasImplTryExcept then
+          begin
+            ExpectIdentifier;
+            El:=TPasImplExceptOn(CreateElement(TPasImplExceptOn,'',CurBlock));
+            SrcPos:=CurSourcePos;
+            Name:=CurTokenString;
+            NextToken;
+            //writeln('ON t=',Name,' Token=',CurTokenText);
+            if CurToken=tkColon then
+              begin
+              // the first expression was the variable name
+              NextToken;
+              TypeEl:=ParseSimpleType(El,SrcPos,'');
+              TPasImplExceptOn(El).TypeEl:=TypeEl;
+              TPasImplExceptOn(El).VarEl:=TPasVariable(CreateElement(TPasVariable,
+                                    Name,El,SrcPos));
+              TPasImplExceptOn(El).VarEl.VarType:=TypeEl;
+              TypeEl.AddRef;
+              end
+            else
+              begin
+              UngetToken;
+              TPasImplExceptOn(El).TypeEl:=ParseSimpleType(El,SrcPos,'');
+              end;
+            Engine.FinishScope(stExceptOnExpr,El);
+            CurBlock.AddElement(El);
+            CurBlock:=TPasImplExceptOn(El);
+            ExpectToken(tkDo);
+          end else
+            ParseExcSyntaxError;
+        end
+      else
+        begin
+        left:=DoParseExpression(CurBlock);
+        case CurToken of
+          tkAssign,
+          tkAssignPlus,
+          tkAssignMinus,
+          tkAssignMul,
+          tkAssignDivision:
+          begin
+            // assign statement
+            Ak:=TokenToAssignKind(CurToken);
+            NextToken;
+            right:=DoParseExpression(CurBlock); // this may solve TPasImplWhileDo.AddElement BUG
+            El:=TPasImplAssign(CreateElement(TPasImplAssign,'',CurBlock));
+            left.Parent:=El;
+            right.Parent:=El;
+            TPasImplAssign(El).left:=Left;
+            TPasImplAssign(El).right:=Right;
+            TPasImplAssign(El).Kind:=ak;
+            CurBlock.AddElement(El);
+            CmdElem:=TPasImplAssign(El);
+            UngetToken;
+          end;
+          tkColon:
+          begin
+            if not (left is TPrimitiveExpr) then
+              ParseExcTokenError(TokenInfos[tkSemicolon]);
+            // label mark. todo: check mark identifier in the list of labels
+            El:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
+            TPasImplLabelMark(El).LabelId:=TPrimitiveExpr(left).Value;
+            CurBlock.AddElement(El);
+            CmdElem:=TPasImplLabelMark(El);
+            left.Free;
+          end;
+        else
+          // simple statement (function call)
+          El:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
+          TPasImplSimple(El).expr:=Left;
+          CurBlock.AddElement(El);
+          CmdElem:=TPasImplSimple(El);
           UngetToken;
         end;
-        tkColon:
-        begin
-          if not (left is TPrimitiveExpr) then
-            ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
-          // label mark. todo: check mark identifier in the list of labels
-          el:=TPasImplLabelMark(CreateElement(TPasImplLabelMark,'', CurBlock));
-          TPasImplLabelMark(el).LabelId:=TPrimitiveExpr(left).Value;
-          CurBlock.AddElement(el);
-          CmdElem:=TPasImplLabelMark(el);
-          left.Free;
+
+        if not (CmdElem is TPasImplLabelMark) then
+          if NewImplElement=nil then NewImplElement:=CmdElem;
         end;
-      else
-        // simple statement (function call)
-        el:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock));
-        TPasImplSimple(el).expr:=Left;
-        CurBlock.AddElement(el);
-        CmdElem:=TPasImplSimple(el);
-        UngetToken;
       end;
-
-      if not (CmdElem is TPasImplLabelMark) then
-        if NewImplElement=nil then NewImplElement:=CmdElem;
+    else
+      ParseExcSyntaxError;
     end;
   end;
 end;
@@ -3657,7 +5224,7 @@ begin
     Labels.Labels.Add(ExpectIdentifier);
     NextToken;
     if not (CurToken in [tkSemicolon, tkComma]) then
-      ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkSemicolon]]));
+      ParseExcTokenError(TokenInfos[tkSemicolon]);
   until CurToken=tkSemicolon;
 end;
 
@@ -3677,24 +5244,43 @@ begin
     ptOperator       : Result:=TPasOperator;
     ptClassOperator  : Result:=TPasClassOperator;
   else
-    ParseExc('Unknown procedure Type '+intToStr(Ord(ProcType)));
+    ParseExc(nParserUnknownProcedureType,SParserUnknownProcedureType,[Ord(ProcType)]);
   end;
 end;
 
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
 
   function ExpectProcName: string;
+
+  Var
+    L : TFPList;
+    I : Integer;
+
   begin
     Result:=ExpectIdentifier;
     //writeln('ExpectProcName ',Parent.Classname);
     if Parent is TImplementationSection then
     begin
       NextToken;
-      if CurToken=tkDot then
-      begin
-        Result:=Result+'.'+ExpectIdentifier;
-      end else
-        UngetToken;
+      While CurToken in [tkDot,tkLessThan] do
+        begin
+        if CurToken=tkDot then
+          Result:=Result+'.'+ExpectIdentifier
+        else
+          begin // <> can be ignored, we read the list but discard its content
+          UnGetToken;
+          L:=TFPList.Create;
+          Try
+            ReadGenericArguments(L,Parent);
+          finally
+            For I:=0 to L.Count-1 do
+              TPasElement(L[i]).Release;
+            L.Free;
+          end;
+          end;
+        NextToken;
+        end;
+      UngetToken;
     end;
   end;
 
@@ -3702,7 +5288,7 @@ var
   Name: String;
   PC : TPTreeElement;
   Ot : TOperatorType;
-  IsTokenBased : Boolean;
+  IsTokenBased , ok: Boolean;
 
 begin
   If (Not (ProcType in [ptOperator,ptClassOperator])) then
@@ -3716,18 +5302,19 @@ begin
     else
       OT:=TPasOperator.NameToOperatorType(CurTokenString);
     if (ot=otUnknown) then
-      ParseExc(SErrUnknownOperatorType,[CurTokenString]);
+      ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
     Name:=OperatorNames[Ot];
     end;
   PC:=GetProcedureClass(ProcType);
   Parent:=CheckIfOverLoaded(Parent,Name);
   Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
+  ok:=false;
   try
     if Not (ProcType in [ptFunction, ptClassFunction, ptOperator, ptClassOperator]) then
       Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
     else
       begin
-      Result.ProcType := CreateFunctionType('', 'Result', Result, True);
+      Result.ProcType := CreateFunctionType('', 'Result', Result, True, CurSourcePos);
       if (ProcType in [ptOperator, ptClassOperator]) then
         begin
         TPasOperator(Result).TokenBased:=IsTokenBased;
@@ -3755,9 +5342,10 @@ begin
             end;
           end;
         end;
-  except
-    FreeAndNil(Result);
-    Raise;
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
 end;
 
@@ -3778,7 +5366,7 @@ begin
       NextToken;
       V.Values.Add(DoParseExpression(ARec));
       if Not (CurToken in [tkComma,tkColon]) then
-        ParseExc(SParserExpectedCommaColon);
+        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
     Until (curToken=tkColon);
     ExpectToken(tkBraceOpen);
     NextToken;
@@ -3809,19 +5397,34 @@ begin
   Flush(output);
 end;
 
+function TPasParser.GetCurrentModeSwitches: TModeSwitches;
+begin
+  if Assigned(FScanner) then
+    Result:=FScanner.CurrentModeSwitches
+  else
+    Result:=[msNone];
+end;
+
+procedure TPasParser.SetCurrentModeSwitches(AValue: TModeSwitches);
+begin
+  if Assigned(FScanner) then
+    FScanner.CurrentModeSwitches:=AValue;
+end;
+
 // Starts on first token after Record or (. Ends on AEndToken
 procedure TPasParser.ParseRecordFieldList(ARec: TPasRecordType;
   AEndToken: TToken; AllowMethods: Boolean);
 
 Var
-  VN : String;
+  VariantName : String;
   v : TPasmemberVisibility;
   Proc: TPasProcedure;
   ProcType: TProcType;
   Prop : TPasProperty;
   Cons : TPasConst;
   isClass : Boolean;
-
+  NamePos: TPasSourcePos;
+  OldCount, i: Integer;
 begin
   v:=visDefault;
   isClass:=False;
@@ -3832,7 +5435,7 @@ begin
       tkConst:
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordConstantsNotAllowed);
+          ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
         ExpectToken(tkIdentifier);
         Cons:=ParseConstDecl(ARec);
         Cons.Visibility:=v;
@@ -3841,66 +5444,73 @@ begin
       tkClass:
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordMethodsNotAllowed);
+          ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         if isClass then
-          ParseExc(SParserTypeSyntaxError);
+          ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
         isClass:=True;
         end;
       tkProperty:
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordPropertiesNotAllowed);
+          ParseExc(nErrRecordPropertiesNotAllowed,SErrRecordPropertiesNotAllowed);
         ExpectToken(tkIdentifier);
-        Prop:=ParseProperty(ARec,CurtokenString,v);
-        Prop.isClass:=isClass;
+        Prop:=ParseProperty(ARec,CurtokenString,v,isClass);
         Arec.Members.Add(Prop);
         end;
       tkOperator,
       tkProcedure,
+      tkConstructor,
       tkFunction :
         begin
         if Not AllowMethods then
-          ParseExc(SErrRecordMethodsNotAllowed);
-        ProcType:=GetProcTypeFromtoken(CurToken,isClass);
+          ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
+        ProcType:=GetProcTypeFromToken(CurToken,isClass);
         Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
         else
           ARec.Members.Add(Proc);
         end;
+      tkGeneric, // Counts as field name
       tkIdentifier :
         begin
-//        If (po_delphi in Scanner.Options) then
           if CheckVisibility(CurtokenString,v) then
             begin
-            If not (po_delphi in Scanner.Options) then
-              ParseExc(SErrRecordVisibilityNotAllowed);
+            If not (msAdvancedRecords in Scanner.CurrentModeSwitches) then
+              ParseExc(nErrRecordVisibilityNotAllowed,SErrRecordVisibilityNotAllowed);
             if not (v in [visPrivate,visPublic,visStrictPrivate]) then
-              ParseExc(SParserInvalidRecordVisibility);
+              ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
             NextToken;
             Continue;
             end;
+        OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
+        for i:=OldCount to ARec.Members.Count-1 do
+          Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
         end;
       tkCase :
         begin
         ARec.Variants:=TFPList.Create;
         NextToken;
-        VN:=CurTokenString;
+        VariantName:=CurTokenString;
+        NamePos:=CurSourcePos;
         NextToken;
         If CurToken=tkColon then
-          ARec.VariantName:=VN
+          begin
+          ARec.VariantEl:=TPasVariable(CreateElement(TPasVariable,VariantName,ARec,NamePos));
+          TPasVariable(ARec.VariantEl).VarType:=ParseType(ARec,CurSourcePos);
+          end
         else
           begin
           UnGetToken;
           UnGetToken;
+          ARec.VariantEl:=ParseType(ARec,CurSourcePos);
           end;
-        ARec.VariantType:=ParseType(ARec);
         ExpectToken(tkOf);
         ParseRecordVariantParts(ARec,AEndToken);
         end;
     else
-      ParseExc(SParserTypeSyntaxError);
+      ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
     end;
     If CurToken<>tkClass then
       isClass:=False;
@@ -3911,18 +5521,24 @@ end;
 
 // Starts after the "record" token
 function TPasParser.ParseRecordDecl(Parent: TPasElement;
-  const TypeName: string; const Packmode: TPackMode): TPasRecordType;
+  const NamePos: TPasSourcePos; const TypeName: string;
+  const Packmode: TPackMode): TPasRecordType;
 
+var
+  ok: Boolean;
 begin
-    Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent));
-    try
-      Result.PackMode:=PackMode;
-      NextToken;
-      ParseRecordFieldList(Result,tkEnd,true);
-    except
-      FreeAndNil(Result);
-      Raise;
-    end;
+  Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent, NamePos));
+  ok:=false;
+  try
+    Result.PackMode:=PackMode;
+    NextToken;
+    ParseRecordFieldList(Result,tkEnd,true);
+    Engine.FinishScope(stTypeDef,Result);
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
+  end;
 end;
 
 Function IsVisibility(S : String;  var AVisibility :TPasMemberVisibility) : Boolean;
@@ -3969,11 +5585,11 @@ begin
         visPrivate   : AVisibility:=visStrictPrivate;
         visProtected : AVisibility:=visStrictProtected;
       else
-        ParseExc(Format(SParserStrangeVisibility,[S]));
+        ParseExc(nParserStrangeVisibility,SParserStrangeVisibility,[S]);
       end
     end
   else if B then
-    ParseExc(SParserExpectVisibility);
+    ParseExc(nParserExpectVisibility,SParserExpectVisibility);
 end;
 
 procedure TPasParser.ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
@@ -3982,7 +5598,7 @@ var
   Proc: TPasProcedure;
   ProcType: TProcType;
 begin
-  ProcType:=GetProcTypeFromtoken(CurToken,isClass);
+  ProcType:=GetProcTypeFromToken(CurToken,isClass);
   Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,AVisibility);
   if Proc.Parent is TPasOverloadedProc then
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
@@ -3997,17 +5613,35 @@ Var
   VarList: TFPList;
   Element: TPasElement;
   I : Integer;
+  isStatic : Boolean;
+  VarEl: TPasVariable;
 
 begin
   VarList := TFPList.Create;
   try
     ParseInlineVarDecl(AType, VarList, AVisibility, False);
+    if CurToken=tkSemicolon then
+      begin
+      NextToken;
+      isStatic:=CurTokenIsIdentifier('static');
+      if isStatic then
+        ExpectToken(tkSemicolon)
+      else
+        UngetToken;
+      end;
     for i := 0 to VarList.Count - 1 do
       begin
       Element := TPasElement(VarList[i]);
       Element.Visibility := AVisibility;
-      if IsClassField and (Element is TPasVariable) then
-        TPasVariable(Element).VarModifiers:=TPasVariable(Element).VarModifiers+[vmClass];
+      if (Element is TPasVariable) then
+        begin
+        VarEl:=TPasVariable(Element);
+        if IsClassField then
+          Include(VarEl.VarModifiers,vmClass);
+        if isStatic then
+          Include(VarEl.VarModifiers,vmStatic);
+        Engine.FinishScope(stDeclaration,VarEl);
+        end;
       AType.Members.Add(Element);
       end;
   finally
@@ -4055,82 +5689,91 @@ end;
 
 procedure TPasParser.ParseClassMembers(AType: TPasClassType);
 
+Type
+  TSectionType = (stNone,stConst,stType,stVar);
+
 Var
   CurVisibility : TPasMemberVisibility;
+  CurSection : TSectionType;
+  haveClass : Boolean;
 
 begin
+  CurSection:=stNone;
   CurVisibility := visDefault;
+  HaveClass:=False;
   while (CurToken<>tkEnd) do
     begin
     case CurToken of
       tkType:
-        begin
-        ExpectToken(tkIdentifier);
-        SaveComments;
-        ParseClassLocalTypes(AType,CurVisibility);
-        end;
+        CurSection:=stType;
       tkConst:
-        begin
-        ExpectToken(tkIdentifier);
-        SaveComments;
-        ParseClassLocalConsts(AType,CurVisibility);
-        end;
-      tkVar,
+        CurSection:=stConst;
+      tkVar:
+        CurSection:=stVar;
       tkIdentifier:
-        begin
-        if (AType.ObjKind=okInterface) then
-          ParseExc(SParserNoFieldsAllowed);
-        if CurToken=tkVar then
-          ExpectToken(tkIdentifier);
-        SaveComments;
-        if Not CheckVisibility(CurtokenString,CurVisibility) then
-          ParseClassFields(AType,CurVisibility,false);
-        end;
+        if CheckVisibility(CurtokenString,CurVisibility) then
+          CurSection:=stNone
+        else
+          begin
+          if not haveClass then
+            SaveComments;
+          Case CurSection of
+          stType:
+            ParseClassLocalTypes(AType,CurVisibility);
+          stConst :
+            ParseClassLocalConsts(AType,CurVisibility);
+          stNone,
+          stvar:
+            begin
+            if (AType.ObjKind in [okInterface,okDispInterface]) then
+              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
+            ParseClassFields(AType,CurVisibility,HaveClass);
+            HaveClass:=False;
+            end;
+          else
+            Raise Exception.Create('Internal error 201704251415');
+          end;
+          end;
       tkProcedure,tkFunction,tkConstructor,tkDestructor:
         begin
-        SaveComments;
-        if (Curtoken in [tkConstructor,tkDestructor]) and (AType.ObjKind in [okInterface,okRecordHelper]) then
-          ParseExc(SParserNoConstructorAllowed);
-        ProcessMethod(AType,False,CurVisibility);
+        curSection:=stNone;
+        if not haveClass then
+          SaveComments;
+        if (Curtoken in [tkConstructor,tkDestructor]) and (AType.ObjKind in [okInterface,okDispInterface,okRecordHelper]) then
+          ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
+        ProcessMethod(AType,HaveClass,CurVisibility);
+        haveClass:=False;
         end;
       tkclass:
         begin
-         SaveComments;
-         NextToken;
-         if CurToken in [tkConstructor,tkDestructor,tkprocedure,tkFunction] then
-           ProcessMethod(AType,True,CurVisibility)
-         else if CurToken = tkVar then
-           begin
-           ExpectToken(tkIdentifier);
-           ParseClassFields(AType,CurVisibility,true);
-           end
-         else if CurToken=tkProperty then
-           begin
-           ExpectToken(tkIdentifier);
-           AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility));
-           end
-         else
-           ParseExc(SParserTypeSyntaxError)
+        SaveComments;
+        HaveClass:=True;
+        curSection:=stNone;
         end;
       tkProperty:
         begin
-        SaveComments;
+        curSection:=stNone;
+        if not haveClass then
+          SaveComments;
         ExpectIdentifier;
-        AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility));
-        end;
+        AType.Members.Add(ParseProperty(AType,CurtokenString,CurVisibility,HaveClass));
+        HaveClass:=False;
+        end
+    else
+      CheckToken(tkIdentifier);
     end;
     NextToken;
     end;
 end;
+
 procedure TPasParser.DoParseClassType(AType: TPasClassType);
 
 var
-  Element : TPasElement;
   s: String;
+  Expr: TPasExpr;
 
 begin
-  // nettism/new delphi features
-  if (CurToken=tkIdentifier) and (Atype.ObjKind in [okClass,okGeneric]) then
+  if (CurToken=tkIdentifier) and (AType.ObjKind in [okClass,okGeneric]) then
     begin
     s := LowerCase(CurTokenString);
     if (s = 'sealed') or (s = 'abstract') then
@@ -4140,41 +5783,38 @@ begin
       end;
     end;
   // Parse ancestor list
-  Atype.IsForward:=(CurToken=tkSemiColon);
+  AType.IsForward:=(CurToken=tkSemiColon);
   if (CurToken=tkBraceOpen) then
     begin
-    AType.AncestorType := ParseType(nil);
-    while True do
+    // read ancestor and interfaces
+    NextToken;
+    AType.AncestorType := ParseTypeReference(AType,false,Expr);
+    while CurToken=tkComma do
       begin
       NextToken;
-      if CurToken = tkBraceClose then
-        break;
-      UngetToken;
-      ExpectToken(tkComma);
-      Element:=ParseType(Nil); // search interface.
-      if assigned(element) then
-        AType.Interfaces.add(element);
+      AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
       end;
+    CheckToken(tkBraceClose);
     NextToken;
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     end;
   if (AType.ObjKind in [okClassHelper,okRecordHelper]) then
     begin
-    if (CurToken<>tkFor) then
-      ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkFor]]));
-    AType.HelperForType:=ParseType(Nil);
+    CheckToken(tkfor);
     NextToken;
+    AType.HelperForType:=ParseTypeReference(AType,false,Expr);
     end;
+  Engine.FinishScope(stAncestors,AType);
   if (AType.IsShortDefinition or AType.IsForward) then
     UngetToken
   else
     begin
-    if (AType.ObjKind=okInterface) and (CurToken = tkSquaredBraceOpen) then
+    if (AType.ObjKind in [okInterface,okDispInterface]) and (CurToken = tkSquaredBraceOpen) then
       begin
       NextToken;
       AType.GUIDExpr:=DoParseExpression(AType);
       if (CurToken<>tkSquaredBraceClose) then
-        ParseExc(Format(SParserExpectTokenError,[TokenInfos[tkSquaredBraceClose]]));
+        ParseExcTokenError(TokenInfos[tkSquaredBraceClose]);
       NextToken;
       end;
     ParseClassMembers(AType);
@@ -4182,74 +5822,304 @@ begin
 end;
 
 function TPasParser.ParseClassDecl(Parent: TPasElement;
-  const AClassName: String; AObjKind: TPasObjKind; PackMode: TPackMode
-  ): TPasType;
+  const NamePos: TPasSourcePos; const AClassName: String;
+  AObjKind: TPasObjKind; PackMode: TPackMode; GenericArgs: TFPList): TPasType;
 
 Var
-  SourcefileName : string;
-  SourceLineNumber : Integer;
-
+  ok: Boolean;
+  FT : TPasType;
+  AExternalNameSpace,AExternalName : String;
+  PCT:TPasClassType;
 begin
-  // Save current parsing position to get it correct in all cases
-  SourceFilename := Scanner.CurFilename;
-  SourceLinenumber := Scanner.CurRow;
-
   NextToken;
-
+  FT:=Nil;
   if (AObjKind = okClass) and (CurToken = tkOf) then
     begin
-    Result := TPasClassOfType(Engine.CreateElement(TPasClassOfType, AClassName,
-      Parent, SourceFilename, SourceLinenumber));
+    Result := TPasClassOfType(CreateElement(TPasClassOfType, AClassName,
+      Parent, NamePos));
     ExpectIdentifier;
     UngetToken;                // Only names are allowed as following type
-    TPasClassOfType(Result).DestType := ParseType(Result);
+    TPasClassOfType(Result).DestType := ParseType(Result,CurSourcePos);
+    Engine.FinishScope(stTypeDef,Result);
     exit;
     end;
-  if (CurToken = tkHelper) then
+  if ((AobjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches) and  CurTokenIsIdentifier('external')) then
+    begin
+    NextToken;
+    if CurToken<>tkString then
+      UnGetToken
+    else
+      AExternalNameSpace:=CurTokenString;
+    ExpectIdentifier;
+    If Not CurTokenIsIdentifier('Name')  then
+      ParseExc(nParserExpectedExternalClassName,SParserExpectedExternalClassName);
+    NextToken;
+    if not (CurToken in [tkChar,tkString]) then
+      CheckToken(tkString);
+    AExternalName:=CurTokenString;
+    NextToken;
+    end
+  else
+    begin
+    AExternalNameSpace:='';
+    AExternalName:='';
+    end;
+  if (CurTokenIsIdentifier('Helper')) then
     begin
-    if Not (AObjKind in [okClass,okRecordHelper]) then
-      ParseExc(Format(SParserHelperNotAllowed,[ObjKindNames[AObjKind]]));
-    if (AObjKind = okClass)  then
-      AObjKind:=okClassHelper;
+    if Not (AObjKind in [okClass,okTypeHelper,okRecordHelper]) then
+      ParseExc(nParserHelperNotAllowed,SParserHelperNotAllowed,[ObjKindNames[AObjKind]]);
+    Case AObjKind of
+     okClass:
+       AObjKind:=okClassHelper;
+     okTypeHelper:
+       begin
+       ExpectToken(tkFor);
+       FT:=ParseType(Parent,CurSourcePos,'',False);
+       end
+    end;
     NextToken;
     end;
-  Result := TPasClassType(Engine.CreateElement(TPasClassType, AClassName,
-    Parent, SourceFilename, SourceLinenumber));
-
+  PCT := TPasClassType(CreateElement(TPasClassType, AClassName,
+    Parent, NamePos));
+  Result:=PCT;
+  PCT.HelperForType:=FT;
+  PCT.IsExternal:=(AExternalName<>'');
+  if AExternalName<>'' then
+    PCT.ExternalName:=AnsiDequotedStr(AExternalName,'''');
+  if AExternalNameSpace<>'' then
+    PCT.ExternalNameSpace:=AnsiDequotedStr(AExternalNameSpace,'''');
+  ok:=false;
   try
-    TPasClassType(Result).ObjKind := AObjKind;
-    TPasClassType(Result).PackMode:=PackMode;
-    DoParseClassType(TPasClassType(Result));
-  except
-    Result.Free;
-    raise;
+    PCT.ObjKind := AObjKind;
+    PCT.PackMode:=PackMode;
+    if Assigned(GenericArgs) then
+      PCT.SetGenericTemplates(GenericArgs);
+    DoParseClassType(PCT);
+    Engine.FinishScope(stTypeDef,Result);
+    ok:=true;
+  finally
+    if not ok then
+      Result.Release;
   end;
 end;
 
 function TPasParser.CreateElement(AClass: TPTreeElement; const AName: String;
   AParent: TPasElement): TPasElement;
 begin
-  Result := Engine.CreateElement(AClass, AName, AParent,
-    Scanner.CurFilename, Scanner.CurRow);
+  Result := Engine.CreateElement(AClass, AName, AParent, visDefault, CurSourcePos);
+end;
+
+function TPasParser.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; const ASrcPos: TPasSourcePos): TPasElement;
+begin
+  Result := Engine.CreateElement(AClass, AName, AParent, visDefault, ASrcPos);
 end;
 
 function TPasParser.CreateElement(AClass: TPTreeElement; const AName: String;
   AParent: TPasElement; AVisibility: TPasMemberVisibility): TPasElement;
 begin
   Result := Engine.CreateElement(AClass, AName, AParent, AVisibility,
-    Scanner.CurFilename, Scanner.CurRow);
+    CurSourcePos);
+end;
+
+function TPasParser.CreateElement(AClass: TPTreeElement; const AName: String;
+  AParent: TPasElement; AVisibility: TPasMemberVisibility;
+  const ASrcPos: TPasSourcePos): TPasElement;
+begin
+  Result := Engine.CreateElement(AClass, AName, AParent, AVisibility, ASrcPos);
+end;
+
+function TPasParser.CreatePrimitiveExpr(AParent: TPasElement;
+  AKind: TPasExprKind; const AValue: String): TPrimitiveExpr;
+begin
+  Result:=TPrimitiveExpr(CreateElement(TPrimitiveExpr,'',AParent));
+  Result.Kind:=AKind;
+  Result.Value:=AValue;
+end;
+
+function TPasParser.CreateBoolConstExpr(AParent: TPasElement;
+  AKind: TPasExprKind; const ABoolValue: Boolean): TBoolConstExpr;
+begin
+  Result:=TBoolConstExpr(CreateElement(TBoolConstExpr,'',AParent));
+  Result.Kind:=AKind;
+  Result.Value:=ABoolValue;
+end;
+
+function TPasParser.CreateBinaryExpr(AParent: TPasElement; xleft,
+  xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr;
+begin
+  Result:=TBinaryExpr(CreateElement(TBinaryExpr,'',AParent));
+  Result.OpCode:=AOpCode;
+  Result.Kind:=pekBinary;
+  if xleft<>nil then
+    begin
+    Result.left:=xleft;
+    xleft.Parent:=Result;
+    end;
+  if xright<>nil then
+    begin
+    Result.right:=xright;
+    xright.Parent:=Result;
+    end;
+end;
+
+procedure TPasParser.AddToBinaryExprChain(var ChainFirst: TPasExpr;
+  Element: TPasExpr; AOpCode: TExprOpCode);
+begin
+  if Element=nil then
+    exit
+  else if ChainFirst=nil then
+    begin
+    // empty chain => simply add element, no need to create TBinaryExpr
+    ChainFirst:=Element;
+    end
+  else
+    begin
+    // create new binary, old becomes left, Element right
+    ChainFirst:=CreateBinaryExpr(ChainFirst.Parent,ChainFirst,Element,AOpCode);
+    end;
+end;
+
+procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
+  Params: TParamsExpr);
+// append Params to chain, using the last(right) element as Params.Value
+var
+  Bin: TBinaryExpr;
+begin
+  if Params.Value<>nil then
+    ParseExcSyntaxError;
+  if ChainFirst=nil then
+    ParseExcSyntaxError;
+  if ChainFirst is TBinaryExpr then
+    begin
+    Bin:=TBinaryExpr(ChainFirst);
+    if Bin.left=nil then
+      ParseExcSyntaxError;
+    if Bin.right=nil then
+      ParseExcSyntaxError;
+    Params.Value:=Bin.right;
+    Params.Value.Parent:=Params;
+    Bin.right:=Params;
+    Params.Parent:=Bin;
+    end
+  else
+    begin
+    Params.Value:=ChainFirst;
+    Params.Parent:=ChainFirst.Parent;
+    ChainFirst.Parent:=Params;
+    ChainFirst:=Params;
+    end;
+end;
+
+{$IFDEF VerbosePasParser}
+procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr
+  );
+var
+  i: Integer;
+begin
+  if First=nil then
+    begin
+    write(Prefix,'First=nil');
+    if Last=nil then
+      writeln('=Last')
+    else
+      begin
+      writeln(', ERROR Last=',Last.ClassName);
+      ParseExcSyntaxError;
+      end;
+    end
+  else if Last=nil then
+    begin
+    writeln(Prefix,'ERROR Last=nil First=',First.ClassName);
+    ParseExcSyntaxError;
+    end
+  else if First is TBinaryExpr then
+    begin
+    i:=0;
+    while First is TBinaryExpr do
+      begin
+      writeln(Prefix,Space(i*2),'bin.left=',TBinaryExpr(First).left.ClassName);
+      if First=Last then break;
+      First:=TBinaryExpr(First).right;
+      inc(i);
+      end;
+    if First<>Last then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last is not last in chain');
+      ParseExcSyntaxError;
+      end;
+    if not (Last is TBinaryExpr) then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last is not TBinaryExpr: ',Last.ClassName);
+      ParseExcSyntaxError;
+      end;
+    if TBinaryExpr(Last).right=nil then
+      begin
+      writeln(Prefix,Space(i*2),'ERROR Last.right=nil');
+      ParseExcSyntaxError;
+      end;
+    writeln(Prefix,Space(i*2),'last.right=',TBinaryExpr(Last).right.ClassName);
+    end
+  else if First=Last then
+    writeln(Prefix,'First=Last=',First.ClassName)
+  else
+    begin
+    write(Prefix,'ERROR First=',First.ClassName);
+    if Last<>nil then
+      writeln(' Last=',Last.ClassName)
+    else
+      writeln(' Last=nil');
+    end;
+end;
+{$ENDIF}
+
+function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
+  AOpCode: TExprOpCode): TUnaryExpr;
+begin
+  Result:=TUnaryExpr(CreateElement(TUnaryExpr,'',AParent));
+  Result.Kind:=pekUnary;
+  Result.Operand:=AOperand;
+  Result.Operand.Parent:=Result;
+  Result.OpCode:=AOpCode;
+end;
+
+function TPasParser.CreateArrayValues(AParent: TPasElement): TArrayValues;
+begin
+  Result:=TArrayValues(CreateElement(TArrayValues,'',AParent));
+  Result.Kind:=pekListOfExp;
 end;
 
 function TPasParser.CreateFunctionType(const AName, AResultName: String;
-  AParent: TPasElement; UseParentAsResultParent: Boolean): TPasFunctionType;
+  AParent: TPasElement; UseParentAsResultParent: Boolean;
+  const NamePos: TPasSourcePos): TPasFunctionType;
 begin
   Result:=Engine.CreateFunctionType(AName,AResultName,
                                     AParent,UseParentAsResultParent,
-                                    Scanner.CurFilename,Scanner.CurRow);
+                                    NamePos);
 end;
 
+function TPasParser.CreateInheritedExpr(AParent: TPasElement): TInheritedExpr;
+begin
+  Result:=TInheritedExpr(CreateElement(TInheritedExpr,'',AParent));
+  Result.Kind:=pekInherited;
+end;
 
+function TPasParser.CreateSelfExpr(AParent: TPasElement): TSelfExpr;
+begin
+  Result:=TSelfExpr(CreateElement(TSelfExpr,'Self',AParent));
+  Result.Kind:=pekSelf;
+end;
 
-initialization
+function TPasParser.CreateNilExpr(AParent: TPasElement): TNilExpr;
+begin
+  Result:=TNilExpr(CreateElement(TNilExpr,'nil',AParent));
+  Result.Kind:=pekNil;
+end;
+
+function TPasParser.CreateRecordValues(AParent: TPasElement): TRecordValues;
+begin
+  Result:=TRecordValues(CreateElement(TRecordValues,'',AParent));
+  Result.Kind:=pekListOfExp;
+end;
 
 end.
diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp
index 00f8ea440a..7a7f5e6929 100644
--- a/packages/fcl-passrc/src/pscanner.pp
+++ b/packages/fcl-passrc/src/pscanner.pp
@@ -23,6 +23,38 @@ interface
 
 uses SysUtils, Classes;
 
+// message numbers
+const
+  nErrInvalidCharacter = 1001;
+  nErrOpenString = 1002;
+  nErrIncludeFileNotFound = 1003;
+  nErrIfXXXNestingLimitReached = 1004;
+  nErrInvalidPPElse = 1005;
+  nErrInvalidPPEndif = 1006;
+  nLogOpeningFile = 1007;
+  nLogLineNumber = 1008;
+  nLogIFDefAccepted = 1009;
+  nLogIFDefRejected = 1010;
+  nLogIFNDefAccepted = 1011;
+  nLogIFNDefRejected = 1012;
+  nLogIFAccepted = 1013;
+  nLogIFRejected = 1014;
+  nLogIFOptAccepted = 1015;
+  nLogIFOptRejected = 1016;
+  nLogELSEIFAccepted = 1017;
+  nLogELSEIFRejected = 1018;
+  nErrInvalidMode = 1019;
+  nErrInvalidModeSwitch = 1020;
+  nErrXExpectedButYFound = 1021;
+  nErrRangeCheck = 1022;
+  nErrDivByZero = 1023;
+  nErrOperandAndOperatorMismatch = 1024;
+  nUserDefined = 1025;
+  nLogMacroDefined = 1026; // FPC=3101
+  nLogMacroUnDefined = 1027; // FPC=3102
+  nWarnIllegalCompilerDirectiveX = 1028;
+
+// resourcestring patterns of messages
 resourcestring
   SErrInvalidCharacter = 'Invalid character ''%s''';
   SErrOpenString = 'string exceeds end of line';
@@ -36,10 +68,36 @@ resourcestring
   SLogIFDefRejected = 'IFDEF %s found, rejecting.';
   SLogIFNDefAccepted = 'IFNDEF %s found, accepting.';
   SLogIFNDefRejected = 'IFNDEF %s found, rejecting.';
-  SLogIFOPTIgnored = 'IFOPT %s found, ignoring (rejected).';
-  SLogIFIgnored = 'IF %s found, ignoring (rejected).';
+  SLogIFAccepted = 'IF %s found, accepting.';
+  SLogIFRejected = 'IF %s found, rejecting.';
+  SLogIFOptAccepted = 'IFOpt %s found, accepting.';
+  SLogIFOptRejected = 'IFOpt %s found, rejecting.';
+  SLogELSEIFAccepted = 'ELSEIF %s found, accepting.';
+  SLogELSEIFRejected = 'ELSEIF %s found, rejecting.';
+  SErrInvalidMode = 'Invalid mode: "%s"';
+  SErrInvalidModeSwitch = 'Invalid mode switch: "%s"';
+  SErrXExpectedButYFound = '"%s" expected, but "%s" found';
+  sErrRangeCheck = 'range check failed';
+  sErrDivByZero = 'division by zero';
+  sErrOperandAndOperatorMismatch = 'operand and operator mismatch';
+  SUserDefined = 'User defined: "%s"';
+  sLogMacroDefined = 'Macro defined: %s';
+  sLogMacroUnDefined = 'Macro undefined: %s';
+  sWarnIllegalCompilerDirectiveX = 'Illegal compiler directive "%s"';
 
 type
+  TMessageType = (
+    mtFatal,
+    mtError,
+    mtWarning,
+    mtNote,
+    mtHint,
+    mtInfo,
+    mtDebug
+    );
+  TMessageTypes = set of TMessageType;
+
+  TMessageArgs = array of string;
 
   TToken = (
     tkEOF,
@@ -94,6 +152,7 @@ type
     tkconstref,
     tkconstructor,
     tkdestructor,
+    tkdispinterface,
     tkdiv,
     tkdo,
     tkdownto,
@@ -109,7 +168,6 @@ type
     tkfunction,
     tkgeneric,
     tkgoto,
-    tkHelper,
     tkif,
     tkimplementation,
     tkin,
@@ -125,7 +183,6 @@ type
     tknot,
     tkobject,
     tkof,
-    tkon,
     tkoperator,
     tkor,
     tkpacked,
@@ -160,6 +217,54 @@ type
     );
   TTokens = set of TToken;
 
+  TModeSwitch = (
+    msNone,
+    { generic }
+    msFpc, msObjfpc, msDelphi, msDelphiUnicode, msTP7, msMac, msIso, msExtpas, msGPC,
+    { more specific }
+    msClass,               { delphi class model }
+    msObjpas,              { load objpas unit }
+    msResult,              { result in functions }
+    msStringPchar,         { pchar 2 string conversion }
+    msCVarSupport,         { cvar variable directive }
+    msNestedComment,       { nested comments }
+    msTPProcVar,           { tp style procvars (no @ needed) }
+    msMacProcVar,          { macpas style procvars }
+    msRepeatForward,       { repeating forward declarations is needed }
+    msPointer2Procedure,   { allows the assignement of pointers to
+                             procedure variables                     }
+    msAutoDeref,           { does auto dereferencing of struct. vars }
+    msInitFinal,           { initialization/finalization for units }
+    msDefaultAnsistring,   { ansistring turned on by default }
+    msOut,                 { support the calling convention OUT }
+    msDefaultPara,         { support default parameters }
+    msHintDirective,       { support hint directives }
+    msDuplicateNames,      { allow locals/paras to have duplicate names of globals }
+    msProperty,            { allow properties }
+    msDefaultInline,       { allow inline proc directive }
+    msExcept,              { allow exception-related keywords }
+    msObjectiveC1,         { support interfacing with Objective-C (1.0) }
+    msObjectiveC2,         { support interfacing with Objective-C (2.0) }
+    msNestedProcVars,      { support nested procedural variables }
+    msNonLocalGoto,        { support non local gotos (like iso pascal) }
+    msAdvancedRecords,     { advanced record syntax with visibility sections, methods and properties }
+    msISOLikeUnaryMinus,   { unary minus like in iso pascal: same precedence level as binary minus/plus }
+    msSystemCodePage,      { use system codepage as compiler codepage by default, emit ansistrings with system codepage }
+    msFinalFields,         { allows declaring fields as "final", which means they must be initialised
+                             in the (class) constructor and are constant from then on (same as final
+                             fields in Java) }
+    msDefaultUnicodestring, { makes the default string type in $h+ mode unicodestring rather than
+                               ansistring; similarly, char becomes unicodechar rather than ansichar }
+    msTypeHelpers,         { allows the declaration of "type helper" (non-Delphi) or "record helper"
+                             (Delphi) for primitive types }
+    msCBlocks,             { 'cblocks', support for http://en.wikipedia.org/wiki/Blocks_(C_language_extension) }
+    msISOLikeIO,           { I/O as it required by an ISO compatible compiler }
+    msISOLikeProgramsPara, { program parameters as it required by an ISO compatible compiler }
+    msISOLikeMod,          { mod operation as it is required by an iso compatible compiler }
+    msExternalClass        { Allow external class definitions }
+  );
+  TModeSwitches = Set of TModeSwitch;
+
   { TMacroDef }
 
   TMacroDef = Class(TObject)
@@ -221,7 +326,7 @@ type
 
   TStringStreamLineReader = class(TStreamLineReader)
   Public
-    constructor Create( const AFilename: string; Const ASource: String);
+    constructor Create( const AFilename: string; Const ASource: String); reintroduce;
   end;
 
   { TMacroReader }
@@ -287,6 +392,75 @@ type
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindIncludeFile(const AName: string): TLineReader; override;
     Property OwnsStreams : Boolean Read FOwnsStreams write SetOwnsStreams;
+    Property Streams: TStringList read FStreams;
+  end;
+
+const
+  CondDirectiveBool: array[boolean] of string = (
+    '0', // false
+    '1'  // true  Note: True is <>'0'
+    );
+type
+  TCondDirectiveEvaluator = class;
+
+  TCEEvalVarEvent = function(Sender: TCondDirectiveEvaluator; Name: String; out Value: string): boolean of object;
+  TCEEvalFunctionEvent = function(Sender: TCondDirectiveEvaluator; Name, Param: String; out Value: string): boolean of object;
+  TCELogEvent = procedure(Sender: TCondDirectiveEvaluator; Args : Array of const) of object;
+
+  { TCondDirectiveEvaluator - evaluate $IF expression }
+
+  TCondDirectiveEvaluator = class
+  private
+    FOnEvalFunction: TCEEvalFunctionEvent;
+    FOnEvalVariable: TCEEvalVarEvent;
+    FOnLog: TCELogEvent;
+  protected
+    type
+      TPrecedenceLevel = (
+        ceplFirst, // tkNot
+        ceplSecond, // *, /, div, mod, and, shl, shr
+        ceplThird, // +, -, or, xor
+        ceplFourth // =, <>, <, >, <=, >=
+        );
+      TStackItem = record
+        Level: TPrecedenceLevel;
+        Operathor: TToken;
+        Operand: String;
+        OperandPos: integer;
+      end;
+  protected
+    FTokenStart: PChar;
+    FTokenEnd: PChar;
+    FToken: TToken;
+    FStack: array of TStackItem;
+    FStackTop: integer;
+    function IsFalse(const Value: String): boolean; inline;
+    function IsTrue(const Value: String): boolean; inline;
+    function IsInteger(const Value: String; out i: int64): boolean;
+    function IsExtended(const Value: String; out e: extended): boolean;
+    procedure NextToken;
+    procedure Log(aMsgType: TMessageType; aMsgNumber: integer;
+      const aMsgFmt: String; const Args: array of const; MsgPos: integer = 0);
+    procedure LogXExpectedButTokenFound(const X: String; ErrorPos: integer = 0);
+    procedure ReadOperand(Skip: boolean = false); // unary operators plus one operand
+    procedure ReadExpression; // binary operators
+    procedure ResolveStack(MinStackLvl: integer; Level: TPrecedenceLevel;
+      NewOperator: TToken);
+    function GetTokenString: String;
+    function GetStringLiteralValue: String; // read value of tkString
+    procedure Push(const AnOperand: String; OperandPosition: integer);
+  public
+    Expression: String;
+    MsgPos: integer;
+    MsgNumber: integer;
+    MsgType: TMessageType;
+    MsgPattern: String; // Format parameter
+    constructor Create;
+    destructor Destroy; override;
+    function Eval(const Expr: string): boolean;
+    property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
+    property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
+    property OnLog: TCELogEvent read FOnLog write FOnLog;
   end;
 
   EScannerError       = class(Exception);
@@ -294,17 +468,48 @@ type
 
   TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch, ppSkipAll);
 
-  TPOption = (po_delphi,po_cassignments);
+  TPOption = (
+    po_delphi,               // DEPRECATED Delphi mode: forbid nested comments
+    po_KeepScannerError,     // default: catch EScannerError and raise an EParserError instead
+    po_CAssignments,         // allow C-operators += -= *= /=
+    po_ResolveStandardTypes, // search for 'longint', 'string', etc., do not use dummies, TPasResolver sets this to use its declarations
+    po_AsmWhole,             // store whole text between asm..end in TPasImplAsmStatement.Tokens
+    po_NoOverloadedProcs,    // do not create TPasOverloadedProc for procs with same name
+    po_KeepClassForward,     // disabled: delete class fowards when there is a class declaration
+    po_ArrayRangeExpr,       // enable: create TPasArrayType.IndexRange, disable: create TPasArrayType.Ranges
+    po_SelfToken,            // Self is a token. For backward compatibility.
+    po_CheckModeSwitches,    // stop on unknown modeswitch with an error
+    po_CheckCondFunction     // stop on unknown function in conditional expression, default: return '0'
+    );
   TPOptions = set of TPOption;
 
+type
+  TPasSourcePos = Record
+    FileName: String;
+    Row, Column: Cardinal;
+  end;
+
+type
   { TPascalScanner }
 
   TPScannerLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
-  TPScannerLogEvent = (sleFile,sleLineNumber,sleConditionals);
+  TPScannerLogEvent = (sleFile,sleLineNumber,sleConditionals,sleDirective);
   TPScannerLogEvents = Set of TPScannerLogEvent;
+  TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String;
+    var Handled: boolean) of object;
 
   TPascalScanner = class
   private
+    FAllowedModes: TModeSwitches;
+    FAllowedModeSwitches: TModeSwitches;
+    FConditionEval: TCondDirectiveEvaluator;
+    FCurrentModeSwitches: TModeSwitches;
+    FForceCaret: Boolean;
+    FLastMsg: string;
+    FLastMsgArgs: TMessageArgs;
+    FLastMsgNumber: integer;
+    FLastMsgPattern: string;
+    FLastMsgType: TMessageType;
     FFileResolver: TBaseFileResolver;
     FCurSourceFile: TLineReader;
     FCurFilename: string;
@@ -314,9 +519,15 @@ type
     FCurLine: string;
     FMacros,
     FDefines: TStrings;
+    FMacrosOn: boolean;
+    FOnDirective: TPScannerDirectiveEvent;
+    FOnEvalFunction: TCEEvalFunctionEvent;
+    FOnEvalVariable: TCEEvalVarEvent;
     FOptions: TPOptions;
     FLogEvents: TPScannerLogEvents;
     FOnLog: TPScannerLogHandler;
+    FPreviousToken: TToken;
+    FReadOnlyModeSwitches: TModeSwitches;
     FSkipComments: Boolean;
     FSkipWhiteSpace: Boolean;
     TokenStr: PChar;
@@ -328,17 +539,43 @@ type
     PPSkipStackIndex: Integer;
     PPSkipModeStack: array[0..255] of TPascalScannerPPSkipMode;
     PPIsSkippingStack: array[0..255] of Boolean;
-
     function GetCurColumn: Integer;
+    function OnCondEvalFunction(Sender: TCondDirectiveEvaluator; Name,
+      Param: String; out Value: string): boolean;
+    procedure OnCondEvalLog(Sender: TCondDirectiveEvaluator;
+      Args: array of const);
+    function OnCondEvalVar(Sender: TCondDirectiveEvaluator; Name: String; out
+      Value: string): boolean;
+    procedure SetAllowedModeSwitches(const AValue: TModeSwitches);
+    procedure SetCurrentModeSwitches(AValue: TModeSwitches);
     procedure SetOptions(AValue: TPOptions);
+    procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
   protected
-    Procedure DoLog(Const Msg : String; SkipSourceInfo : Boolean = False);overload;
-    Procedure DoLog(Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
-    procedure Error(const Msg: string);overload;
-    procedure Error(const Msg: string; Args: array of Const);overload;
+    function FetchLine: boolean;
+    function GetMacroName(const Param: String): String;
+    procedure SetCurMsg(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const);
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Msg : String; SkipSourceInfo : Boolean = False);overload;
+    Procedure DoLog(MsgType: TMessageType; MsgNumber: integer; Const Fmt : String; Args : Array of const;SkipSourceInfo : Boolean = False);overload;
+    procedure Error(MsgNumber: integer; const Msg: string);overload;
+    procedure Error(MsgNumber: integer; const Fmt: string; Args: array of Const);overload;
+    procedure PushSkipMode;
+    function HandleDirective(const ADirectiveText: String): TToken; virtual;
+    function HandleLetterDirective(Letter: char; Enable: boolean): TToken; virtual;
+    procedure HandleIFDEF(const AParam: String);
+    procedure HandleIFNDEF(const AParam: String);
+    procedure HandleIFOPT(const AParam: String);
+    procedure HandleIF(const AParam: String);
+    procedure HandleELSEIF(const AParam: String);
+    procedure HandleELSE(const AParam: String);
+    procedure HandleENDIF(const AParam: String);
     procedure HandleDefine(Param: String); virtual;
+    procedure HandleError(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleUnDefine(Param: String);virtual;
+    function HandleInclude(const Param: String): TToken;virtual;
+    procedure HandleMacroDirective(const Param: String);virtual;
+    procedure HandleMode(const Param: String);virtual;
+    procedure HandleModeSwitch(const Param: String);virtual;
     function HandleMacro(AIndex: integer): TToken;virtual;
     procedure PushStackItem; virtual;
     function DoFetchTextToken: TToken;
@@ -352,8 +589,17 @@ type
     destructor Destroy; override;
     procedure OpenFile(const AFilename: string);
     function FetchToken: TToken;
-    Procedure AddDefine(S : String);
-    Procedure RemoveDefine(S : String);
+    function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
+    function AddDefine(const aName: String; Quiet: boolean = false): boolean;
+    function RemoveDefine(const aName: String; Quiet: boolean = false): boolean;
+    function UnDefine(const aName: String; Quiet: boolean = false): boolean; // check defines and macros
+    function IsDefined(const aName: String): boolean; // check defines and macros
+    function IfOpt(Letter: Char): boolean;
+    function AddMacro(const aName, aValue: String; Quiet: boolean = false): boolean;
+    function RemoveMacro(const aName: String; Quiet: boolean = false): boolean;
+    Procedure SetCompilerMode(S : String);
+    function CurSourcePos: TPasSourcePos;
+    Function SetForceCaret(AValue : Boolean) : Boolean;
 
     property FileResolver: TBaseFileResolver read FFileResolver;
     property CurSourceFile: TLineReader read FCurSourceFile;
@@ -366,12 +612,28 @@ type
 
     property CurToken: TToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
+    Property PreviousToken : TToken Read FPreviousToken;
 
     property Defines: TStrings read FDefines;
     property Macros: TStrings read FMacros;
-    Property Options : TPOptions Read FOptions Write SetOptions;
-    Property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
-    Property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
+    property MacrosOn: boolean read FMacrosOn write FMacrosOn;
+    property OnDirective: TPScannerDirectiveEvent read FOnDirective write FOnDirective;
+    property AllowedModeSwitches: TModeSwitches Read FAllowedModeSwitches Write SetAllowedModeSwitches;
+    property ReadOnlyModeSwitches: TModeSwitches Read FReadOnlyModeSwitches Write SetReadOnlyModeSwitches;// always set, cannot be disabled
+    property CurrentModeSwitches: TModeSwitches Read FCurrentModeSwitches Write SetCurrentModeSwitches;
+    property Options : TPOptions Read FOptions Write SetOptions;
+    property ForceCaret : Boolean Read FForceCaret;
+    property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
+    property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
+    property ConditionEval: TCondDirectiveEvaluator read FConditionEval;
+    property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
+    property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
+
+    property LastMsg: string read FLastMsg write FLastMsg;
+    property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
+    property LastMsgType: TMessageType read FLastMsgType write FLastMsgType;
+    property LastMsgPattern: string read FLastMsgPattern write FLastMsgPattern;
+    property LastMsgArgs: TMessageArgs read FLastMsgArgs write FLastMsgArgs;
   end;
 
 const
@@ -426,6 +688,7 @@ const
     'constref',
     'constructor',
     'destructor',
+    'dispinterface',
     'div',
     'do',
     'downto',
@@ -441,7 +704,6 @@ const
     'function',
     'generic',
     'goto',
-    'helper',
     'if',
     'implementation',
     'in',
@@ -457,7 +719,6 @@ const
     'not',
     'object',
     'of',
-    'on',
     'operator',
     'or',
     'packed',
@@ -491,11 +752,127 @@ const
     'Tab'
   );
 
+  SModeSwitchNames : array[TModeSwitch] of string[18] =
+  ( '', // msNone
+    '', // Fpc,
+    '', // Objfpc,
+    '', // Delphi,
+    '', // DelphiUnicode,
+    '', // TP7,
+    '', // Mac,
+    '', // Iso,
+    '', // Extpas,
+    '', // GPC,
+    { more specific }
+    'CLASS',
+    'OBJPAS',
+    'RESULT',
+    'PCHARTOSTRING',
+    'CVAR',
+    'NESTEDCOMMENTS',
+    'CLASSICPROCVARS',
+    'MACPROCVARS',
+    'REPEATFORWARD',
+    'POINTERTOPROCVAR',
+    'AUTODEREF',
+    'INITFINAL',
+    'ANSISTRINGS',
+    'OUT',
+    'DEFAULTPARAMETERS',
+    'HINTDIRECTIVE',
+    'DUPLICATELOCALS',
+    'PROPERTIES',
+    'ALLOWINLINE',
+    'EXCEPTIONS',
+    'OBJECTIVEC1',
+    'OBJECTIVEC2',
+    'NESTEDPROCVARS',
+    'NONLOCALGOTO',
+    'ADVANCEDRECORDS',
+    'ISOUNARYMINUS',
+    'SYSTEMCODEPAGE',
+    'FINALFIELDS',
+    'UNICODESTRINGS',
+    'TYPEHELPERS',
+    'CBLOCKS',
+    'ISOIO',
+    'ISOPROGRAMPARAS',
+    'ISOMOD',
+    'EXTERNALCLASS'
+    );
+
+  LetterSwitchNames: array['A'..'Z'] of string=(
+     'ALIGN'          // A
+    ,'BOOLEVAL'       // B
+    ,'ASSERTIONS'     // C
+    ,'DEBUGINFO'      // D
+    ,'EXTENSION'      // E
+    ,''               // F
+    ,'IMPORTEDDATA'   // G
+    ,'LONGSTRINGS'    // H
+    ,'IOCHECKS'       // I
+    ,'WRITEABLECONST' // J
+    ,''               // K
+    ,'LOCALSYMBOLS'   // L
+    ,'TYPEINFO'       // M
+    ,''               // N
+    ,'OPTIMIZATION'   // O
+    ,'OPENSTRINGS'    // P
+    ,'OVERFLOWCHECKS' // Q
+    ,'RANGECHECKS'    // R
+    ,''               // S
+    ,'TYPEADDRESS'    // T
+    ,'SAFEDIVIDE'     // U
+    ,'VARSTRINGCHECKS'// V
+    ,'STACKFRAMES'    // W
+    ,'EXTENDEDSYNTAX' // X
+    ,'REFERENCEINFO'  // Y
+    ,''               // Z
+   );
+const
+  AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
+
+const
+  // all mode switches supported by FPC
+  msAllFPCModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
+
+  DelphiModeSwitches = [msDelphi,msClass,msObjpas,msresult,msstringpchar,
+     mspointer2procedure,msautoderef,msTPprocvar,msinitfinal,msdefaultansistring,
+     msout,msdefaultpara,msduplicatenames,mshintdirective,
+     msproperty,msdefaultinline,msexcept,msadvancedrecords,mstypehelpers];
+
+  DelphiUnicodeModeSwitches = delphimodeswitches + [mssystemcodepage,msdefaultunicodestring];
+
+  // mode switches of $mode FPC, don't confuse with msAllFPCModeSwitches
+  FPCModeSwitches = [msfpc,msstringpchar,msnestedcomment,msrepeatforward,
+    mscvarsupport,msinitfinal,mshintdirective, msproperty,msdefaultinline];
+
+  OBJFPCModeSwitches =  [msobjfpc,msclass,msobjpas,msresult,msstringpchar,msnestedcomment,
+    msrepeatforward,mscvarsupport,msinitfinal,msout,msdefaultpara,mshintdirective,
+    msproperty,msdefaultinline,msexcept];
+
+  TPModeSwitches = [mstp7,mstpprocvar,msduplicatenames];
+
+  GPCModeSwitches = [msgpc,mstpprocvar];
+
+  MacModeSwitches = [msmac,mscvarsupport,msmacprocvar,msnestedprocvars,msnonlocalgoto,
+    msisolikeunaryminus,msdefaultinline];
+
+  ISOModeSwitches =  [msiso,mstpprocvar,msduplicatenames,msnestedprocvars,msnonlocalgoto,msisolikeunaryminus,msisolikeio,
+    msisolikeprogramspara, msisolikemod];
+
+  ExtPasModeSwitches = [msextpas,mstpprocvar,msduplicatenames,msnestedprocvars,msnonlocalgoto,msisolikeunaryminus,msisolikeio,
+    msisolikeprogramspara, msisolikemod];
+
+function StrToModeSwitch(aName: String): TModeSwitch;
 function FilenameIsAbsolute(const TheFilename: string):boolean;
 function FilenameIsWinAbsolute(const TheFilename: string): boolean;
 function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
 function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
 
+procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
+function SafeFormat(const Fmt: string; Args: array of const): string;
+
 implementation
 
 Var
@@ -576,6 +953,58 @@ begin
     T:=SortedTokens[I];
 end;
 
+procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
+var
+  i: Integer;
+begin
+  SetLength(MsgArgs, High(Args)-Low(Args)+1);
+  for i:=Low(Args) to High(Args) do
+    case Args[i].VType of
+      vtInteger:      MsgArgs[i] := IntToStr(Args[i].VInteger);
+      vtBoolean:      MsgArgs[i] := BoolToStr(Args[i].VBoolean);
+      vtChar:         MsgArgs[i] := Args[i].VChar;
+      {$ifndef FPUNONE}
+      vtExtended:     ; //  Args[i].VExtended^;
+      {$ENDIF}
+      vtString:       MsgArgs[i] := Args[i].VString^;
+      vtPointer:      ; //  Args[i].VPointer;
+      vtPChar:        MsgArgs[i] := Args[i].VPChar;
+      vtObject:       ; //  Args[i].VObject;
+      vtClass:        ; //  Args[i].VClass;
+      vtWideChar:     MsgArgs[i] := AnsiString(Args[i].VWideChar);
+      vtPWideChar:    MsgArgs[i] := Args[i].VPWideChar;
+      vtAnsiString:   MsgArgs[i] := AnsiString(Args[i].VAnsiString);
+      vtCurrency:     ; //  Args[i].VCurrency^);
+      vtVariant:      ; //  Args[i].VVariant^);
+      vtInterface:    ; //  Args[i].VInterface^);
+      vtWidestring:   MsgArgs[i] := AnsiString(WideString(Args[i].VWideString));
+      vtInt64:        MsgArgs[i] := IntToStr(Args[i].VInt64^);
+      vtQWord:        MsgArgs[i] := IntToStr(Args[i].VQWord^);
+      vtUnicodeString:MsgArgs[i] := AnsiString(UnicodeString(Args[i].VUnicodeString));
+    end;
+end;
+
+function SafeFormat(const Fmt: string; Args: array of const): string;
+var
+  MsgArgs: TMessageArgs;
+  i: Integer;
+begin
+  try
+    Result:=Format(Fmt,Args);
+  except
+    Result:='';
+    MsgArgs:=nil;
+    CreateMsgArgs(MsgArgs,Args);
+    for i:=0 to length(MsgArgs)-1 do
+      begin
+      if i>0 then
+        Result:=Result+',';
+      Result:=Result+MsgArgs[i];
+      end;
+    Result:='{'+Fmt+'}['+Result+']';
+  end;
+end;
+
 type
   TIncludeStackItem = class
     SourceFile: TLineReader;
@@ -587,6 +1016,17 @@ type
     TokenStr: PChar;
   end;
 
+function StrToModeSwitch(aName: String): TModeSwitch;
+var
+  ms: TModeSwitch;
+begin
+  aName:=UpperCase(aName);
+  if aName='' then exit(msNone);
+  for ms in TModeSwitch do
+    if SModeSwitchNames[ms]=aName then exit(ms);
+  Result:=msNone;
+end;
+
 function FilenameIsAbsolute(const TheFilename: string):boolean;
 begin
   {$IFDEF WINDOWS}
@@ -611,6 +1051,743 @@ begin
   Result:=(TheFilename<>'') and (TheFilename[1]='/');
 end;
 
+{ TCondDirectiveEvaluator }
+
+// inline
+function TCondDirectiveEvaluator.IsFalse(const Value: String): boolean;
+begin
+  Result:=Value=CondDirectiveBool[false];
+end;
+
+// inline
+function TCondDirectiveEvaluator.IsTrue(const Value: String): boolean;
+begin
+  Result:=Value<>CondDirectiveBool[false];
+end;
+
+function TCondDirectiveEvaluator.IsInteger(const Value: String; out i: int64
+  ): boolean;
+var
+  Code: integer;
+begin
+  val(Value,i,Code);
+  Result:=Code=0;
+end;
+
+function TCondDirectiveEvaluator.IsExtended(const Value: String; out e: extended
+  ): boolean;
+var
+  Code: integer;
+begin
+  val(Value,e,Code);
+  Result:=Code=0;
+end;
+
+procedure TCondDirectiveEvaluator.NextToken;
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+
+  function IsIdentifier(a,b: PChar): boolean;
+  var
+    ac: Char;
+  begin
+    repeat
+      ac:=a^;
+      if (ac in IdentChars) and (upcase(ac)=upcase(b^)) then
+        begin
+        inc(a);
+        inc(b);
+        end
+      else
+        begin
+        Result:=(not (ac in IdentChars)) and (not (b^ in IdentChars));
+        exit;
+        end;
+    until false;
+  end;
+
+  function ReadIdentifier: TToken;
+  begin
+    Result:=tkIdentifier;
+    case FTokenEnd-FTokenStart of
+    2:
+      if IsIdentifier(FTokenStart,'or') then
+        Result:=tkor;
+    3:
+      if IsIdentifier(FTokenStart,'not') then
+        Result:=tknot
+      else if IsIdentifier(FTokenStart,'and') then
+        Result:=tkand
+      else if IsIdentifier(FTokenStart,'xor') then
+        Result:=tkxor
+      else if IsIdentifier(FTokenStart,'shl') then
+        Result:=tkshl
+      else if IsIdentifier(FTokenStart,'shr') then
+        Result:=tkshr
+      else if IsIdentifier(FTokenStart,'mod') then
+        Result:=tkmod
+      else if IsIdentifier(FTokenStart,'div') then
+        Result:=tkdiv;
+    end;
+  end;
+
+begin
+  FTokenStart:=FTokenEnd;
+  // skip white space
+  repeat
+    case FTokenStart^ of
+      #0:
+      if FTokenStart-PChar(Expression)>=length(Expression) then
+        begin
+        FToken:=tkEOF;
+        FTokenEnd:=FTokenStart;
+        exit;
+        end
+      else
+        inc(FTokenStart);
+      #9,#10,#13,' ':
+        inc(FTokenStart);
+      else break;
+    end;
+  until false;
+  // read token
+  FTokenEnd:=FTokenStart;
+  case FTokenEnd^ of
+  'a'..'z','A'..'Z','_':
+    begin
+    inc(FTokenEnd);
+    while FTokenEnd^ in IdentChars do inc(FTokenEnd);
+    FToken:=ReadIdentifier;
+    end;
+  '0'..'9':
+    begin
+    FToken:=tkNumber;
+    // examples: 1, 1.2, 1.2E3, 1E-2
+    inc(FTokenEnd);
+    while FTokenEnd^ in ['0'..'9'] do inc(FTokenEnd);
+    if (FTokenEnd^='.') and (FTokenEnd[1]<>'.') then
+      begin
+      inc(FTokenEnd);
+      while FTokenEnd^ in ['0'..'9'] do inc(FTokenEnd);
+      end;
+    if FTokenEnd^ in ['e','E'] then
+      begin
+      inc(FTokenEnd);
+      if FTokenEnd^ in ['-','+'] then inc(FTokenEnd);
+      while FTokenEnd^ in ['0'..'9'] do inc(FTokenEnd);
+      end;
+    end;
+  '$':
+    begin
+    FToken:=tkNumber;
+    while FTokenEnd^ in ['0'..'9','a'..'f','A'..'F'] do inc(FTokenEnd);
+    end;
+  '%':
+    begin
+    FToken:=tkNumber;
+    while FTokenEnd^ in ['0','1'] do inc(FTokenEnd);
+    end;
+  '(':
+    begin
+    FToken:=tkBraceOpen;
+    inc(FTokenEnd);
+    end;
+  ')':
+    begin
+    FToken:=tkBraceClose;
+    inc(FTokenEnd);
+    end;
+  '=':
+    begin
+    FToken:=tkEqual;
+    inc(FTokenEnd);
+    end;
+  '<':
+    begin
+    inc(FTokenEnd);
+    case FTokenEnd^ of
+    '=':
+      begin
+      FToken:=tkLessEqualThan;
+      inc(FTokenEnd);
+      end;
+    '<':
+      begin
+      FToken:=tkshl;
+      inc(FTokenEnd);
+      end;
+    '>':
+      begin
+      FToken:=tkNotEqual;
+      inc(FTokenEnd);
+      end;
+    else
+      FToken:=tkLessThan;
+    end;
+    end;
+  '>':
+    begin
+    inc(FTokenEnd);
+    case FTokenEnd^ of
+    '=':
+      begin
+      FToken:=tkGreaterEqualThan;
+      inc(FTokenEnd);
+      end;
+    '>':
+      begin
+      FToken:=tkshr;
+      inc(FTokenEnd);
+      end;
+    else
+      FToken:=tkGreaterThan;
+    end;
+    end;
+  '+':
+    begin
+    FToken:=tkPlus;
+    inc(FTokenEnd);
+    end;
+  '-':
+    begin
+    FToken:=tkMinus;
+    inc(FTokenEnd);
+    end;
+  '*':
+    begin
+    FToken:=tkMul;
+    inc(FTokenEnd);
+    end;
+  '/':
+    begin
+    FToken:=tkDivision;
+    inc(FTokenEnd);
+    end;
+  '''':
+    begin
+    FToken:=tkString;
+    repeat
+      inc(FTokenEnd);
+      if FTokenEnd^='''' then
+        begin
+        inc(FTokenEnd);
+        if FTokenEnd^<>'''' then break;
+        end
+      else if FTokenEnd^ in [#0,#10,#13] then
+        Log(mtError,nErrOpenString,SErrOpenString,[]);
+    until false;
+    end
+  else
+    FToken:=tkEOF;
+  end;
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.NextToken END Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken);
+  {$ENDIF}
+end;
+
+procedure TCondDirectiveEvaluator.Log(aMsgType: TMessageType;
+  aMsgNumber: integer; const aMsgFmt: String; const Args: array of const;
+  MsgPos: integer);
+begin
+  if MsgPos<1 then
+    MsgPos:=FTokenEnd-PChar(Expression)+1;
+  MsgType:=aMsgType;
+  MsgNumber:=aMsgNumber;
+  MsgPattern:=aMsgFmt;
+  if Assigned(OnLog) then
+    begin
+    OnLog(Self,Args);
+    if not (aMsgType in [mtError,mtFatal]) then exit;
+    end;
+  raise EScannerError.CreateFmt(MsgPattern+' at '+IntToStr(MsgPos),Args);
+end;
+
+procedure TCondDirectiveEvaluator.LogXExpectedButTokenFound(const X: String;
+  ErrorPos: integer);
+begin
+  Log(mtError,nErrXExpectedButYFound,SErrXExpectedButYFound,
+      [X,TokenInfos[FToken]],ErrorPos);
+end;
+
+procedure TCondDirectiveEvaluator.ReadOperand(Skip: boolean);
+{ Read operand and put it on the stack
+  Examples:
+   Variable
+   not Variable
+   not not undefined Variable
+   defined(Variable)
+   !Variable
+   unicodestring
+   123
+   $45
+   'Abc'
+   (expression)
+}
+var
+  i: Int64;
+  e: extended;
+  S, aName, Param: String;
+  Code: integer;
+  NameStartP: PChar;
+  p, Lvl: integer;
+begin
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.ReadOperand START Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken,BoolToStr(Skip,' SKIP',''));
+  {$ENDIF}
+  case FToken of
+    tknot:
+      begin
+      // boolean not
+      NextToken;
+      ReadOperand(Skip);
+      if not Skip then
+        FStack[FStackTop].Operand:=CondDirectiveBool[IsFalse(FStack[FStackTop].Operand)];
+      end;
+    tkMinus:
+      begin
+      // unary minus
+      NextToken;
+      ReadOperand(Skip);
+      if not Skip then
+        begin
+        i:=StrToInt64Def(FStack[FStackTop].Operand,0);
+        FStack[FStackTop].Operand:=IntToStr(-i);
+        end;
+      end;
+    tkPlus:
+      begin
+      // unary plus
+      NextToken;
+      ReadOperand(Skip);
+      if not Skip then
+        begin
+        i:=StrToInt64Def(FStack[FStackTop].Operand,0);
+        FStack[FStackTop].Operand:=IntToStr(i);
+        end;
+      end;
+    tkNumber:
+      begin
+      // number: convert to decimal
+      if not Skip then
+        begin
+        S:=GetTokenString;
+        val(S,i,Code);
+        if Code=0 then
+          begin
+          // integer
+          Push(IntToStr(i),FTokenStart-PChar(Expression)+1);
+          end
+        else
+          begin
+          val(S,e,Code);
+          if Code>0 then
+            Log(mtError,nErrRangeCheck,sErrRangeCheck,[]);
+          if e=0 then ;
+          // float
+          Push(S,FTokenStart-PChar(Expression)+1);
+          end;
+        end;
+      NextToken;
+      end;
+    tkString:
+      begin
+      // string literal
+      if not Skip then
+        Push(GetStringLiteralValue,FTokenStart-PChar(Expression)+1);
+      NextToken;
+      end;
+    tkIdentifier:
+      if Skip then
+        begin
+        NextToken;
+        if FToken=tkBraceOpen then
+          begin
+          // only one parameter is supported
+          NextToken;
+          if FToken=tkIdentifier then
+            NextToken;
+          if FToken<>tkBraceClose then
+            LogXExpectedButTokenFound(')');
+          NextToken;
+          end;
+        end
+      else
+        begin
+        aName:=GetTokenString;
+        p:=FTokenStart-PChar(Expression)+1;
+        NextToken;
+        if FToken=tkBraceOpen then
+          begin
+          // function
+          NameStartP:=FTokenStart;
+          NextToken;
+          // only one parameter is supported
+          Param:='';
+          if FToken=tkIdentifier then
+            begin
+            Param:=GetTokenString;
+            NextToken;
+            end;
+          if FToken<>tkBraceClose then
+            LogXExpectedButTokenFound(')');
+          if not OnEvalFunction(Self,aName,Param,S) then
+            begin
+            FTokenStart:=NameStartP;
+            FTokenEnd:=FTokenStart+length(aName);
+            LogXExpectedButTokenFound('function');
+            end;
+          Push(S,p);
+          NextToken;
+          end
+        else
+          begin
+          // variable
+          if OnEvalVariable(Self,aName,S) then
+            Push(S,p)
+          else
+            begin
+            // variable does not exist -> evaluates to false
+            Push(CondDirectiveBool[false],p);
+            end;
+          end;
+        end;
+    tkBraceOpen:
+      begin
+      NextToken;
+      if Skip then
+        begin
+        Lvl:=1;
+        repeat
+          case FToken of
+          tkEOF:
+            LogXExpectedButTokenFound(')');
+          tkBraceOpen: inc(Lvl);
+          tkBraceClose:
+            begin
+            dec(Lvl);
+            if Lvl=0 then break;
+            end;
+          end;
+          NextToken;
+        until false;
+        end
+      else
+        begin
+        ReadExpression;
+        if FToken<>tkBraceClose then
+          LogXExpectedButTokenFound(')');
+        end;
+      NextToken;
+      end;
+  else
+    LogXExpectedButTokenFound('identifier');
+  end;
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.ReadOperand END Top=',FStackTop,' Value="',FStack[FStackTop].Operand,'" Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken);
+  {$ENDIF}
+end;
+
+procedure TCondDirectiveEvaluator.ReadExpression;
+// read operand operator operand ... til tkEOF or tkBraceClose
+var
+  OldStackTop: Integer;
+
+  procedure ReadBinary(Level: TPrecedenceLevel; NewOperator: TToken);
+  begin
+    ResolveStack(OldStackTop,Level,NewOperator);
+    NextToken;
+    ReadOperand;
+  end;
+
+begin
+  OldStackTop:=FStackTop;
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.ReadExpression START Top=',FStackTop,' Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken);
+  {$ENDIF}
+  ReadOperand;
+  repeat
+    {$IFDEF VerbosePasDirectiveEval}
+    writeln('TCondDirectiveEvaluator.ReadExpression NEXT Top=',FStackTop,' Token[',FTokenStart-PChar(Expression)+1,']="',GetTokenString,'" ',FToken);
+    {$ENDIF}
+    case FToken of
+    tkEOF,tkBraceClose:
+      begin
+      ResolveStack(OldStackTop,high(TPrecedenceLevel),tkEOF);
+      exit;
+      end;
+    tkand:
+      begin
+      ResolveStack(OldStackTop,ceplSecond,tkand);
+      NextToken;
+      if (FStackTop=OldStackTop+1) and IsFalse(FStack[FStackTop].Operand) then
+        begin
+        // false and ...
+        // -> skip all "and"
+        repeat
+          ReadOperand(true);
+          if FToken<>tkand then break;
+          NextToken;
+        until false;
+        FStack[FStackTop].Operathor:=tkEOF;
+        end
+      else
+        ReadOperand;
+      end;
+    tkMul,tkDivision,tkdiv,tkmod,tkshl,tkshr:
+      ReadBinary(ceplSecond,FToken);
+    tkor:
+      begin
+      ResolveStack(OldStackTop,ceplThird,tkor);
+      NextToken;
+      if (FStackTop=OldStackTop+1) and IsTrue(FStack[FStackTop].Operand) then
+        begin
+        // true or ...
+        // -> skip all "and" and "or"
+        repeat
+          ReadOperand(true);
+          if not (FToken in [tkand,tkor]) then break;
+          NextToken;
+        until false;
+        FStack[FStackTop].Operathor:=tkEOF;
+        end
+      else
+        ReadOperand;
+      end;
+    tkPlus,tkMinus,tkxor:
+      ReadBinary(ceplThird,FToken);
+    tkEqual,tkNotEqual,tkLessThan,tkGreaterThan,tkLessEqualThan,tkGreaterEqualThan:
+      ReadBinary(ceplFourth,FToken);
+    else
+      LogXExpectedButTokenFound('operator');
+    end;
+  until false;
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.ReadExpression END Top=',FStackTop,' Value="',FStack[FStackTop].Operand,'" Token[',FTokenStart-PChar(Expression)+1,']=',GetTokenString,' ',FToken);
+  {$ENDIF}
+end;
+
+procedure TCondDirectiveEvaluator.ResolveStack(MinStackLvl: integer;
+  Level: TPrecedenceLevel; NewOperator: TToken);
+var
+  A, B, R: String;
+  Op: TToken;
+  AInt, BInt: int64;
+  AFloat, BFloat: extended;
+  BPos: Integer;
+begin
+  // resolve all higher or equal level operations
+  // Note: the stack top contains operand B
+  //       the stack second contains operand A and the operator between A and B
+
+  //writeln('TCondDirectiveEvaluator.ResolveStack FStackTop=',FStackTop,' MinStackLvl=',MinStackLvl);
+  //if FStackTop>MinStackLvl+1 then
+  //  writeln('  FStack[FStackTop-1].Level=',FStack[FStackTop-1].Level,' Level=',Level);
+  while (FStackTop>MinStackLvl+1) and (FStack[FStackTop-1].Level<=Level) do
+    begin
+    // pop last operand and operator from stack
+    B:=FStack[FStackTop].Operand;
+    BPos:=FStack[FStackTop].OperandPos;
+    dec(FStackTop);
+    Op:=FStack[FStackTop].Operathor;
+    A:=FStack[FStackTop].Operand;
+    {$IFDEF VerbosePasDirectiveEval}
+    writeln('  ResolveStack Top=',FStackTop,' A="',A,'" ',Op,' B="',B,'"');
+    {$ENDIF}
+    {$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
+    {$R+}
+    try
+      case Op of
+      tkand: // boolean and
+        R:=CondDirectiveBool[IsTrue(A) and IsTrue(B)];
+      tkor: // boolean or
+        R:=CondDirectiveBool[IsTrue(A) or IsTrue(B)];
+      tkxor: // boolean xor
+        R:=CondDirectiveBool[IsTrue(A) xor IsTrue(B)];
+      tkMul, tkdiv, tkmod, tkshl, tkshr, tkPlus, tkMinus:
+        if IsInteger(A,AInt) then
+          begin
+          if IsInteger(B,BInt) then
+            case Op of
+              tkMul: R:=IntToStr(AInt*BInt);
+              tkdiv: R:=IntToStr(AInt div BInt);
+              tkmod: R:=IntToStr(AInt mod BInt);
+              tkshl: R:=IntToStr(AInt shl BInt);
+              tkshr: R:=IntToStr(AInt shr BInt);
+              tkPlus: R:=IntToStr(AInt+BInt);
+              tkMinus: R:=IntToStr(AInt-BInt);
+            end
+          else if IsExtended(B,BFloat) then
+            case Op of
+              tkMul: R:=FloatToStr(Extended(AInt)*BFloat);
+              tkPlus: R:=FloatToStr(Extended(AInt)+BFloat);
+              tkMinus: R:=FloatToStr(Extended(AInt)-BFloat);
+            else
+              LogXExpectedButTokenFound('integer',BPos);
+            end
+          else
+            LogXExpectedButTokenFound('integer',BPos);
+          end
+        else if IsExtended(A,AFloat) then
+          begin
+          if IsExtended(B,BFloat) then
+            case Op of
+              tkMul: R:=FloatToStr(AFloat*BFloat);
+              tkPlus: R:=FloatToStr(AFloat+BFloat);
+              tkMinus: R:=FloatToStr(AFloat-BFloat);
+            else
+              LogXExpectedButTokenFound('float',BPos);
+            end
+          else
+            LogXExpectedButTokenFound('float',BPos);
+          end
+        else
+          Log(mtError,nErrOperandAndOperatorMismatch,sErrOperandAndOperatorMismatch,[]);
+      tkDivision:
+        if IsExtended(A,AFloat) then
+          begin
+          if IsExtended(B,BFloat) then
+            R:=FloatToStr(AFloat/BFloat)
+          else
+            LogXExpectedButTokenFound('float',BPos);
+          end
+        else
+          Log(mtError,nErrOperandAndOperatorMismatch,sErrOperandAndOperatorMismatch,[]);
+      tkEqual,
+      tkNotEqual,
+      tkLessThan,tkGreaterThan,
+      tkLessEqualThan,tkGreaterEqualThan:
+        begin
+        if IsInteger(A,AInt) and IsInteger(B,BInt) then
+          case Op of
+          tkEqual: R:=CondDirectiveBool[AInt=BInt];
+          tkNotEqual: R:=CondDirectiveBool[AInt<>BInt];
+          tkLessThan: R:=CondDirectiveBool[AInt<BInt];
+          tkGreaterThan: R:=CondDirectiveBool[AInt>BInt];
+          tkLessEqualThan: R:=CondDirectiveBool[AInt<=BInt];
+          tkGreaterEqualThan: R:=CondDirectiveBool[AInt>=BInt];
+          end
+        else if IsExtended(A,AFloat) and IsExtended(B,BFloat) then
+          case Op of
+          tkEqual: R:=CondDirectiveBool[AFloat=BFloat];
+          tkNotEqual: R:=CondDirectiveBool[AFloat<>BFloat];
+          tkLessThan: R:=CondDirectiveBool[AFloat<BFloat];
+          tkGreaterThan: R:=CondDirectiveBool[AFloat>BFloat];
+          tkLessEqualThan: R:=CondDirectiveBool[AFloat<=BFloat];
+          tkGreaterEqualThan: R:=CondDirectiveBool[AFloat>=BFloat];
+          end
+        else
+          case Op of
+          tkEqual: R:=CondDirectiveBool[A=B];
+          tkNotEqual: R:=CondDirectiveBool[A<>B];
+          tkLessThan: R:=CondDirectiveBool[A<B];
+          tkGreaterThan: R:=CondDirectiveBool[A>B];
+          tkLessEqualThan: R:=CondDirectiveBool[A<=B];
+          tkGreaterEqualThan: R:=CondDirectiveBool[A>=B];
+          end;
+        end;
+      else
+        Log(mtError,nErrOperandAndOperatorMismatch,sErrOperandAndOperatorMismatch,[]);
+      end;
+    except
+      on E: EDivByZero do
+        Log(mtError,nErrDivByZero,sErrDivByZero,[]);
+      on E: EZeroDivide do
+        Log(mtError,nErrDivByZero,sErrDivByZero,[]);
+      on E: EMathError do
+        Log(mtError,nErrRangeCheck,sErrRangeCheck+' '+E.Message,[]);
+      on E: EInterror do
+        Log(mtError,nErrRangeCheck,sErrRangeCheck+' '+E.Message,[]);
+    end;
+    {$IFNDEF RangeChecking}{$R-}{$UNDEF RangeChecking}{$ENDIF}
+    {$IFDEF VerbosePasDirectiveEval}
+    writeln('  ResolveStack Top=',FStackTop,' A="',A,'" ',Op,' B="',B,'" = "',R,'"');
+    {$ENDIF}
+    FStack[FStackTop].Operand:=R;
+    FStack[FStackTop].OperandPos:=BPos;
+    end;
+  FStack[FStackTop].Operathor:=NewOperator;
+  FStack[FStackTop].Level:=Level;
+end;
+
+function TCondDirectiveEvaluator.GetTokenString: String;
+begin
+  Result:=copy(Expression,FTokenStart-PChar(Expression)+1,FTokenEnd-FTokenStart);
+end;
+
+function TCondDirectiveEvaluator.GetStringLiteralValue: String;
+var
+  p, StartP: PChar;
+begin
+  Result:='';
+  p:=FTokenStart;
+  repeat
+    case p^ of
+    '''':
+      begin
+      inc(p);
+      StartP:=p;
+      repeat
+        case p^ of
+        #0: Log(mtError,nErrInvalidCharacter,SErrInvalidCharacter,['#0']);
+        '''': break;
+        end;
+      until false;
+      if p>StartP then
+        Result:=Result+copy(Expression,StartP-PChar(Expression)+1,p-StartP);
+      inc(p);
+      end;
+    else
+      Log(mtError,nErrInvalidCharacter,SErrInvalidCharacter,['#0']);
+    end;
+  until false;
+end;
+
+procedure TCondDirectiveEvaluator.Push(const AnOperand: String;
+  OperandPosition: integer);
+begin
+  inc(FStackTop);
+  if FStackTop>=length(FStack) then
+    SetLength(FStack,length(FStack)*2+4);
+  with FStack[FStackTop] do
+    begin
+    Operand:=AnOperand;
+    OperandPos:=OperandPosition;
+    Operathor:=tkEOF;
+    Level:=ceplFourth;
+    end;
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.Push Top=',FStackTop,' Operand="',AnOperand,'" Pos=',OperandPosition);
+  {$ENDIF}
+end;
+
+constructor TCondDirectiveEvaluator.Create;
+begin
+
+end;
+
+destructor TCondDirectiveEvaluator.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TCondDirectiveEvaluator.Eval(const Expr: string): boolean;
+begin
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TCondDirectiveEvaluator.Eval Expr="',Expr,'"');
+  {$ENDIF}
+  Expression:=Expr;
+  MsgType:=mtInfo;
+  MsgNumber:=0;
+  MsgPattern:='';
+  if Expr='' then exit(false);
+  FTokenStart:=PChar(Expr);
+  FTokenEnd:=FTokenStart;
+  FStackTop:=-1;
+  NextToken;
+  ReadExpression;
+  Result:=IsTrue(FStack[0].Operand);
+end;
+
 { TMacroDef }
 
 constructor TMacroDef.Create(const AName, AValue: String);
@@ -674,7 +1851,7 @@ begin
     While (I=-1) and (J<IncludePaths.Count-1) do
       begin
       FN:=IncludeTrailingPathDelimiter(IncludePaths[i])+AName;
-      I:=FStreams.INdexOf(FN);
+      I:=FStreams.IndexOf(FN);
       Inc(J);
       end;
     end;
@@ -693,6 +1870,7 @@ begin
   S:=FindStream(AName,ScanIncludes);
   If (S<>Nil) then
     begin
+    S.Position:=0;
     SL:=TStreamLineReader.Create(AName);
     try
       SL.InitFromStream(S);
@@ -755,7 +1933,8 @@ Procedure TStreamLineReader.InitFromStream(AStream : TStream);
 
 begin
   SetLength(FContent,AStream.Size);
-  AStream.Read(FContent[1],AStream.Size);
+  if FContent<>'' then
+    AStream.Read(FContent[1],length(FContent));
   FPos:=0;
 end;
 
@@ -772,7 +1951,7 @@ Var
 
 begin
   If isEOF then
-    exit;
+    exit('');
   LPos:=FPos+1;
   Repeat
     Inc(FPos);
@@ -929,7 +2108,7 @@ end;
 function TFileResolver.FindSourceFile(const AName: string): TLineReader;
 begin
   if not FileExists(AName) then
-    Raise EFileNotFoundError.create(Aname)
+    Raise EFileNotFoundError.create(AName)
   else
     try
       Result := CreateFileReader(AName)
@@ -945,7 +2124,7 @@ Var
 
 begin
   Result:=Nil;
-  FN:=FindIncludeFileName(ANAme);
+  FN:=FindIncludeFileName(AName);
   If (FN<>'') then
     try
       Result := TFileLineReader.Create(FN);
@@ -974,10 +2153,18 @@ begin
   FIncludeStack := TFPList.Create;
   FDefines := CS;
   FMacros:=CS;
+  FAllowedModes:=AllLanguageModes;
+  FCurrentModeSwitches:=FPCModeSwitches;
+  FAllowedModeSwitches:=msAllFPCModeSwitches;
+  FConditionEval:=TCondDirectiveEvaluator.Create;
+  FConditionEval.OnLog:=@OnCondEvalLog;
+  FConditionEval.OnEvalVariable:=@OnCondEvalVar;
+  FConditionEval.OnEvalFunction:=@OnCondEvalFunction;
 end;
 
 destructor TPascalScanner.Destroy;
 begin
+  FreeAndNil(FConditionEval);
   ClearMacros;
   FreeAndNil(FMacros);
   FreeAndNil(FDefines);
@@ -1020,7 +2207,7 @@ begin
   Clearfiles;
   FCurSourceFile := FileResolver.FindSourceFile(AFilename);
   if LogEvent(sleFile) then
-    DoLog(SLogOpeningFile,[AFileName],True);
+    DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[AFileName],True);
   FCurFilename := AFilename;
   FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(AFilename));
 end;
@@ -1029,6 +2216,7 @@ function TPascalScanner.FetchToken: TToken;
 var
   IncludeStackItem: TIncludeStackItem;
 begin
+  FPreviousToken:=FCurToken;
   while true do
   begin
     Result := DoFetchToken;
@@ -1061,6 +2249,16 @@ begin
     tkComment:
       if not (FSkipComments or PPIsSkipping) then
         Break;
+    tkSelf:
+      begin
+      if Not (po_selftoken in Options) then
+        begin
+        FCurToken:=tkIdentifier;
+        Result:=FCurToken;
+        end;
+      if not (FSkipComments or PPIsSkipping) then
+        Break;
+      end;
     else
       if not PPIsSkipping then
         break;
@@ -1069,14 +2267,95 @@ begin
 //  Writeln(Result, '(',CurTokenString,')');
 end;
 
-procedure TPascalScanner.Error(const Msg: string);
+function TPascalScanner.ReadNonPascalTillEndToken(StopAtLineEnd: boolean
+  ): TToken;
+var
+  StartPos: PChar;
+
+  Procedure Add;
+  var
+    AddLen: PtrInt;
+    OldLen: Integer;
+  begin
+    AddLen:=TokenStr-StartPos;
+    if AddLen=0 then exit;
+    OldLen:=length(FCurTokenString);
+    SetLength(FCurTokenString,OldLen+AddLen);
+    Move(StartPos^,PChar(PChar(FCurTokenString)+OldLen)^,AddLen);
+    StartPos:=TokenStr;
+  end;
+
 begin
-  raise EScannerError.Create(Msg);
+  FCurTokenString := '';
+  if (TokenStr = nil) or (TokenStr^ = #0) then
+    if not FetchLine then
+    begin
+      Result := tkEOF;
+      FCurToken := Result;
+      exit;
+    end;
+
+  StartPos:=TokenStr;
+  repeat
+    case TokenStr[0] of
+      #0: // end of line
+        begin
+          Add;
+          if StopAtLineEnd then
+            begin
+            Result := tkLineEnding;
+            FCurToken := Result;
+            exit;
+            end;
+          if not FetchLine then
+            begin
+            Result := tkEOF;
+            FCurToken := Result;
+            exit;
+            end;
+          StartPos:=TokenStr;
+        end;
+      '0'..'9', 'A'..'Z', 'a'..'z','_':
+        begin
+          // number or identifier
+          if (TokenStr[0] in ['e','E'])
+              and (TokenStr[1] in ['n','N'])
+              and (TokenStr[2] in ['d','D'])
+              and not (TokenStr[3] in ['0'..'9', 'A'..'Z', 'a'..'z','_']) then
+            begin
+            // 'end' found
+            Add;
+            Result := tkend;
+            SetLength(FCurTokenString, 3);
+            Move(TokenStr^, FCurTokenString[1], 3);
+            inc(TokenStr,3);
+            FCurToken := Result;
+            exit;
+            end
+          else
+            begin
+            // skip identifier
+            while TokenStr[0] in ['0'..'9', 'A'..'Z', 'a'..'z','_'] do
+              inc(TokenStr);
+            end;
+        end;
+      else
+        inc(TokenStr);
+    end;
+  until false;
 end;
 
-procedure TPascalScanner.Error(const Msg: string; Args: array of Const);
+procedure TPascalScanner.Error(MsgNumber: integer; const Msg: string);
 begin
-  raise EScannerError.CreateFmt(Msg, Args);
+  SetCurMsg(mtError,MsgNumber,Msg,[]);
+  raise EScannerError.Create(FLastMsg);
+end;
+
+procedure TPascalScanner.Error(MsgNumber: integer; const Fmt: string;
+  Args: array of const);
+begin
+  SetCurMsg(mtError,MsgNumber,Fmt,Args);
+  raise EScannerError.Create(FLastMsg);
 end;
 
 function TPascalScanner.DoFetchTextToken:TToken;
@@ -1089,9 +2368,16 @@ begin
   OldLength:=0;
   FCurTokenString := '';
 
-  while TokenStr[0] in ['#', ''''] do
-  begin
+  repeat
     case TokenStr[0] of
+      '^' :
+        begin
+        TokenStart := TokenStr;
+        Inc(TokenStr);
+        if TokenStr[0] in ['a'..'z','A'..'Z'] then
+          Inc(TokenStr);
+        if Result=tkEOF then Result := tkChar else Result:=tkString;
+        end;
       '#':
         begin
           TokenStart := TokenStr;
@@ -1122,12 +2408,15 @@ begin
                 break;
 
             if TokenStr[0] = #0 then
-              Error(SErrOpenString);
+              Error(nErrOpenString,SErrOpenString);
 
             Inc(TokenStr);
           end;
           Inc(TokenStr);
-          Result := tkString;
+          if ((TokenStr - TokenStart)=3) then // 'z'
+            Result := tkChar
+          else
+            Result := tkString;
         end;
     else
       Break;
@@ -1137,11 +2426,10 @@ begin
     if SectionLength > 0 then
       Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
     Inc(OldLength, SectionLength);
-  end;
-
+  until false;
 end;
 
-Procedure TPascalScanner.PushStackItem;
+procedure TPascalScanner.PushStackItem;
 
 Var
   SI: TIncludeStackItem;
@@ -1160,7 +2448,7 @@ begin
   FCurRow := 0;
 end;
 
-Procedure TPascalScanner.HandleIncludeFile(Param : String);
+procedure TPascalScanner.HandleIncludeFile(Param: String);
 
 begin
   PushStackItem;
@@ -1171,12 +2459,12 @@ begin
     end;
   FCurSourceFile := FileResolver.FindIncludeFile(Param);
   if not Assigned(FCurSourceFile) then
-    Error(SErrIncludeFileNotFound, [Param]);
+    Error(nErrIncludeFileNotFound, SErrIncludeFileNotFound, [Param]);
   FCurFilename := Param;
   if FCurSourceFile is TFileLineReader then
     FCurFilename := TFileLineReader(FCurSourceFile).Filename; // nicer error messages
   If LogEvent(sleFile) then
-    DoLog(SLogOpeningFile,[FCurFileName],True);
+    DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FCurFileName],True);
 end;
 
 function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
@@ -1196,77 +2484,399 @@ begin
 //  Writeln(Result,Curtoken);
 end;
 
-Procedure TPascalScanner.HandleDefine(Param : String);
+procedure TPascalScanner.HandleDefine(Param: String);
 
 Var
   Index : Integer;
-  MN,MV : String;
+  MName,MValue : String;
 
 begin
   Param := UpperCase(Param);
   Index:=Pos(':=',Param);
   If (Index=0) then
-    AddDefine(Param)
+    AddDefine(GetMacroName(Param))
   else
     begin
-    MV:=Trim(Param);
-    MN:=Trim(Copy(MV,1,Index-1));
-    Delete(MV,1,Index+1);
-    Index:=FMacros.IndexOf(MN);
-    If (Index=-1) then
-      FMacros.AddObject(MN,TMacroDef.Create(MN,MV))
-    else
-      TMacroDef(FMacros.Objects[index]).Value:=MV;
+    MValue:=Trim(Param);
+    MName:=Trim(Copy(MValue,1,Index-1));
+    Delete(MValue,1,Index+1);
+    AddMacro(MName,MValue);
     end;
 end;
 
-Procedure TPascalScanner.HandleUnDefine(Param : String);
+procedure TPascalScanner.HandleError(Param: String);
+begin
+  if po_CheckCondFunction in Options then
+    Error(nUserDefined, SUserDefined,[Param])
+  else
+    DoLog(mtWarning,nUserDefined,SUserDefined+' error',[Param]);
+end;
+
+procedure TPascalScanner.HandleUnDefine(Param: String);
+begin
+  UnDefine(GetMacroName(Param));
+end;
+
+function TPascalScanner.HandleInclude(const Param: String): TToken;
+
+begin
+  Result:=tkComment;
+  if ((Param='') or (Param[1]<>'%')) then
+    HandleIncludeFile(Param)
+  else if Param[1]='%' then
+    begin
+    FCurTokenString:='{$i '+Param+'}';
+    FCurToken:=tkString;
+    Result:=FCurToken;
+    end
+end;
+
+procedure TPascalScanner.HandleMacroDirective(const Param: String);
+begin
+  if CompareText(Param,'on')=0 then
+    MacrosOn:=true
+  else if CompareText(Param,'off')=0 then
+    MacrosOn:=false
+  else
+    Error(nErrXExpectedButYFound,SErrXExpectedButYFound,['on',Param]);
+end;
+
+procedure TPascalScanner.HandleMode(const Param: String);
+
+  procedure SetMode(const LangMode: TModeSwitch; const NewModeSwitches: TModeSwitches;
+    IsDelphi: boolean);
+  begin
+    if not (LangMode in AllowedModeSwitches) then
+      Error(nErrInvalidMode,SErrInvalidMode,[Param]);
+    CurrentModeSwitches:=(NewModeSwitches+ReadOnlyModeSwitches)*AllowedModeSwitches;
+    if IsDelphi then
+      FOptions:=FOptions+[po_delphi]
+    else
+      FOptions:=FOptions-[po_delphi];
+  end;
 
 Var
-  Index : integer;
+  P : String;
 
 begin
-  Param := UpperCase(Param);
-  Index:=FDefines.IndexOf(Param);
-  If (Index>=0) then
-    RemoveDefine(Param)
+  P:=UpperCase(Param);
+  Case P of
+  'FPC','DEFAULT':
+    SetMode(msFpc,FPCModeSwitches,false);
+  'OBJFPC':
+    SetMode(msObjfpc,OBJFPCModeSwitches,true);
+  'DELPHI':
+    SetMode(msDelphi,DelphiModeSwitches,true);
+  'DELPHIUNICODE':
+    SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true);
+  'TP':
+    SetMode(msTP7,TPModeSwitches,false);
+  'MACPAS':
+    SetMode(msMac,MacModeSwitches,false);
+  'ISO':
+    SetMode(msIso,ISOModeSwitches,false);
+  'EXTENDED':
+    SetMode(msExtpas,ExtPasModeSwitches,false);
+  'GPC':
+    SetMode(msGPC,GPCModeSwitches,false);
   else
+    Error(nErrInvalidMode,SErrInvalidMode,[Param])
+  end;
+end;
+
+procedure TPascalScanner.HandleModeSwitch(const Param: String);
+
+Var
+  MS : TModeSwitch;
+  MSN,PM : String;
+  P : Integer;
+
+begin
+  MSN:=Uppercase(Param);
+  P:=Pos(' ',MSN);
+  if P<>0 then
     begin
-    Index := FMacros.IndexOf(Param);
-    If (Index>=0) then
+    PM:=Trim(Copy(MSN,P+1,Length(MSN)-P));
+    MSN:=Copy(MSN,1,P-1);
+    end;
+  MS:=StrToModeSwitch(MSN);
+  if (MS=msNone) or not (MS in AllowedModeSwitches) then
+    begin
+    if po_CheckModeSwitches in Options then
+      Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param])
+    else
+      exit; // ignore
+    end;
+  if (PM='-') or (PM='OFF') then
+    begin
+    if MS in ReadOnlyModeSwitches then
+      Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param]);
+    CurrentModeSwitches:=CurrentModeSwitches-[MS]
+    end
+  else
+    CurrentModeSwitches:=CurrentModeSwitches+[MS];
+end;
+
+procedure TPascalScanner.PushSkipMode;
+
+begin
+  if PPSkipStackIndex = High(PPSkipModeStack) then
+    Error(nErrIfXXXNestingLimitReached,SErrIfXXXNestingLimitReached);
+  PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
+  PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
+  Inc(PPSkipStackIndex);
+end;
+
+procedure TPascalScanner.HandleIFDEF(const AParam: String);
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    if IsDefined(AParam) then
+      PPSkipMode := ppSkipElseBranch
+    else
       begin
-      FMacros.Objects[Index].FRee;
-      FMacros.Delete(Index);
+      PPSkipMode := ppSkipIfBranch;
+      PPIsSkipping := true;
       end;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[AParam]);
     end;
 end;
 
-function TPascalScanner.DoFetchToken: TToken;
+procedure TPascalScanner.HandleIFNDEF(const AParam: String);
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    if IsDefined(AParam) then
+      begin
+      PPSkipMode := ppSkipIfBranch;
+      PPIsSkipping := true;
+      end
+    else
+      PPSkipMode := ppSkipElseBranch;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[AParam]);
+    end;
+end;
 
-  function FetchLine: Boolean;
-  begin
-    if CurSourceFile.IsEOF then
+procedure TPascalScanner.HandleIFOPT(const AParam: String);
+
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
     begin
-      FCurLine := '';
-      TokenStr := nil;
-      Result := false;
-    end else
+    if (length(AParam)<>2) or not (AParam[1] in ['a'..'z','A'..'Z'])
+        or not (AParam[2] in ['+','-']) then
+      Error(nErrXExpectedButYFound,sErrXExpectedButYFound,['letter[+|-]',AParam]);
+    if IfOpt(AParam[1])=(AParam[2]='+') then
+      PPSkipMode := ppSkipElseBranch
+    else
+      begin
+      PPSkipMode := ppSkipIfBranch;
+      PPIsSkipping := true;
+      end;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogIFOptAccepted,sLogIFOptAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogIFOptRejected,sLogIFOptRejected,[AParam]);
+    end;
+end;
+
+procedure TPascalScanner.HandleIF(const AParam: String);
+
+begin
+  PushSkipMode;
+  if PPIsSkipping then
+    PPSkipMode := ppSkipAll
+  else
+    begin
+    if ConditionEval.Eval(AParam) then
+      PPSkipMode := ppSkipElseBranch
+    else
+      begin
+      PPSkipMode := ppSkipIfBranch;
+      PPIsSkipping := true;
+      end;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogIFAccepted,sLogIFAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogIFRejected,sLogIFRejected,[AParam]);
+    end;
+end;
+
+procedure TPascalScanner.HandleELSEIF(const AParam: String);
+begin
+  if PPSkipStackIndex = 0 then
+    Error(nErrInvalidPPElse,sErrInvalidPPElse);
+  if PPSkipMode = ppSkipIfBranch then
+    begin
+    if ConditionEval.Eval(AParam) then
+      begin
+      PPSkipMode := ppSkipElseBranch;
+      PPIsSkipping := false;
+      end
+    else
+      PPIsSkipping := true;
+    If LogEvent(sleConditionals) then
+      if PPSkipMode=ppSkipElseBranch then
+        DoLog(mtInfo,nLogELSEIFAccepted,sLogELSEIFAccepted,[AParam])
+      else
+        DoLog(mtInfo,nLogELSEIFRejected,sLogELSEIFRejected,[AParam]);
+    end
+  else if PPSkipMode=ppSkipElseBranch then
     begin
-      FCurLine := CurSourceFile.ReadLine;
-      TokenStr := PChar(CurLine);
-      Result := true;
-      Inc(FCurRow);
-      if LogEvent(sleLineNumber) and ((FCurRow Mod 100) = 0) then
-        DoLog(SLogLineNumber,[FCurRow],True);
+    PPIsSkipping := true;
     end;
+end;
+
+procedure TPascalScanner.HandleELSE(const AParam: String);
+
+begin
+  if AParam='' then;
+  if PPSkipStackIndex = 0 then
+    Error(nErrInvalidPPElse,sErrInvalidPPElse);
+  if PPSkipMode = ppSkipIfBranch then
+    PPIsSkipping := false
+  else if PPSkipMode = ppSkipElseBranch then
+    PPIsSkipping := true;
+end;
+
+
+procedure TPascalScanner.HandleENDIF(const AParam: String);
+
+begin
+  if AParam='' then;
+  if PPSkipStackIndex = 0 then
+    Error(nErrInvalidPPEndif,sErrInvalidPPEndif);
+  Dec(PPSkipStackIndex);
+  PPSkipMode := PPSkipModeStack[PPSkipStackIndex];
+  PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
+end;
+
+function TPascalScanner.HandleDirective(const ADirectiveText: String): TToken;
+
+Var
+  Directive,Param : String;
+  P : Integer;
+  Handled: Boolean;
+
+begin
+  Result:=tkComment;
+  P:=Pos(' ',ADirectiveText);
+  If P=0 then
+    P:=Length(ADirectiveText)+1;
+  Directive:=Copy(ADirectiveText,2,P-2); // 1 is $
+  Param:=ADirectiveText;
+  Delete(Param,1,P);
+  {$IFDEF VerbosePasDirectiveEval}
+  Writeln('Directive: "',Directive,'", Param : "',Param,'"');
+  {$ENDIF}
+
+  Case UpperCase(Directive) of
+  'IFDEF':
+     HandleIFDEF(Param);
+  'IFNDEF':
+     HandleIFNDEF(Param);
+  'IFOPT':
+     HandleIFOPT(Param);
+  'IF':
+     HandleIF(Param);
+  'ELSEIF':
+     HandleELSEIF(Param);
+  'ELSE':
+     HandleELSE(Param);
+  'ENDIF':
+    HandleENDIF(Param);
+  'IFEND':
+    HandleENDIF(Param);
+  else
+    if PPIsSkipping then exit;
+
+    Handled:=false;
+    if (length(Directive)=2)
+        and (Directive[1] in ['a'..'z','A'..'Z'])
+        and (Directive[2] in ['-','+']) then
+      begin
+      Handled:=true;
+      Result:=HandleLetterDirective(Directive[1],Directive[2]='+');
+      end;
+
+    if not Handled then
+      begin
+      Handled:=true;
+      Case UpperCase(Directive) of
+        'I','INCLUDE':
+          Result:=HandleInclude(Param);
+        'MACRO':
+          HandleMacroDirective(Param);
+        'MODE':
+          HandleMode(Param);
+        'MODESWITCH':
+          HandleModeSwitch(Param);
+        'DEFINE':
+          HandleDefine(Param);
+        'ERROR':
+          HandleError(Param);
+        'WARNING':
+          DoLog(mtWarning,nUserDefined,SUserDefined,[Directive]);
+        'NOTE':
+          DoLog(mtNote,nUserDefined,SUserDefined,[Directive]);
+        'HINT':
+          DoLog(mtHint,nUserDefined,SUserDefined,[Directive]);
+        'UNDEF':
+          HandleUnDefine(Param);
+      else
+        Handled:=false;
+      end;
+      end;
+
+    if Assigned(OnDirective) then
+      OnDirective(Self,Directive,Param,Handled);
+    if (not Handled) then
+      if LogEvent(sleDirective) then
+        DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,
+          [Directive]);
   end;
+end;
+
+function TPascalScanner.HandleLetterDirective(Letter: char; Enable: boolean): TToken;
+begin
+  Result:=tkComment;
+  Letter:=upcase(Letter);
+  if LetterSwitchNames[Letter]='' then
+    DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,
+      [Letter]);
+  if Enable then
+    AddDefine(LetterSwitchNames[Letter])
+  else
+    UnDefine(LetterSwitchNames[Letter]);
+end;
 
+function TPascalScanner.DoFetchToken: TToken;
 var
-  TokenStart, CurPos: PChar;
+  TokenStart: PChar;
   i: TToken;
   OldLength, SectionLength, NestingLevel, Index: Integer;
-  Directive, Param : string;
+
+
 begin
+  result:=tkLineEnding;
   if TokenStr = nil then
     if not FetchLine then
     begin
@@ -1274,9 +2884,7 @@ begin
       FCurToken := Result;
       exit;
     end;
-
   FCurTokenString := '';
-
   case TokenStr[0] of
     #0:         // Empty line
       begin
@@ -1318,10 +2926,18 @@ begin
           Inc(TokenStr);
         until not (TokenStr[0] in ['0'..'7']);
         SectionLength := TokenStr - TokenStart;
-        SetLength(FCurTokenString, SectionLength);
-        if SectionLength > 0 then
-          Move(TokenStart^, FCurTokenString[1], SectionLength);
-        Result := tkNumber;
+        if (SectionLength=1) then // &Keyword
+          begin
+          DoFetchToken();
+          Result:=tkIdentifier;
+          end
+        else
+          begin
+          SetLength(FCurTokenString, SectionLength);
+          if SectionLength > 0 then
+            Move(TokenStart^, FCurTokenString[1], SectionLength);
+          Result := tkNumber;
+          end;
       end;
     '$':
       begin
@@ -1350,27 +2966,55 @@ begin
     '(':
       begin
         Inc(TokenStr);
-        if TokenStr[0] = '*' then
-        begin
+        if TokenStr[0] <> '*' then
+          Result := tkBraceOpen
+        else
+          begin
           // Old-style multi-line comment
           Inc(TokenStr);
-          while (TokenStr[0] <> '*') or (TokenStr[1] <> ')') do
-          begin
-            if TokenStr[0] = #0 then
+          TokenStart := TokenStr;
+          FCurTokenString := '';
+          OldLength := 0;
+          NestingLevel:=0;
+          while (TokenStr[0] <> '*') or (TokenStr[1] <> ')') or (NestingLevel>0) do
             begin
-              if not FetchLine then
+            if TokenStr[0] = #0 then
               begin
+              SectionLength:=TokenStr - TokenStart +1;
+              SetLength(FCurTokenString, OldLength + SectionLength);
+              if SectionLength > 1 then
+                Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength - 1);
+              Inc(OldLength, SectionLength);
+              FCurTokenString[OldLength] := #10;
+              if not FetchLine then
+                begin
                 Result := tkEOF;
                 FCurToken := Result;
                 exit;
-              end;
-            end else
+                end;
+              TokenStart:=TokenStr;
+              end
+            else
+              begin
+              If (msNestedComment in CurrentModeSwitches) then
+                 begin
+                 if (TokenStr[0] = '(') and (TokenStr[1] = '*') then
+                   Inc(NestingLevel)
+                 else if (TokenStr[0] = '*') and (TokenStr[1] = ')') and not PPIsSkipping then
+                   Dec(NestingLevel);
+                 end;
               Inc(TokenStr);
+              end;
           end;
+          SectionLength := TokenStr - TokenStart;
+          SetLength(FCurTokenString, OldLength + SectionLength);
+          if SectionLength > 0 then
+            Move(TokenStart^, FCurTokenString[OldLength + 1], SectionLength);
           Inc(TokenStr, 2);
           Result := tkComment;
-        end else
-          Result := tkBraceOpen;
+          if Copy(CurTokenString,1,1)='$' then
+            Result := HandleDirective(CurTokenString);
+          end;
       end;
     ')':
       begin
@@ -1386,7 +3030,7 @@ begin
           Inc(TokenStr);
           Result := tkPower;
           end 
-        else if (po_cassignments in options) then
+        else if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -1399,7 +3043,7 @@ begin
       begin
         Result:=tkPlus;
         Inc(TokenStr);
-        if (po_cassignments in options) then
+        if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -1417,7 +3061,7 @@ begin
       begin
         Result := tkMinus;
         Inc(TokenStr);
-        if (po_cassignments in options) then
+        if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -1451,9 +3095,18 @@ begin
           SetLength(FCurTokenString, SectionLength);
           if SectionLength > 0 then
             Move(TokenStart^, FCurTokenString[1], SectionLength);
+          // Handle macro which is //
+          if FCurSourceFile is TMacroReader then
+            begin
+            // exhaust till eof of macro stream
+            Repeat
+              I:=Fetchtoken;
+            until (i<>tkLineEnding);
+            FetchLine;
+            end;
           Result := tkComment;
           end
-        else if (po_cassignments in options) then
+        else if (po_CAssignments in options) then
           begin
           if TokenStr[0]='=' then
             begin
@@ -1464,35 +3117,25 @@ begin
       end;
     '0'..'9':
       begin
+        // 1, 12, 1.2, 1.2E3, 1.E2, 1E2, 1.2E-3, 1E+2
+        // beware of 1..2
         TokenStart := TokenStr;
-        while true do
-        begin
+        repeat
           Inc(TokenStr);
-          case TokenStr[0] of
-            '.':
-              begin
-                if TokenStr[1] in ['0'..'9', 'e', 'E'] then
-                begin
-                  Inc(TokenStr);
-                  repeat
-                    Inc(TokenStr);
-                  until not (TokenStr[0] in ['0'..'9', 'e', 'E']);
-                end;
-                break;
-              end;
-            '0'..'9': ;
-            'e', 'E':
-              begin
-                Inc(TokenStr);
-                if TokenStr[0] = '-'  then
-                  Inc(TokenStr);
-                while TokenStr[0] in ['0'..'9'] do
-                  Inc(TokenStr);
-                break;
-              end;
-            else
-              break;
+        until not (TokenStr[0] in ['0'..'9']);
+        if (TokenStr[0]='.') and (TokenStr[1]<>'.') then
+          begin
+          inc(TokenStr);
+          while TokenStr[0] in ['0'..'9'] do
+            Inc(TokenStr);
           end;
+        if TokenStr[0] in ['e', 'E'] then
+        begin
+          Inc(TokenStr);
+          if TokenStr[0] in ['-','+'] then
+            inc(TokenStr);
+          while TokenStr[0] in ['0'..'9'] do
+            Inc(TokenStr);
         end;
         SectionLength := TokenStr - TokenStart;
         SetLength(FCurTokenString, SectionLength);
@@ -1519,14 +3162,21 @@ begin
       begin
         Inc(TokenStr);
         if TokenStr[0] = '>' then
-        begin
+          begin
           Inc(TokenStr);
           Result := tkNotEqual;
-        end else if TokenStr[0] = '=' then
-        begin
+          end
+        else if TokenStr[0] = '=' then
+          begin
           Inc(TokenStr);
           Result := tkLessEqualThan;
-        end else
+          end
+        else if TokenStr[0] = '<' then
+          begin
+          Inc(TokenStr);
+          Result := tkshl;
+          end
+        else
           Result := tkLessThan;
       end;
     '=':
@@ -1538,14 +3188,20 @@ begin
       begin
         Inc(TokenStr);
         if TokenStr[0] = '=' then
-        begin
+          begin
           Inc(TokenStr);
           Result := tkGreaterEqualThan;
             end else if TokenStr[0] = '<' then
             begin
           Inc(TokenStr);
           Result := tkSymmetricalDifference;
-        end else
+          end
+        else if TokenStr[0] = '>' then
+          begin
+          Inc(TokenStr);
+          Result := tkshr;
+          end
+        else
           Result := tkGreaterThan;
       end;
     '@':
@@ -1565,8 +3221,16 @@ begin
       end;
     '^':
       begin
+      if ForceCaret or PPisSkipping or
+         (PreviousToken in [tkeof,tkTab,tkLineEnding,tkComment,tkIdentifier,
+                   tkNil,tkOperator,tkBraceClose,tkSquaredBraceClose,tkCaret,
+                   tkWhitespace]) then
+        begin
         Inc(TokenStr);
         Result := tkCaret;
+        end
+      else
+        Result:=DoFetchTextToken;
       end;
     '\':
       begin
@@ -1600,9 +3264,9 @@ begin
             TokenStart := TokenStr;
           end else
           begin
-            if not(po_delphi in Options) and (TokenStr[0] = '{') then
+            if (msNestedComment in CurrentModeSwitches) and (TokenStr[0] = '{') then
               Inc(NestingLevel)
-            else if TokenStr[0] = '}' then
+            else if (TokenStr[0] = '}') and not PPIsSkipping then
               Dec(NestingLevel);
             Inc(TokenStr);
           end;
@@ -1614,164 +3278,8 @@ begin
         Inc(TokenStr);
         Result := tkComment;
         //WriteLn('Kommentar: "', CurTokenString, '"');
-        if (Length(CurTokenString) > 0) and (CurTokenString[1] = '$') then
-        begin
-          TokenStart := @CurTokenString[2];
-          CurPos := TokenStart;
-          while (CurPos[0] <> ' ') and (CurPos[0] <> #0) do
-            Inc(CurPos);
-          SectionLength := CurPos - TokenStart;
-          SetLength(Directive, SectionLength);
-          if SectionLength > 0 then
-          begin
-            Move(TokenStart^, Directive[1], SectionLength);
-            Directive := UpperCase(Directive);
-            if CurPos[0] <> #0 then
-            begin
-              TokenStart := CurPos + 1;
-              CurPos := TokenStart;
-              while CurPos[0] <> #0 do
-                Inc(CurPos);
-              SectionLength := CurPos - TokenStart;
-              SetLength(Param, SectionLength);
-              if SectionLength > 0 then
-                Move(TokenStart^, Param[1], SectionLength);
-            end else
-              Param := '';
-            if Not PPIsSkipping then
-              begin
-              if (Directive = 'I') or (Directive = 'INCLUDE') then
-                begin
-                if ((Param='') or (Param[1]<>'%')) then
-                  HandleIncludeFile(param)
-                else if Param[1]='%' then
-                  begin
-                  fcurtokenstring:='{$i '+param+'}';
-                  fcurtoken:=tkstring;
-                  result:=fcurtoken;
-                  exit;
-                  end
-                end
-              else if (Directive = 'DEFINE') then
-                HandleDefine(Param)
-              else if (Directive = 'UNDEF') then
-                HandleUnDefine(Param)
-              end;
-            if (Directive = 'IFDEF') then
-              begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                Param := UpperCase(Param);
-                Index := Defines.IndexOf(Param);
-                if Index < 0 then
-                  Index := Macros.IndexOf(Param);
-                if Index < 0 then
-                begin
-                  PPSkipMode := ppSkipIfBranch;
-                  PPIsSkipping := true;
-                end else
-                  PPSkipMode := ppSkipElseBranch;
-                If LogEvent(sleConditionals) then
-                  if PPSkipMode=ppSkipElseBranch then
-                    DoLog(SLogIFDefAccepted,[Param])
-                  else
-                    DoLog(SLogIFDefRejected,[Param])
-              end;
-            end else if Directive = 'IFNDEF' then
-            begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                Param := UpperCase(Param);
-                Index := Defines.IndexOf(Param);
-                if Index >= 0 then
-                begin
-                  PPSkipMode := ppSkipIfBranch;
-                  PPIsSkipping := true;
-                end else
-                  PPSkipMode := ppSkipElseBranch;
-                If LogEvent(sleConditionals) then
-                  if PPSkipMode=ppSkipElseBranch then
-                    DoLog(SLogIFNDefAccepted,[Param])
-                  else
-                    DoLog(SLogIFNDefRejected,[Param])
-              end;
-            end else if Directive = 'IFOPT' then
-            begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                { !!!: Currently, options are not supported, so they are just
-                  assumed as not being set. }
-                PPSkipMode := ppSkipIfBranch;
-                PPIsSkipping := true;
-              end;
-              If LogEvent(sleConditionals) then
-                DoLog(SLogIFOPTIgnored,[Uppercase(Param)])
-            end else if Directive = 'IF' then
-            begin
-              if PPSkipStackIndex = High(PPSkipModeStack) then
-                Error(SErrIfXXXNestingLimitReached);
-              PPSkipModeStack[PPSkipStackIndex] := PPSkipMode;
-              PPIsSkippingStack[PPSkipStackIndex] := PPIsSkipping;
-              Inc(PPSkipStackIndex);
-              if PPIsSkipping then
-              begin
-                PPSkipMode := ppSkipAll;
-                PPIsSkipping := true;
-              end else
-              begin
-                { !!!: Currently, expressions are not supported, so they are
-                  just assumed as evaluating to false. }
-                PPSkipMode := ppSkipIfBranch;
-                PPIsSkipping := true;
-              If LogEvent(sleConditionals) then
-                 DoLog(SLogIFIgnored,[Uppercase(Param)])
-              end;
-            end else if Directive = 'ELSE' then
-            begin
-              if PPSkipStackIndex = 0 then
-                Error(SErrInvalidPPElse);
-              if PPSkipMode = ppSkipIfBranch then
-                PPIsSkipping := false
-              else if PPSkipMode = ppSkipElseBranch then
-                PPIsSkipping := true;
-            end else if ((Directive = 'ENDIF') or (Directive='IFEND')) then
-            begin
-              if PPSkipStackIndex = 0 then
-                Error(SErrInvalidPPEndif);
-              Dec(PPSkipStackIndex);
-              PPSkipMode := PPSkipModeStack[PPSkipStackIndex];
-              PPIsSkipping := PPIsSkippingStack[PPSkipStackIndex];
-            end;
-          end else
-            Directive := '';
-        end;
+        if (Copy(CurTokenString,1,1)='$') then
+          Result:=HandleDirective(CurTokenString);
       end;
     'A'..'Z', 'a'..'z', '_':
       begin
@@ -1790,17 +3298,19 @@ begin
             FCurToken := Result;
             exit;
           end;
-        Index:=FMacros.IndexOf(CurtokenString);
-        if (Index=-1) then
-          Result := tkIdentifier
-        else
-          Result:=HandleMacro(index);
+        Result := tkIdentifier;
+        if MacrosOn then
+          begin
+          Index:=FMacros.IndexOf(CurtokenString);
+          if Index>=0 then
+            Result:=HandleMacro(Index);
+          end;
       end;
   else
     if PPIsSkipping then
       Inc(TokenStr)
     else
-      Error(SErrInvalidCharacter, [TokenStr[0]]);
+      Error(nErrInvalidCharacter, SErrInvalidCharacter, [TokenStr[0]]);
   end;
 
   FCurToken := Result;
@@ -1816,45 +3326,319 @@ begin
   If (TokenStr<>Nil) then
     Result := TokenStr - PChar(CurLine)
   else
-    Result:=0;
+    Result := 0;
 end;
 
-procedure TPascalScanner.DoLog(const Msg: String;SkipSourceInfo : Boolean = False);
+function TPascalScanner.OnCondEvalFunction(Sender: TCondDirectiveEvaluator;
+  Name, Param: String; out Value: string): boolean;
 begin
-  If Assigned(FOnLog) then
-    if SkipSourceInfo then
-      FOnLog(Self,Msg)
-    else
-      FOnLog(Self,Format('%s(%d) : %s',[FCurFileName,FCurRow,Msg]));
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TPascalScanner.OnCondEvalFunction Func="',Name,'" Param="',Param,'"');
+  {$ENDIF}
+  if CompareText(Name,'defined')=0 then
+    begin
+    if not IsValidIdent(Param) then
+      Sender.Log(mtError,nErrXExpectedButYFound,SErrXExpectedButYFound,
+        ['identifier',Param]);
+    Value:=CondDirectiveBool[IsDefined(Param)];
+    exit(true);
+    end
+  else if CompareText(Name,'undefined')=0 then
+    begin
+    if not IsValidIdent(Param) then
+      Sender.Log(mtError,nErrXExpectedButYFound,SErrXExpectedButYFound,
+        ['identifier',Param]);
+    Value:=CondDirectiveBool[not IsDefined(Param)];
+    exit(true);
+    end
+  else if CompareText(Name,'option')=0 then
+    begin
+    if (length(Param)<>1) or not (Param[1] in ['a'..'z','A'..'Z']) then
+      Sender.Log(mtError,nErrXExpectedButYFound,SErrXExpectedButYFound,
+        ['letter',Param]);
+    Value:=CondDirectiveBool[IfOpt(Param[1])];
+    exit(true);
+    end;
+  // last check user hook
+  if Assigned(OnEvalFunction) then
+    begin
+    Result:=OnEvalFunction(Sender,Name,Param,Value);
+    if not (po_CheckCondFunction in Options) then
+      begin
+      Value:='0';
+      Result:=true;
+      end;
+    exit;
+    end;
+  if (po_CheckCondFunction in Options) then
+    begin
+    Value:='';
+    Result:=false;
+    end
+  else
+    begin
+    Value:='0';
+    Result:=true;
+    end;
+end;
+
+procedure TPascalScanner.OnCondEvalLog(Sender: TCondDirectiveEvaluator;
+  Args: array of const);
+begin
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TPascalScanner.OnCondEvalLog "',Sender.MsgPattern,'"');
+  {$ENDIF}
+  // ToDo: move CurLine/CurRow to Sender.MsgPos
+  if Sender.MsgType<=mtError then
+    begin
+    SetCurMsg(Sender.MsgType,Sender.MsgNumber,Sender.MsgPattern,Args);
+    raise EScannerError.Create(FLastMsg);
+    end
+  else
+    DoLog(Sender.MsgType,Sender.MsgNumber,Sender.MsgPattern,Args,true);
+end;
+
+function TPascalScanner.OnCondEvalVar(Sender: TCondDirectiveEvaluator;
+  Name: String; out Value: string): boolean;
+var
+  i: Integer;
+  M: TMacroDef;
+begin
+  {$IFDEF VerbosePasDirectiveEval}
+  writeln('TPascalScanner.OnCondEvalVar "',Name,'"');
+  {$ENDIF}
+  // first check defines
+  if FDefines.IndexOf(Name)>=0 then
+    begin
+    Value:='1';
+    exit(true);
+    end;
+  // then check macros
+  i:=FMacros.IndexOf(Name);
+  if i>=0 then
+    begin
+    M:=FMacros.Objects[i] as TMacroDef;
+    Value:=M.Value;
+    exit(true);
+    end;
+  // last check user hook
+  if Assigned(OnEvalVariable) then
+    begin
+    Result:=OnEvalVariable(Sender,Name,Value);
+    exit;
+    end;
+  Value:='';
+  Result:=false;
+end;
+
+procedure TPascalScanner.SetAllowedModeSwitches(const AValue: TModeSwitches);
+begin
+  if FAllowedModeSwitches=AValue then Exit;
+  FAllowedModeSwitches:=AValue;
+  CurrentModeSwitches:=FCurrentModeSwitches*AllowedModeSwitches;
+end;
+
+procedure TPascalScanner.SetCurrentModeSwitches(AValue: TModeSwitches);
+var
+  Old, AddedMS, RemovedMS: TModeSwitches;
+begin
+  AValue:=AValue*AllowedModeSwitches;
+  if FCurrentModeSwitches=AValue then Exit;
+  Old:=FCurrentModeSwitches;
+  FCurrentModeSwitches:=AValue;
+  AddedMS:=FCurrentModeSwitches-Old;
+  RemovedMS:=Old-FCurrentModeSwitches;
+  if msDefaultUnicodestring in AddedMS then
+    begin
+    AddDefine('UNICODE');
+    AddDefine('FPC_UNICODESTRINGS');
+    end
+  else if msDefaultUnicodestring in RemovedMS then
+    begin
+    UnDefine('UNICODE');
+    UnDefine('FPC_UNICODESTRINGS');
+    end;
 end;
 
-procedure TPascalScanner.DoLog(const Fmt: String; Args: array of const;SkipSourceInfo : Boolean = False);
+procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Msg: String; SkipSourceInfo: Boolean);
 begin
-  DoLog(Format(Fmt,Args),SkipSourceInfo);
+  DoLog(MsgType,MsgNumber,Msg,[],SkipSourceInfo);
+end;
+
+procedure TPascalScanner.DoLog(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const; SkipSourceInfo: Boolean);
+begin
+  SetCurMsg(MsgType,MsgNumber,Fmt,Args);
+  If Assigned(FOnLog) then
+    if SkipSourceInfo then
+      FOnLog(Self,FLastMsg)
+    else
+      FOnLog(Self,Format('%s(%d) : %s',[FCurFileName,FCurRow,FLastMsg]));
 end;
 
 procedure TPascalScanner.SetOptions(AValue: TPOptions);
+
+Var
+  isModeSwitch : Boolean;
+
 begin
   if FOptions=AValue then Exit;
+  // Change of mode ?
+  IsModeSwitch:=(po_delphi in Avalue) <> (po_delphi in FOptions);
   FOptions:=AValue;
+  if isModeSwitch then
+    if (po_delphi in FOptions) then
+      CurrentModeSwitches:=DelphiModeSwitches
+    else
+      CurrentModeSwitches:=FPCModeSwitches
 end;
 
-Procedure TPascalScanner.AddDefine(S : String);
+procedure TPascalScanner.SetReadOnlyModeSwitches(const AValue: TModeSwitches);
+begin
+  if FReadOnlyModeSwitches=AValue then Exit;
+  FReadOnlyModeSwitches:=AValue;
+  FAllowedModeSwitches:=FAllowedModeSwitches+FReadOnlyModeSwitches;
+  FCurrentModeSwitches:=FCurrentModeSwitches+FReadOnlyModeSwitches;
+end;
 
+function TPascalScanner.FetchLine: boolean;
 begin
-  If FDefines.IndexOf(S)=-1 then
-    FDefines.Add(S);
+  if CurSourceFile.IsEOF then
+  begin
+    if TokenStr<>nil then
+      begin
+      FCurLine := '';
+      TokenStr := nil;
+      inc(FCurRow); // set CurRow to last line+1
+      end;
+    Result := false;
+  end else
+  begin
+    FCurLine := CurSourceFile.ReadLine;
+    TokenStr := PChar(CurLine);
+    Result := true;
+    Inc(FCurRow);
+    if LogEvent(sleLineNumber) and ((FCurRow Mod 100) = 0) then
+      DoLog(mtInfo,nLogLineNumber,SLogLineNumber,[FCurRow],True);
+  end;
+end;
+
+function TPascalScanner.GetMacroName(const Param: String): String;
+var
+  p: Integer;
+begin
+  Result:=Param;
+  p:=1;
+  while (p<=length(Param)) and (Param[p] in ['a'..'z','A'..'Z','0'..'9','_']) do
+    inc(p);
+  SetLength(Result,p-1);
+end;
+
+procedure TPascalScanner.SetCurMsg(MsgType: TMessageType; MsgNumber: integer;
+  const Fmt: String; Args: array of const);
+begin
+  FLastMsgType := MsgType;
+  FLastMsgNumber := MsgNumber;
+  FLastMsgPattern := Fmt;
+  FLastMsg := SafeFormat(Fmt,Args);
+  CreateMsgArgs(FLastMsgArgs,Args);
+end;
+
+function TPascalScanner.AddDefine(const aName: String; Quiet: boolean): boolean;
+
+begin
+  If FDefines.IndexOf(aName)>=0 then exit(false);
+  Result:=true;
+  FDefines.Add(aName);
+  if (not Quiet) and LogEvent(sleConditionals) then
+    DoLog(mtInfo,nLogMacroDefined,sLogMacroDefined,[aName])
 end;
 
-Procedure TPascalScanner.RemoveDefine(S : String);
+function TPascalScanner.RemoveDefine(const aName: String; Quiet: boolean
+  ): boolean;
 
 Var
   I : Integer;
 
 begin
-  I:=FDefines.IndexOf(S);
-  if (I<>-1) then
-    FDefines.Delete(I);
+  I:=FDefines.IndexOf(aName);
+  if (I<0) then exit(false);
+  Result:=true;
+  FDefines.Delete(I);
+  if (not Quiet) and LogEvent(sleConditionals) then
+    DoLog(mtInfo,nLogMacroUnDefined,sLogMacroUnDefined,[aName])
+end;
+
+function TPascalScanner.UnDefine(const aName: String; Quiet: boolean): boolean;
+begin
+  // Important: always call both, do not use OR
+  Result:=RemoveDefine(aName,Quiet);
+  if RemoveMacro(aName,Quiet) then Result:=true;
 end;
 
+function TPascalScanner.IsDefined(const aName: String): boolean;
+begin
+  Result:=(FDefines.IndexOf(aName)>=0) or (FMacros.IndexOf(aName)>=0);
+end;
+
+function TPascalScanner.IfOpt(Letter: Char): boolean;
+begin
+  Letter:=upcase(Letter);
+  Result:=(Letter in ['A'..'Z']) and (LetterSwitchNames[Letter]<>'')
+    and IsDefined(LetterSwitchNames[Letter]);
+end;
+
+function TPascalScanner.AddMacro(const aName, aValue: String; Quiet: boolean
+  ): boolean;
+var
+  Index: Integer;
+begin
+  Index:=FMacros.IndexOf(aName);
+  If (Index=-1) then
+    FMacros.AddObject(aName,TMacroDef.Create(aName,aValue))
+  else
+    begin
+    if TMacroDef(FMacros.Objects[Index]).Value=aValue then exit(false);
+    TMacroDef(FMacros.Objects[Index]).Value:=aValue;
+    end;
+  Result:=true;
+  if (not Quiet) and LogEvent(sleConditionals) then
+    DoLog(mtInfo,nLogMacroDefined,sLogMacroDefined,[aName])
+end;
+
+function TPascalScanner.RemoveMacro(const aName: String; Quiet: boolean
+  ): boolean;
+var
+  Index: Integer;
+begin
+  Index:=FMacros.IndexOf(aName);
+  if Index<0 then exit(false);
+  Result:=true;
+  TMacroDef(FMacros.Objects[Index]).Free;
+  FMacros.Delete(Index);
+  if (not Quiet) and LogEvent(sleConditionals) then
+    DoLog(mtInfo,nLogMacroUnDefined,sLogMacroUnDefined,[aName])
+end;
+
+procedure TPascalScanner.SetCompilerMode(S: String);
+begin
+  HandleMode(S);
+end;
+
+function TPascalScanner.CurSourcePos: TPasSourcePos;
+begin
+  Result.FileName:=CurFilename;
+  Result.Row:=CurRow;
+  Result.Column:=CurColumn;
+end;
+
+function TPascalScanner.SetForceCaret(AValue: Boolean): Boolean;
+
+begin
+  Result:=FForceCaret;
+  FForceCaret:=AValue;
+end;
+
+
 end.
diff --git a/packages/fcl-passrc/src/readme.txt b/packages/fcl-passrc/src/readme.txt
index 6545a896b2..4ed3120ead 100644
--- a/packages/fcl-passrc/src/readme.txt
+++ b/packages/fcl-passrc/src/readme.txt
@@ -28,3 +28,18 @@ pparser.pp
 ----------
 Parser for Pascal source files. Reads files via the pscanner unit and stores
 all parsed data in a parse tree, as implemented in the pastree unit.
+
+pasresolver.pp
+--------------
+A symbol resolver: A TPasTreeContainer descendent that looks up symbols 
+(identifiers) in the parse tree, following the scope rules of Pascal
+
+passrcutil.pp
+-------------
+A small class to roughly analyse a pascal source unit. It gives some methods to get
+a list of interface/implementation units, whether a source file has resource
+strings, a complete list of identifiers etc.
+
+pastounittest.pp
+----------------
+A unit to create a FPC unit test source file from a pascal unit file.
diff --git a/packages/fcl-passrc/tests/tcbaseparser.pas b/packages/fcl-passrc/tests/tcbaseparser.pas
index 650f73e16b..2834f038c9 100644
--- a/packages/fcl-passrc/tests/tcbaseparser.pas
+++ b/packages/fcl-passrc/tests/tcbaseparser.pas
@@ -7,6 +7,8 @@ interface
 uses
   Classes, SysUtils, fpcunit, pastree, pscanner, pparser, testregistry;
 
+const
+  DefaultMainFilename = 'afile.pp';
 Type
   { TTestEngine }
 
@@ -25,11 +27,12 @@ Type
 
   { TTestParser }
 
-  TTestParser= class(TTestCase)
+  TTestParser = class(TTestCase)
   Private
     FDeclarations: TPasDeclarations;
     FDefinition: TPasElement;
-    FEngine : TTestEngine;
+    FEngine : TPasTreeContainer;
+    FMainFilename: string;
     FModule: TPasModule;
     FParseResult: TPasElement;
     FScanner : TPascalScanner;
@@ -48,6 +51,7 @@ Type
   protected
     procedure SetUp; override;
     procedure TearDown; override;
+    procedure CreateEngine(var TheEngine: TPasTreeContainer); virtual;
     Procedure StartUnit(AUnitName : String);
     Procedure StartProgram(AFileName : String; AIn : String = ''; AOut : String = '');
     Procedure StartLibrary(AFileName : String);
@@ -55,6 +59,7 @@ Type
     Procedure StartImplementation;
     Procedure EndSource;
     Procedure Add(Const ALine : String);
+    Procedure Add(Const Lines : array of String);
     Procedure StartParsing;
     Procedure ParseDeclarations;
     Procedure ParseModule;
@@ -75,13 +80,15 @@ Type
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TPasMemberVisibility); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifier); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureModifiers); overload;
+    Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcTypeModifiers); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TAssignKind); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TProcedureMessageType); overload;
     Procedure AssertEquals(Const Msg : String; AExpected, AActual: TOperatorType); overload;
+    Procedure AssertSame(Const Msg : String; AExpected, AActual: TPasElement); overload;
     Procedure HaveHint(AHint : TPasMemberHint; AHints : TPasMemberHints);
     Property Resolver : TStreamResolver Read FResolver;
     Property Scanner : TPascalScanner Read FScanner;
-    Property Engine : TTestEngine read FEngine;
+    Property Engine : TPasTreeContainer read FEngine;
     Property Parser : TTestPasParser read FParser ;
     Property Source : TStrings Read FSource;
     Property Module : TPasModule Read FModule;
@@ -92,11 +99,299 @@ Type
     // If set, Will be freed in teardown
     Property ParseResult : TPasElement Read FParseResult Write FParseResult;
     Property UseImplementation : Boolean Read FUseImplementation Write FUseImplementation;
+    Property MainFilename: string read FMainFilename write FMainFilename;
   end;
 
+function ExtractFileUnitName(aFilename: string): string;
+function GetPasElementDesc(El: TPasElement): string;
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+
 implementation
 
 uses typinfo;
+
+function ExtractFileUnitName(aFilename: string): string;
+var
+  p: Integer;
+begin
+  Result:=ExtractFileName(aFilename);
+  if Result='' then exit;
+  for p:=length(Result) downto 1 do
+    case Result[p] of
+    '/','\': exit;
+    '.':
+      begin
+      Delete(Result,p,length(Result));
+      exit;
+      end;
+    end;
+end;
+
+function GetPasElementDesc(El: TPasElement): string;
+begin
+  if El=nil then exit('nil');
+  Result:=El.Name+':'+El.ClassName+'['+El.SourceFilename+','+IntToStr(El.SourceLinenumber)+']';
+end;
+
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  c1:char;
+  CommentLvl: Integer;
+  Src: PChar;
+begin
+  Src:=Position;
+  // read till next atom
+  while true do
+    begin
+    case Src^ of
+    #0: break;
+    #1..#32:  // spaces and special characters
+      inc(Src);
+    #$EF:
+      if (Src[1]=#$BB)
+      and (Src[2]=#$BF) then
+        begin
+        // skip UTF BOM
+        inc(Src,3);
+        end
+      else
+        break;
+    '{':    // comment start or compiler directive
+      if (Src[1]='$') and (not SkipDirectives) then
+        // compiler directive
+        break
+      else begin
+        // Pascal comment => skip
+        CommentLvl:=1;
+        while true do
+          begin
+          inc(Src);
+          case Src^ of
+          #0: break;
+          '{':
+            if NestedComments then
+              inc(CommentLvl);
+          '}':
+            begin
+            dec(CommentLvl);
+            if CommentLvl=0 then
+              begin
+              inc(Src);
+              break;
+              end;
+            end;
+          end;
+        end;
+      end;
+    '/':  // comment or real division
+      if (Src[1]='/') then
+        begin
+        // comment start -> read til line end
+        inc(Src);
+        while not (Src^ in [#0,#10,#13]) do
+          inc(Src);
+        end
+      else
+        break;
+    '(':  // comment, bracket or compiler directive
+      if (Src[1]='*') then
+        begin
+        if (Src[2]='$') and (not SkipDirectives) then
+          // compiler directive
+          break
+        else
+          begin
+          // comment start -> read til comment end
+          inc(Src,2);
+          CommentLvl:=1;
+          while true do
+            begin
+            case Src^ of
+            #0: break;
+            '(':
+              if NestedComments and (Src[1]='*') then
+                inc(CommentLvl);
+            '*':
+              if (Src[1]=')') then
+                begin
+                dec(CommentLvl);
+                if CommentLvl=0 then
+                  begin
+                  inc(Src,2);
+                  break;
+                  end;
+                inc(Position);
+                end;
+            end;
+            inc(Src);
+            end;
+        end;
+      end else
+        // round bracket open
+        break;
+    else
+      break;
+    end;
+    end;
+  // read token
+  TokenStart:=Src;
+  c1:=Src^;
+  case c1 of
+  #0:
+    ;
+  'A'..'Z','a'..'z','_':
+    begin
+    // identifier
+    inc(Src);
+    while Src^ in IdentChars do
+      inc(Src);
+    end;
+  '0'..'9': // number
+    begin
+    inc(Src);
+    // read numbers
+    while (Src^ in ['0'..'9']) do
+      inc(Src);
+    if (Src^='.') and (Src[1]<>'.') then
+      begin
+      // real type number
+      inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    if (Src^ in ['e','E']) then
+      begin
+      // read exponent
+      inc(Src);
+      if (Src^='-') then inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    end;
+  '''','#':  // string constant
+    while true do
+      case Src^ of
+      #0: break;
+      '#':
+        begin
+        inc(Src);
+        while Src^ in ['0'..'9'] do
+          inc(Src);
+        end;
+      '''':
+        begin
+        inc(Src);
+        while not (Src^ in ['''',#0]) do
+          inc(Src);
+        if Src^='''' then
+          inc(Src);
+        end;
+      else
+        break;
+      end;
+  '$':  // hex constant
+    begin
+    inc(Src);
+    while Src^ in HexNumberChars do
+      inc(Src);
+    end;
+  '&':  // octal constant or keyword as identifier (e.g. &label)
+    begin
+    inc(Src);
+    if Src^ in ['0'..'7'] then
+      while Src^ in ['0'..'7'] do
+        inc(Src)
+    else
+      while Src^ in IdentChars do
+        inc(Src);
+    end;
+  '{':  // compiler directive (it can't be a comment, because see above)
+    begin
+    CommentLvl:=1;
+    while true do
+      begin
+      inc(Src);
+      case Src^ of
+      #0: break;
+      '{':
+        if NestedComments then
+          inc(CommentLvl);
+      '}':
+        begin
+        dec(CommentLvl);
+        if CommentLvl=0 then
+          begin
+          inc(Src);
+          break;
+          end;
+        end;
+      end;
+      end;
+    end;
+  '(':  // bracket or compiler directive
+    if (Src[1]='*') then
+      begin
+      // compiler directive -> read til comment end
+      inc(Src,2);
+      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
+        inc(Src);
+      inc(Src,2);
+      end
+    else
+      // round bracket open
+      inc(Src);
+  #192..#255:
+    begin
+    // read UTF8 character
+    inc(Src);
+    if ((ord(c1) and %11100000) = %11000000) then
+      begin
+      // could be 2 byte character
+      if (ord(Src[0]) and %11000000) = %10000000 then
+        inc(Src);
+      end
+    else if ((ord(c1) and %11110000) = %11100000) then
+      begin
+      // could be 3 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000) then
+        inc(Src,2);
+      end
+    else if ((ord(c1) and %11111000) = %11110000) then
+      begin
+      // could be 4 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000)
+      and ((ord(Src[2]) and %11000000) = %10000000) then
+        inc(Src,3);
+      end;
+    end;
+  else
+    inc(Src);
+    case c1 of
+    '<': if Src^ in ['>','='] then inc(Src);
+    '.': if Src^='.' then inc(Src);
+    '@':
+      if Src^='@' then
+        begin
+        // @@ label
+        repeat
+          inc(Src);
+        until not (Src^ in IdentChars);
+        end
+    else
+      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
+        inc(Src);
+    end;
+  end;
+  Position:=Src;
+end;
+
 { TTestEngine }
 
 destructor TTestEngine.Destroy;
@@ -109,6 +404,7 @@ function TTestEngine.CreateElement(AClass: TPTreeElement; const AName: String;
   AParent: TPasElement; AVisibility: TPasMemberVisibility;
   const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
 begin
+  //writeln('TTestEngine.CreateElement ',AName,' ',AClass.ClassName);
   Result := AClass.Create(AName, AParent);
   Result.Visibility := AVisibility;
   Result.SourceFilename := ASourceFilename;
@@ -118,9 +414,12 @@ begin
 //    Writeln('Saving comment : ',CurrentParser.SavedComments);
     Result.DocComment:=CurrentParser.SavedComments;
     end;
-  If not Assigned(FList) then
-    FList:=TFPList.Create;
-  FList.Add(Result);
+  if AName<>'' then
+    begin
+    If not Assigned(FList) then
+      FList:=TFPList.Create;
+    FList.Add(Result);
+    end;
 end;
 
 function TTestEngine.FindElement(const AName: String): TPasElement;
@@ -136,7 +435,7 @@ begin
     While (Result=Nil) and (I>=0) do
       begin
       if CompareText(TPasElement(FList[I]).Name,AName)=0 then
-        Result:=TPasElement(Flist[i]);
+        Result:=TPasElement(FList[i]);
       Dec(i);
       end;
     end;
@@ -158,7 +457,7 @@ begin
   FResolver:=TStreamResolver.Create;
   FResolver.OwnsStreams:=True;
   FScanner:=TPascalScanner.Create(FResolver);
-  FEngine:=TTestEngine.Create;
+  CreateEngine(FEngine);
   FParser:=TTestPasParser.Create(FScanner,FResolver,FEngine);
   FSource:=TStringList.Create;
   FModule:=Nil;
@@ -171,6 +470,9 @@ end;
 procedure TTestParser.CleanupParser;
 
 begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser START');
+  {$ENDIF}
   if Not Assigned(FModule) then
     FreeAndNil(FDeclarations)
   else
@@ -178,13 +480,38 @@ begin
   FImplementation:=False;
   FEndSource:=False;
   FIsUnit:=False;
-  FreeAndNil(FModule);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FModule');
+  {$ENDIF}
+  if Assigned(FModule) then
+    ReleaseAndNil(TPasElement(FModule));
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FSource');
+  {$ENDIF}
   FreeAndNil(FSource);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FParseResult');
+  {$ENDIF}
   FreeAndNil(FParseResult);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FParser');
+  {$ENDIF}
   FreeAndNil(FParser);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FEngine');
+  {$ENDIF}
   FreeAndNil(FEngine);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FScanner');
+  {$ENDIF}
   FreeAndNil(FScanner);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser FResolver');
+  {$ENDIF}
   FreeAndNil(FResolver);
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.CleanupParser END');
+  {$ENDIF}
 end;
 
 procedure TTestParser.ResetParser;
@@ -196,21 +523,36 @@ end;
 
 procedure TTestParser.SetUp;
 begin
+  FMainFilename:=DefaultMainFilename;
   Inherited;
   SetupParser;
 end;
 
 procedure TTestParser.TearDown;
 begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.TearDown START CleanupParser');
+  {$ENDIF}
   CleanupParser;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.TearDown inherited');
+  {$ENDIF}
   Inherited;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestParser.TearDown END');
+  {$ENDIF}
+end;
+
+procedure TTestParser.CreateEngine(var TheEngine: TPasTreeContainer);
+begin
+  TheEngine:=TTestEngine.Create;
 end;
 
 procedure TTestParser.StartUnit(AUnitName: String);
 begin
   FIsUnit:=True;
   If (AUnitName='') then
-    AUnitName:='afile';
+    AUnitName:=ExtractFileUnitName(MainFilename);
   Add('unit '+aUnitName+';');
   Add('');
   Add('interface');
@@ -228,7 +570,7 @@ begin
     begin
     AFileName:=AFileName+'('+AIn;
     if (AOut<>'') then
-      AFileName:=AFIleName+','+AOut;
+      AFileName:=AFileName+','+AOut;
     AFileName:=AFileName+')';
     end;
   Add('program '+AFileName+';');
@@ -297,18 +639,29 @@ begin
   FSource.Add(ALine);
 end;
 
+procedure TTestParser.Add(const Lines: array of String);
+var
+  i: Integer;
+begin
+  for i:=Low(Lines) to High(Lines) do
+    Add(Lines[i]);
+end;
+
 procedure TTestParser.StartParsing;
 
+var
+  i: Integer;
 begin
   If FIsUnit then
     StartImplementation;
   EndSource;
   If (FFileName='') then
-    FFileName:='afile.pp';
-  FResolver.AddStream(FFileName,TStringStream.Create(FSource.text));
+    FFileName:=MainFilename;
+  FResolver.AddStream(FFileName,TStringStream.Create(FSource.Text));
   FScanner.OpenFile(FFileName);
   Writeln('// Test : ',Self.TestName);
-  Writeln(FSource.Text);
+  for i:=0 to FSource.Count-1 do
+    Writeln(Format('%:4d: ',[i+1]),FSource[i]);
 end;
 
 procedure TTestParser.ParseDeclarations;
@@ -345,6 +698,7 @@ end;
 function TTestParser.AssertExpression(const Msg: String; AExpr: TPasExpr;
   aKind: TPasExprKind; AClass: TClass): TPasExpr;
 begin
+  AssertNotNull(AExpr);
   AssertEquals(Msg+': Correct expression kind',aKind,AExpr.Kind);
   AssertEquals(Msg+': Correct expression class',AClass,AExpr.ClassType);
   Result:=AExpr;
@@ -406,8 +760,8 @@ end;
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TPasObjKind);
 begin
-  AssertEquals(Msg,GetEnumName(TypeInfo(TexprOpcode),Ord(AExpected)),
-                   GetEnumName(TypeInfo(TexprOpcode),Ord(AActual)));
+  AssertEquals(Msg,GetEnumName(TypeInfo(TPasObjKind),Ord(AExpected)),
+                   GetEnumName(TypeInfo(TPasObjKind),Ord(AActual)));
 end;
 
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
@@ -504,6 +858,27 @@ begin
 end;
 
 procedure TTestParser.AssertEquals(const Msg: String; AExpected,
+  AActual: TProcTypeModifiers);
+
+  Function Sn (S : TProcTypeModifiers) : String;
+
+  Var
+    m : TProcTypeModifier;
+  begin
+    Result:='';
+    For M:=Low(TProcTypeModifier) to High(TProcTypeModifier) do
+      If (m in S) then
+        begin
+        If (Result<>'') then
+           Result:=Result+',';
+        Result:=Result+GetEnumName(TypeInfo(TProcTypeModifier),Ord(m))
+        end;
+  end;
+begin
+  AssertEquals(Msg,Sn(AExpected),SN(AActual));
+end;
+
+procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TAssignKind);
 begin
   AssertEquals(Msg,GetEnumName(TypeInfo(TAssignKind),Ord(AExpected)),
@@ -521,7 +896,14 @@ procedure TTestParser.AssertEquals(const Msg: String; AExpected,
   AActual: TOperatorType);
 begin
   AssertEquals(Msg,GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)),
-                   GetEnumName(TypeInfo(TOperatorType),Ord(AExpected)));
+                   GetEnumName(TypeInfo(TOperatorType),Ord(AActual)));
+end;
+
+procedure TTestParser.AssertSame(const Msg: String; AExpected,
+  AActual: TPasElement);
+begin
+  if AExpected=AActual then exit;
+  AssertEquals(Msg,GetPasElementDesc(AExpected),GetPasElementDesc(AActual));
 end;
 
 procedure TTestParser.HaveHint(AHint: TPasMemberHint; AHints: TPasMemberHints);
diff --git a/packages/fcl-passrc/tests/tcclasstype.pas b/packages/fcl-passrc/tests/tcclasstype.pas
index d8a00f1ec5..9ae082033d 100644
--- a/packages/fcl-passrc/tests/tcclasstype.pas
+++ b/packages/fcl-passrc/tests/tcclasstype.pas
@@ -5,7 +5,7 @@ unit tcclasstype;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pparser, pastree, testregistry, tctypeparser;
+  Classes, SysUtils, fpcunit, pscanner,pparser, pastree, testregistry, tctypeparser;
 
 type
 
@@ -19,7 +19,8 @@ type
     FParent : String;
     FEnded,
     FStarted: Boolean;
-    procedure AssertSpecializedClass(C: TPasClassType);
+    procedure AssertGenericClass(C: TPasClassType);
+    procedure AssertSpecializedClass(C: TPasSpecializeType);
     function GetC(AIndex: Integer): TPasConst;
     function GetF1: TPasVariable;
     function GetM(AIndex : Integer): TPasElement;
@@ -29,14 +30,16 @@ type
     function GetP2: TPasProperty;
     function GetT(AIndex : Integer) : TPasType;
   protected
-    Procedure StartClass (AParent : String = 'TObject'; InterfaceList : String = '');
+    Procedure StartClass (AncestorName : String = 'TObject'; InterfaceList : String = '');
+    Procedure StartExternalClass (AParent : String; AExternalName,AExternalNameSpace : String );
     Procedure StartClassHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
-    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = '');
+    Procedure StartInterface (AParent : String = 'IInterface'; UUID : String = ''; Disp : Boolean = False);
     Procedure StartRecordHelper (ForType : String = 'TOriginal'; AParent : String = 'TObject');
     Procedure StartVisibility(A : TPasMemberVisibility);
     Procedure EndClass(AEnd : String = 'end');
     Procedure AddMember(S : String);
     Procedure ParseClass;
+    Procedure ParseClassFail(Msg: string; MsgNumber: integer);
     Procedure DoParseClass(FromSpecial : Boolean = False);
     procedure SetUp; override;
     procedure TearDown; override;
@@ -72,6 +75,8 @@ type
     procedure TestOneSpecializedClassInterface;
     Procedure TestOneField;
     Procedure TestOneFieldComment;
+    procedure TestOneFieldStatic;
+    Procedure TestOneHelperField;
     Procedure TestOneVarField;
     Procedure TestOneClassField;
     Procedure TestOneFieldVisibility;
@@ -79,6 +84,9 @@ type
     Procedure TestTwoFields;
     Procedure TestTwoFieldsB;
     Procedure TestTwoVarFieldsB;
+    procedure TestNoVarFields;
+    procedure TestVarClassFunction;
+    procedure TestClassVarClassFunction;
     Procedure TestTwoFieldsVisibility;
     Procedure TestConstProtectedEnd;
     Procedure TestTypeProtectedEnd;
@@ -88,8 +96,11 @@ type
     procedure TestHintFieldExperimental;
     procedure TestHintFieldLibraryError;
     procedure TestHintFieldUninmplemented;
+    Procedure TestOneVarFieldExternalName;
+    procedure TestOneVarFieldExternalNameSemicolon;
     Procedure TestMethodSimple;
     Procedure TestMethodSimpleComment;
+    Procedure TestMethodWithDotFails;
     Procedure TestClassMethodSimple;
     Procedure TestClassMethodSimpleComment;
     Procedure TestConstructor;
@@ -102,6 +113,7 @@ type
     Procedure TestMethodVirtual;
     Procedure TestMethodVirtualSemicolon;
     Procedure TestMethodVirtualAbstract;
+    procedure TestMethodVirtualAbstractFinal;
     Procedure TestMethodOverride;
     procedure TestMethodDynamic;
     procedure TestMethodReintroduce;
@@ -135,7 +147,14 @@ type
     Procedure TestPropertyImplements;
     Procedure TestPropertyImplementsFullyQualifiedName;
     Procedure TestPropertyReadFromRecordField;
+    procedure TestPropertyReadFromArrayField;
     procedure TestPropertyReadWriteFromRecordField;
+    procedure TestPropertyDeprecated;
+    procedure TestPropertyDeprecatedMessage;
+    Procedure TestExternalClass;
+    Procedure TestExternalClassNoNameSpace;
+    Procedure TestExternalClassNoNameKeyWord;
+    Procedure TestExternalClassNoName;
     Procedure TestLocalSimpleType;
     Procedure TestLocalSimpleTypes;
     Procedure TestLocalSimpleConst;
@@ -144,8 +163,14 @@ type
     procedure TestClassHelperParentedEmpty;
     procedure TestClassHelperOneMethod;
     procedure TestInterfaceEmpty;
+    procedure TestInterfaceDisp;
     procedure TestInterfaceParentedEmpty;
     procedure TestInterfaceOneMethod;
+    procedure TestInterfaceDispIDMethod;
+    procedure TestInterfaceDispIDMethod2;
+    procedure TestInterfaceProperty;
+    procedure TestInterfaceDispProperty;
+    procedure TestInterfaceDispPropertyReadOnly;
     procedure TestInterfaceNoConstructor;
     procedure TestInterfaceNoDestructor;
     procedure TestInterfaceNoFields;
@@ -223,21 +248,36 @@ begin
   Result:=TPasConst(Members[AIndex]);
 end;
 
-procedure TTestClassType.StartClass(AParent: String; InterfaceList: String);
+procedure TTestClassType.StartClass(AncestorName: String; InterfaceList: String);
 
 Var
   S : String;
 begin
   FStarted:=True;
   S:='TMyClass = Class';
-  if (AParent<>'') then
+  if (AncestorName<>'') then
     begin
-    S:=S+'('+AParent;
+    S:=S+'('+AncestorName;
     if (InterfaceList<>'') then
       S:=S+','+InterfaceList;
     S:=S+')';
     end;
   FDecl.Add(S);
+  FParent:=AncestorName;
+end;
+
+procedure TTestClassType.StartExternalClass(AParent: String; AExternalName,
+  AExternalNameSpace: String);
+
+Var
+  S : String;
+
+begin
+  FStarted:=True;
+  S:=Format('TMyClass = Class external ''%s'' name ''%s'' ',[AExternalNameSpace,AExternalName]);
+  if (AParent<>'') then
+    S:=S+'('+AParent+')';
+  FDecl.Add(S);
   FParent:=AParent;
 end;
 
@@ -257,12 +297,16 @@ begin
   FParent:=AParent;
 end;
 
-procedure TTestClassType.StartInterface(AParent: String; UUID: String);
+procedure TTestClassType.StartInterface(AParent: String; UUID: String;
+  Disp: Boolean = False);
 Var
   S : String;
 begin
   FStarted:=True;
-  S:='TMyClass = Interface';
+  if Disp then
+    S:='TMyClass = DispInterface'
+  else
+    S:='TMyClass = Interface';
   if (AParent<>'') then
     S:=S+' ('+AParent+')';
   if (UUID<>'') then
@@ -317,14 +361,33 @@ begin
   DoParseClass(False);
 end;
 
+procedure TTestClassType.ParseClassFail(Msg: string; MsgNumber: integer);
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseClass;
+  except
+    on E: EParserError do
+      begin
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',MsgNumber,Parser.LastMsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
 procedure TTestClassType.DoParseClass(FromSpecial: Boolean);
+var
+  AncestorType: TPasType;
 begin
   EndClass;
   Add('Type');
   if AddComment then
     begin
     Add('// A comment');
-    engine.NeedComments:=True;
+    Engine.NeedComments:=True;
     end;
   Add('  '+TrimRight(FDecl.Text)+';');
   ParseDeclarations;
@@ -337,7 +400,14 @@ begin
      AssertNotNull('Have parent class',TheClass.AncestorType);
      if FromSpecial then
        begin
-       AssertEquals('Parent class',TPasClassType,TheClass.AncestorType.ClassType);
+       AncestorType:=TheClass.AncestorType;
+       if AncestorType is TPasSpecializeType then
+         begin
+         AncestorType:=TPasSpecializeType(AncestorType).DestType;
+         AssertEquals('Parent class',TPasUnresolvedTypeRef,AncestorType.ClassType);
+         end
+       else
+         AssertEquals('Parent class',TPasClassType,AncestorType.ClassType);
        end
      else
        begin
@@ -351,7 +421,6 @@ begin
     AssertNull('No helperfortype if not helper',TheClass.HelperForType);
   if TheClass.Members.Count>0 then
     FMember1:=TObject(TheClass.Members[0]) as TPaselement;
-
 end;
 
 procedure TTestClassType.SetUp;
@@ -397,6 +466,7 @@ procedure TTestClassType.AssertProperty(P: TPasProperty;
   AVisibility: TPasMemberVisibility; AName, ARead, AWrite, AStored,
   AImplements: String; AArgCount: Integer; ADefault, ANodefault: Boolean);
 begin
+  AssertEquals('Property Name',AName,P.Name);
   AssertEquals(P.Name+': Visibility',AVisibility,P.Visibility);
   Assertequals(P.Name+': No args',AArgCount,P.Args.Count);
   Assertequals(P.Name+': Read accessor',ARead,P.ReadAccessorName);
@@ -465,7 +535,7 @@ begin
   AssertEquals('Interface name','ISomethingElse',TPasUnresolvedTypeRef(TheClass.Interfaces[1]).Name);
 end;
 
-procedure TTestClassType.AssertSpecializedClass(C : TPasClassType);
+procedure TTestClassType.AssertGenericClass(C : TPasClassType);
 
 begin
   AssertEquals('Parent class name is empty','',C.Name);
@@ -477,26 +547,38 @@ begin
   AssertEquals('Have generic template types','Integer',TPasElement(C.GenericTemplateTypes[0]).Name);
 end;
 
+procedure TTestClassType.AssertSpecializedClass(C: TPasSpecializeType);
+begin
+  AssertEquals('Parent class name is empty','',C.Name);
+  AssertNotNull('Have dest type',C.DestType);
+  AssertEquals('Have dest type name','TMyList',C.DestType.Name);
+  AssertNotNull('Have param types',C.Params);
+  AssertEquals('Have one param type',1,C.Params.Count);
+  AssertNotNull('First Param ',C.Params[0]);
+  AssertEquals('First Param expr',TPrimitiveExpr,TObject(C.Params[0]).ClassType);
+  AssertEquals('Has specialize param integer','Integer',TPrimitiveExpr(C.Params[0]).Value);
+end;
+
 procedure TTestClassType.TestOneSpecializedClass;
 
 Var
-  C : TPasClassType;
+  C : TPasSpecializeType;
 
 begin
   StartClass('Specialize TMyList<Integer>','');
   DoParseClass(True);
-  C:=TPasClassType(TheClass.AncestorType);
+  C:=TPasSpecializeType(TheClass.AncestorType);
   AssertSpecializedClass(C);
 end;
 
 procedure TTestClassType.TestOneSpecializedClassInterface;
 Var
-  C : TPasClassType;
+  C : TPasSpecializeType;
 
 begin
   StartClass('Specialize TMyList<Integer>','ISomething');
   DoParseClass(True);
-  C:=TPasClassType(TheClass.AncestorType);
+  C:=TPasSpecializeType(TheClass.AncestorType);
   AssertSpecializedClass(C);
   AssertEquals('Have 1 interface',1,TheClass.Interfaces.Count);
   AssertNotNull('Correct class',TheClass.Interfaces[0]);
@@ -513,6 +595,25 @@ begin
   AssertVisibility;
 end;
 
+procedure TTestClassType.TestOneFieldStatic;
+begin
+  AddMember('a : integer; static');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('a');
+  AssertVisibility;
+  AssertTrue('Have static field',vmStatic in TPasVariable(Field1).VarModifiers);
+end;
+
+procedure TTestClassType.TestOneHelperField;
+begin
+  AddMember('helper : integer');
+  ParseClass;
+  AssertNotNull('Have 1 field',Field1);
+  AssertMemberName('helper');
+  AssertVisibility;
+end;
+
 procedure TTestClassType.TestOneFieldComment;
 begin
   AddComment:=true;
@@ -612,6 +713,46 @@ begin
   AssertVisibility(visPublic,Members[1]);
 end;
 
+procedure TTestClassType.TestNoVarFields;
+
+begin
+  StartVisibility(visPublic);
+  FDecl.Add('var');
+  AddMember('Function b : integer');
+  ParseClass;
+  AssertEquals('member count',1,TheClass.members.Count);
+  AssertNotNull('Have function',Members[0]);
+  AssertMemberName('b',Members[0]);
+  AssertMemberType(TPasFunction,Members[0]);
+  AssertVisibility(visPublic,Members[0]);
+end;
+
+procedure TTestClassType.TestVarClassFunction;
+begin
+  StartVisibility(visPublic);
+  FDecl.Add('var');
+  AddMember('class Function b : integer');
+  ParseClass;
+  AssertEquals('member count',1,TheClass.members.Count);
+  AssertNotNull('Have function',Members[0]);
+  AssertMemberName('b',Members[0]);
+  AssertMemberType(TPasClassFunction,Members[0]);
+  AssertVisibility(visPublic,Members[0]);
+end;
+
+procedure TTestClassType.TestClassVarClassFunction;
+begin
+  StartVisibility(visPublic);
+  FDecl.Add('class var');
+  AddMember('class Function b : integer');
+  ParseClass;
+  AssertEquals('member count',1,TheClass.members.Count);
+  AssertNotNull('Have function',Members[0]);
+  AssertMemberName('b',Members[0]);
+  AssertMemberType(TPasClassFunction,Members[0]);
+  AssertVisibility(visPublic,Members[0]);
+end;
+
 procedure TTestClassType.TestTwoFieldsVisibility;
 begin
   StartVisibility(visPublic);
@@ -711,6 +852,28 @@ begin
   AssertMemberName('unimplemented');
 end;
 
+procedure TTestClassType.TestOneVarFieldExternalName;
+begin
+  Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msExternalClass];
+  StartExternalClass('','myname','');
+  AddMember('unimplemented: integer external name ''uni''');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertNotNull('Have field',Field1);
+  AssertMemberName('unimplemented');
+end;
+
+procedure TTestClassType.TestOneVarFieldExternalNameSemicolon;
+begin
+  Parser.CurrentModeswitches:=Parser.CurrentModeswitches+[msExternalClass];
+  StartExternalClass('','myname','');
+  AddMember('unimplemented: integer; external name ''uni''');
+  ParseClass;
+  AssertEquals('1 members',1,TheClass.members.Count);
+  AssertNotNull('Have field',Field1);
+  AssertMemberName('unimplemented');
+end;
+
 procedure TTestClassType.TestMethodSimple;
 begin
   AddMember('Procedure DoSomething');
@@ -737,6 +900,12 @@ begin
   AssertEquals('Comment','c'+sLineBreak,Method1.DocComment);
 end;
 
+procedure TTestClassType.TestMethodWithDotFails;
+begin
+  AddMember('Procedure DoSomething.Stupid');
+  ParseClassFail('Expected ";"',nParserExpectTokenError);
+end;
+
 procedure TTestClassType.TestClassMethodSimple;
 begin
   AddMember('Class Procedure DoSomething');
@@ -763,28 +932,28 @@ procedure TTestClassType.TestConstructor;
 begin
   AddMember('Constructor Create');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
-  AssertEquals('1 class procedure',TPasConstructor,members[0].ClassType);
+  AssertEquals('1 members',1,TheClass.Members.Count);
+  AssertEquals('1 class procedure',TPasConstructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Create');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasConstructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasConstructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasConstructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasConstructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestClassConstructor;
 begin
   AddMember('Class Constructor Create');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
-  AssertEquals('1 class procedure',TPasClassConstructor,members[0].ClassType);
+  AssertEquals('1 members',1,TheClass.Members.Count);
+  AssertEquals('1 class procedure',TPasClassConstructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Create');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasClassConstructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassConstructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassConstructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassConstructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestDestructor;
@@ -795,24 +964,24 @@ begin
   AssertEquals('1 class procedure',TPasDestructor,members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Destroy');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasDestructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasDestructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasDestructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasDestructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestClassDestructor;
 begin
   AddMember('Class Destructor Destroy');
   ParseClass;
-  AssertEquals('1 members',1,TheClass.members.Count);
-  AssertEquals('1 class procedure',TPasClassDestructor,members[0].ClassType);
+  AssertEquals('1 members',1,TheClass.Members.Count);
+  AssertEquals('1 class procedure',TPasClassDestructor,Members[0].ClassType);
   AssertEquals('Default visibility',visDefault,Members[0].Visibility);
   AssertMemberName('Destroy');
-  AssertEquals('No modifiers',[],TPasClassProcedure(Members[0]).Modifiers);
-  AssertEquals('Default calling convention',ccDefault, TPasClassProcedure(Members[0]).ProcType.CallingConvention);
-  AssertNotNull('Method proc type',TPasClassProcedure(Members[0]).ProcType);
-  AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
+  AssertEquals('No modifiers',[],TPasClassDestructor(Members[0]).Modifiers);
+  AssertEquals('Default calling convention',ccDefault, TPasClassDestructor(Members[0]).ProcType.CallingConvention);
+  AssertNotNull('Method proc type',TPasClassDestructor(Members[0]).ProcType);
+  AssertEquals('No arguments',0,TPasClassDestructor(Members[0]).ProcType.Args.Count)
 end;
 
 procedure TTestClassType.TestFunctionMethodSimple;
@@ -900,6 +1069,16 @@ begin
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
 end;
 
+procedure TTestClassType.TestMethodVirtualAbstractFinal;
+begin
+  AddMember('Procedure DoSomething(A : Integer) virtual; abstract; final');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('Virtual, abstract modifiers',[pmVirtual,pmAbstract,pmFinal],Method1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
 
 procedure TTestClassType.TestMethodOverride;
 begin
@@ -1011,7 +1190,7 @@ begin
   ParseClass;
   DefaultMethod;
   AssertEquals('Default visibility',visDefault,Method1.Visibility);
-  AssertEquals('No modifiers',[pmMessage],Method1.Modifiers);
+  AssertEquals('message modifier',[pmMessage],Method1.Modifiers);
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
   AssertEquals('Message name','123',Method1.MessageName);
 end;
@@ -1022,7 +1201,7 @@ begin
   ParseClass;
   DefaultMethod;
   AssertEquals('Default visibility',visDefault,Method1.Visibility);
-  AssertEquals('No modifiers',[pmMessage],Method1.Modifiers);
+  AssertEquals('message modifiers',[pmMessage],Method1.Modifiers);
   AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
   AssertEquals('Message name','''aha''',Method1.MessageName);
 end;
@@ -1085,7 +1264,7 @@ end;
 procedure TTestClassType.TestPropertyRedeclareDefault;
 begin
   StartVisibility(visPublic);
-  AddMember('Property Something; default;');
+  AddMember('Property Something; default');
   ParseClass;
   AssertProperty(Property1,visPublic,'Something','','','','',0,True,False);
   AssertNull('No type',Property1.VarType);
@@ -1377,6 +1556,40 @@ begin
 
 end;
 
+procedure TTestClassType.TestPropertyDeprecated;
+
+begin
+  StartVisibility(visPublished);
+  AddMember('Property Something : AInterface Read FSomething; deprecated');
+  ParseClass;
+  AssertProperty(Property1,visPublished,'Something','FSomething','','','',0,False,False);
+  AssertNotNull('Have type',Property1.VarType);
+  AssertEquals('Property type class type',TPasUnresolvedTypeRef,Property1.vartype.ClassType);
+  AssertEquals('Property type name','AInterface',Property1.vartype.name);
+  Assertequals('No index','',Property1.IndexValue);
+  AssertNull('No Index expression',Property1.IndexExpr);
+  AssertNull('No default expression',Property1.DefaultExpr);
+  Assertequals('Default value','',Property1.DefaultValue);
+  AssertTrue('Deprecated',[hDeprecated]=Property1.Hints);
+end;
+
+procedure TTestClassType.TestPropertyDeprecatedMessage;
+
+begin
+  StartVisibility(visPublished);
+  AddMember('Property Something : AInterface Read FSomething; deprecated ''this is no longer used'' ');
+  ParseClass;
+  AssertProperty(Property1,visPublished,'Something','FSomething','','','',0,False,False);
+  AssertNotNull('Have type',Property1.VarType);
+  AssertEquals('Property type class type',TPasUnresolvedTypeRef,Property1.vartype.ClassType);
+  AssertEquals('Property type name','AInterface',Property1.vartype.name);
+  Assertequals('No index','',Property1.IndexValue);
+  AssertNull('No Index expression',Property1.IndexExpr);
+  AssertNull('No default expression',Property1.DefaultExpr);
+  Assertequals('Default value','',Property1.DefaultValue);
+  AssertTrue('Deprecated',[hDeprecated]=Property1.Hints);
+end;
+
 procedure TTestClassType.TestPropertyImplementsFullyQualifiedName;
 begin
   StartVisibility(visPublished);
@@ -1407,6 +1620,21 @@ begin
   Assertequals('Default value','',Property1.DefaultValue);
 end;
 
+procedure TTestClassType.TestPropertyReadFromArrayField;
+begin
+  StartVisibility(visPublished);
+  AddMember('Property Something : Integer Read FPoint.W[x].y.Z');
+  ParseClass;
+  AssertProperty(Property1,visPublished,'Something','FPoint.W[x].y.Z','','','',0,False,False);
+  AssertNotNull('Have type',Property1.VarType);
+  AssertEquals('Property type class type',TPasUnresolvedTypeRef,Property1.vartype.ClassType);
+  AssertEquals('Property type name','Integer',Property1.vartype.name);
+  Assertequals('No index','',Property1.IndexValue);
+  AssertNull('No Index expression',Property1.IndexExpr);
+  AssertNull('No default expression',Property1.DefaultExpr);
+  Assertequals('Default value','',Property1.DefaultValue);
+end;
+
 procedure TTestClassType.TestPropertyReadWriteFromRecordField;
 begin
   StartVisibility(visPublished);
@@ -1422,6 +1650,45 @@ begin
   Assertequals('Default value','',Property1.DefaultValue);
 end;
 
+procedure TTestClassType.TestExternalClass;
+begin
+  StartExternalClass('','myname','mynamespace');
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  ParseClass;
+  AssertTrue('External class ',TheClass.IsExternal);
+  AssertEquals('External name space','mynamespace',TheClass.ExternalNameSpace);
+  AssertEquals('External name ','myname',TheClass.ExternalName);
+end;
+
+procedure TTestClassType.TestExternalClassNoNameSpace;
+begin
+  FStarted:=True;
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  FDecl.add('TMyClass = Class external name ''me'' ');
+  ParseClass;
+  AssertTrue('External class ',TheClass.IsExternal);
+  AssertEquals('External name space','',TheClass.ExternalNameSpace);
+  AssertEquals('External name ','me',TheClass.ExternalName);
+end;
+
+procedure TTestClassType.TestExternalClassNoNameKeyWord;
+begin
+  FStarted:=True;
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  FDecl.add('TMyClass = Class external ''name'' ''me'' ');
+  AssertException('No name keyword raises error',EParserError,@ParseClass);
+
+end;
+
+procedure TTestClassType.TestExternalClassNoName;
+begin
+  FStarted:=True;
+  Parser.CurrentModeswitches:=[msObjfpc,msexternalClass];
+  FDecl.add('TMyClass = Class external ''name'' name ');
+  AssertException('No name  raises error',EParserError,@ParseClass);
+
+end;
+
 procedure TTestClassType.TestLocalSimpleType;
 begin
   StartVisibility(visPublic);
@@ -1546,6 +1813,17 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestInterfaceDisp;
+
+begin
+  StartInterface('','',true);
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okDispInterface,TheClass.ObjKind);
+  AssertEquals('No members',0,TheClass.Members.Count);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+end;
+
 procedure TTestClassType.TestInterfaceParentedEmpty;
 begin
   StartInterface('IInterface','');
@@ -1570,6 +1848,86 @@ begin
   AssertNull('No UUID',TheClass.GUIDExpr);
 end;
 
+procedure TTestClassType.TestInterfaceDispIDMethod;
+
+begin
+  StartInterface('IInterface','');
+  AddMember('Procedure DoSomething(A : Integer) dispid 12');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('dispid modifier',[pmDispID],Method1.Modifiers);
+  AssertNotNull('dispid expression',Method1.DispIDExpr);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
+procedure TTestClassType.TestInterfaceDispIDMethod2;
+begin
+  StartInterface('IInterface','');
+  AddMember('Procedure DoSomething(A : Integer); dispid 12');
+  ParseClass;
+  DefaultMethod;
+  AssertEquals('Default visibility',visDefault,Method1.Visibility);
+  AssertEquals('dispid modifier',[pmDispID],Method1.Modifiers);
+  AssertNotNull('dispid expression',Method1.DispIDExpr);
+  AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
+end;
+
+procedure TTestClassType.TestInterfaceProperty;
+begin
+  StartInterface('IInterface','');
+  AddMember('Function GetS : Integer');
+  AddMember('Property S : Integer Read GetS');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okInterface,TheClass.ObjKind);
+  if TheClass.members.Count<1 then
+    Fail('No members for method');
+  AssertNotNull('Have method',FunctionMethod1);
+  AssertNotNull('Method proc type',FunctionMethod1.ProcType);
+  AssertMemberName('GetS');
+  AssertEquals('0 arguments',0,FunctionMethod1.ProcType.Args.Count) ;
+  AssertEquals('Default visibility',visDefault,FunctionMethod1.Visibility);
+  AssertEquals('No modifiers',[],FunctionMethod1.Modifiers);
+  AssertEquals('Default calling convention',ccDefault, FunctionMethod1.ProcType.CallingConvention);
+  AssertNull('No UUID',TheClass.GUIDExpr);
+  AssertNotNull('Have property',Property2);
+  AssertMemberName('S',Property2);
+end;
+
+procedure TTestClassType.TestInterfaceDispProperty;
+begin
+  StartInterface('IInterface','',True);
+  AddMember('Property S : Integer DispID 1');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okDispInterface,TheClass.ObjKind);
+  if TheClass.members.Count<1 then
+    Fail('No members for method');
+  AssertNotNull('Have property',Property1);
+  AssertMemberName('S',Property1);
+  AssertNotNull('Have property dispID',Property1.DispIDExpr);
+  AssertEquals('Have number',pekNumber,Property1.DispIDExpr.Kind);
+  AssertEquals('Have number','1', (Property1.DispIDExpr as TPrimitiveExpr).Value);
+end;
+
+procedure TTestClassType.TestInterfaceDispPropertyReadOnly;
+begin
+  StartInterface('IInterface','',True);
+  AddMember('Property S : Integer readonly DispID 1');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okDispInterface,TheClass.ObjKind);
+  if TheClass.members.Count<1 then
+    Fail('No members for method');
+  AssertNotNull('Have property',Property1);
+  AssertMemberName('S',Property1);
+  AssertNotNull('Have property dispID',Property1.DispIDExpr);
+  AssertTrue('DispID property is readonly',Property1.DispIDReadOnly);
+  AssertEquals('Have number',pekNumber,Property1.DispIDExpr.Kind);
+  AssertEquals('Have number','1', (Property1.DispIDExpr as TPrimitiveExpr).Value);
+end;
+
 procedure TTestClassType.TestInterfaceNoConstructor;
 begin
   StartInterface('','');
diff --git a/packages/fcl-passrc/tests/tcexprparser.pas b/packages/fcl-passrc/tests/tcexprparser.pas
index 1566c9be7f..b729e20d86 100644
--- a/packages/fcl-passrc/tests/tcexprparser.pas
+++ b/packages/fcl-passrc/tests/tcexprparser.pas
@@ -45,6 +45,16 @@ type
     procedure TestPrimitiveIntegerOctal;
     procedure TestPrimitiveIntegerBinary;
     procedure TestPrimitiveDouble;
+    procedure TestPrimitiveDouble2;
+    procedure TestPrimitiveDouble3;
+    procedure TestPrimitiveDouble4;
+    procedure TestPrimitiveDouble5;
+    procedure TestPrimitiveDouble6;
+    procedure TestPrimitiveDouble7;
+    procedure TestPrimitiveDouble8;
+    procedure TestPrimitiveDouble9;
+    procedure TestPrimitiveDouble10;
+    procedure TestPrimitiveDouble11;
     procedure TestPrimitiveString;
     procedure TestPrimitiveIdent;
     procedure TestPrimitiveBooleanFalse;
@@ -62,6 +72,8 @@ type
     Procedure TestUnaryAddress;
     Procedure TestUnaryNot;
     Procedure TestUnaryDeref;
+    Procedure TestUnaryDoubleDeref;
+    Procedure TestUnaryDoubleDeref2;
     Procedure TestBinaryAdd;
     Procedure TestBinarySubtract;
     Procedure TestBinaryMultiply;
@@ -91,6 +103,7 @@ type
     Procedure TestFunctionCall;
     Procedure TestFunctionCall2args;
     Procedure TestFunctionCallNoArgs;
+    Procedure ParseStrWithFormatFullyQualified;
     Procedure TestRange;
     Procedure TestBracketsTotal;
     Procedure TestBracketsLeft;
@@ -122,6 +135,12 @@ type
     Procedure TestTypeCast;
     procedure TestTypeCast2;
     Procedure TestCreate;
+    procedure TestChainedPointers;
+    procedure TestChainedPointers2;
+    procedure TestChainedPointers3;
+    Procedure TestNilCaret;
+    Procedure TestExpCaret;
+    Procedure TestArrayAccess;
   end;
 
 implementation
@@ -162,6 +181,66 @@ begin
   AssertExpression('Simple double',theExpr,pekNumber,'1.2');
 end;
 
+procedure TTestExpressions.TestPrimitiveDouble2;
+begin
+  ParseExpression('1.200');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.200');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble3;
+begin
+  ParseExpression('01.2');
+  AssertExpression('Simple double',theExpr,pekNumber,'01.2');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble4;
+begin
+  ParseExpression('1.2e10');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.2e10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble5;
+begin
+  ParseExpression('1.2e-10');
+  AssertExpression('Simple double',theExpr,pekNumber,'1.2e-10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble6;
+begin
+  ParseExpression('12e10');
+  AssertExpression('Simple double',theExpr,pekNumber,'12e10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble7;
+begin
+  ParseExpression('12e-10');
+  AssertExpression('Simple double',theExpr,pekNumber,'12e-10');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble8;
+begin
+  ParseExpression('8.5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8.5');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble9;
+begin
+  ParseExpression('8.E5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8.E5');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble10;
+begin
+  ParseExpression('8.E-5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8.E-5');
+end;
+
+procedure TTestExpressions.TestPrimitiveDouble11;
+begin
+  ParseExpression('8E+5');
+  AssertExpression('Simple double',theExpr,pekNumber,'8E+5');
+end;
+
 procedure TTestExpressions.TestPrimitiveString;
 begin
   DeclareVar('string');
@@ -210,13 +289,16 @@ Var
 begin
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
-  P:=TParamsExpr(AssertExpression('Simple identifier',theExpr,pekArrayParams,TParamsExpr));
-  B:=AssertExpression('Name of array',P.Value,pekBinary,TBInaryExpr) as TBInaryExpr;
-  AssertEquals('name is Subident',eopSubIdent,B.Opcode);
+  B:=AssertExpression('Binary of record',TheExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
+  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
   AssertExpression('Name of array',B.Left,pekIdent,'b');
-  AssertExpression('Name of array',B.Right,pekIdent,'a');
-  AssertEquals('One dimension',1,Length(p.params));
-  AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
+  P:=TParamsExpr(AssertExpression('Simple identifier',B.right,pekArrayParams,TParamsExpr));
+  AssertExpression('Name of array',P.Value,pekIdent,'a');
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('One dimension',1,Length(P.params));
+  AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 
 procedure TTestExpressions.TestArrayElement2Dims;
@@ -291,6 +373,9 @@ begin
   B:=TBinaryExpr(AssertExpression('First element is range',P.Params[0],pekRange,TBinaryExpr));
   AssertExpression('Left is 0',B.Left,pekNumber,'0');
   AssertExpression('Right is 10',B.Right,pekNumber,'10');
+  B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 
 procedure TTestExpressions.TestBracketsTotal;
@@ -502,6 +587,83 @@ begin
   ParseExpression('ESDOSerializationException.CreateFmt(SERR_InvalidDataTypeInContext,[IntToStr(Ord(AOwner^.DataType))])');
 end;
 
+procedure TTestExpressions.TestChainedPointers;
+begin
+  // From bug report 31719
+  Source.Add('type');
+  Source.Add('    PTResourceManager=^TResourceManager;');
+  Source.Add('    TResourceManager=object');
+  Source.Add('      function LoadResourceFromFile(filename:string):PTResourceManager;');
+  Source.Add('    end;');
+  Source.Add('    function TResourceManager.LoadResourceFromFile(filename:string):PTResourceManager;');
+  Source.Add('    begin');
+  Source.Add('      result:=@self;');
+  Source.Add('    end;');
+  Source.Add('');
+  Source.Add('  var');
+  Source.Add('    ResourceManager:TResourceManager;');
+  Source.Add('');
+  Source.Add('  begin');
+  Source.Add('    ResourceManager.LoadResourceFromFile(''file1'')');
+  Source.Add('                  ^.LoadResourceFromFile(''file2'');');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestChainedPointers2;
+begin
+  Source.Add('program afile;');
+  Source.Add('procedure test;');
+  Source.Add('begin');
+  Source.Add('ResourcePool.Shared^.Register(TypeOf(tTexture), @LoadTexture)^.Tag(GLResourceTag)');
+  Source.Add(' ^.Register(TypeOf(tShader), @LoadShader)^.Tag(GLResourceTag)//space - works');
+  Source.Add('^.Register(TypeOf(ShaderProgram), @LoadShaderProgram)^.Tag(GLResourceTag);//without space - does not work');
+  Source.Add('end;');
+  Source.Add('begin');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestChainedPointers3;
+begin
+  Source.Add('program afile;');
+  Source.Add('procedure test;');
+  Source.Add('begin');
+  Source.Add('ResourcePool.Shared^.Register(TypeOf(tTexture), @LoadTexture)^.Tag(GLResourceTag)');
+  Source.Add(' ^.Register(TypeOf(tShader), @LoadShader)^.Tag(GLResourceTag)//space - works');
+  Source.Add(#9'^.Register(TypeOf(ShaderProgram), @LoadShaderProgram)^.Tag(GLResourceTag);// tab - does not work');
+  Source.Add('end;');
+  Source.Add('begin');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestNilCaret;
+begin
+  Source.Add('{$mode objfpc}');
+  Source.Add('begin');
+  Source.Add('FillChar(nil^,10,10);');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestExpCaret;
+begin
+  Source.Add('{$mode objfpc}');
+  Source.Add('begin');
+  Source.Add('A:=B^;');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestExpressions.TestArrayAccess;
+begin
+  Source.Add('begin');
+  Source.Add('DoSomething((pb + 10)[4]);');
+  Source.Add('end.');
+  ParseModule;
+end;
+
 
 procedure TTestExpressions.TestUnaryMinus;
 begin
@@ -544,10 +706,30 @@ begin
   DeclareVar('integer','a');
   DeclareVar('pinteger','b');
   ParseExpression('b^');
-  AssertUnaryExpr('Simple address unary',eopDeref,FLeft);
+  AssertUnaryExpr('Simple deref unary',eopDeref,FLeft);
   AssertExpression('Simple identifier',theLeft,pekIdent,'b');
 end;
 
+procedure TTestExpressions.TestUnaryDoubleDeref;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('ppinteger','b');
+  ParseExpression('(b)^^');
+  AssertExpression('Deref expression 1',TheExpr,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 2',TUnaryExpr(TheExpr).Operand,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 3',TUnaryExpr(TUnaryExpr(TheExpr).Operand).Operand,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestUnaryDoubleDeref2;
+begin
+  DeclareVar('integer','a');
+  DeclareVar('ppinteger','b');
+  ParseExpression('b^^');
+  AssertExpression('Deref expression 1',TheExpr,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 2',TUnaryExpr(TheExpr).Operand,pekUnary,TUnaryExpr);
+  AssertExpression('Deref expression 3',TUnaryExpr(TUnaryExpr(TheExpr).Operand).Operand,pekIdent,'b');
+end;
+
 procedure TTestExpressions.TestBinaryAdd;
 begin
   ParseExpression('1+2');
@@ -868,7 +1050,7 @@ Var
   I : Integer;
 
 begin
-  StartProgram('afile');
+  StartProgram(ExtractFileUnitName(MainFilename));
   if FVariables.Count=0 then
     DeclareVar('integer');
   Add('Var');
@@ -913,6 +1095,8 @@ begin
   ARight:=Result.Right;
   AssertNotNull('Have left',ALeft);
   AssertNotNull('Have right',ARight);
+  TAssert.AssertSame('Result.left.parent=B',Result,Result.left.Parent);
+  TAssert.AssertSame('Result.right.parent=B',Result,Result.right.Parent);
 end;
 
 function TTestExpressions.AssertUnaryExpr(const Msg: String; Op: TExprOpCode;
@@ -931,6 +1115,24 @@ begin
   AssertNotNull('Have left',AOperand);
 end;
 
+Procedure TTestExpressions.ParseStrWithFormatFullyQualified;
+
+Var
+  P : TParamsExpr;
+  B : TBinaryExpr;
+
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','i');
+  ParseExpression('system.str(i:0:3,a)');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',theExpr,pekBinary,TBinaryExpr));
+  P:=TParamsExpr(AssertExpression('Simple identifier',B.Right,pekFuncParams,TParamsExpr));
+  AssertExpression('Name of function',P.Value,pekIdent,'str');
+  AssertEquals('2 argument',2,Length(p.params));
+  AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
+  AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
+end;
+
 initialization
 
   RegisterTest(TTestExpressions);
diff --git a/packages/fcl-passrc/tests/tcgenerics.pp b/packages/fcl-passrc/tests/tcgenerics.pp
new file mode 100644
index 0000000000..cab2db6344
--- /dev/null
+++ b/packages/fcl-passrc/tests/tcgenerics.pp
@@ -0,0 +1,167 @@
+unit tcgenerics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, pastree, testregistry, pscanner, tctypeparser;
+
+Type
+
+  { TTestGenerics }
+
+  TTestGenerics = Class(TBaseTestTypeParser)
+  Published
+    Procedure TestObjectGenerics;
+    Procedure TestRecordGenerics;
+    Procedure TestArrayGenerics;
+    Procedure TestSpecializationDelphi;
+    Procedure TestDeclarationDelphi;
+    Procedure TestDeclarationDelphiSpecialize;
+    Procedure TestMethodImplementation;
+    Procedure TestInlineSpecializationInArgument;
+    Procedure TestSpecializeNested;
+    Procedure TestInlineSpecializeInStatement;
+  end;
+
+implementation
+
+procedure TTestGenerics.TestObjectGenerics;
+begin
+  Add([
+    'Type',
+    'Generic TSomeClass<T> = Object',
+    '  b : T;',
+    'end;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestRecordGenerics;
+begin
+  Add([
+    'Type',
+    '  Generic TSome<T> = Record',
+    '    b : T;',
+    '  end;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestArrayGenerics;
+begin
+  Add([
+    'Type',
+    '  Generic TSome<T> = array of T;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestSpecializationDelphi;
+begin
+  ParseType('TFPGList<integer>',TPasSpecializeType,'');
+end;
+
+procedure TTestGenerics.TestDeclarationDelphi;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
+  Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
+  Source.Add('end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
+procedure TTestGenerics.TestDeclarationDelphiSpecialize;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
+  Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
+  Source.Add('end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertEquals('Name is correct','TSomeClass',T.Name);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
+procedure TTestGenerics.TestMethodImplementation;
+begin
+  With source do
+    begin
+    Add('unit afile;');
+    Add('{$MODE DELPHI}');
+    Add('interface');
+    Add('type');
+    Add('  TTest<T> =  object');
+    Add('    procedure foo(v:T);');
+    Add('  end;');
+    Add('implementation');
+    Add('procedure TTest<T>.foo;');
+    Add('begin');
+    Add('end;');
+    end;
+  ParseModule;
+end;
+
+procedure TTestGenerics.TestInlineSpecializationInArgument;
+begin
+  With source do
+    begin
+    Add('unit afile;');
+    Add('{$MODE DELPHI}');
+    Add('interface');
+    Add('type');
+    Add('  TFoo=class');
+    Add('    procedure foo(var Node:TSomeGeneric<TBoundingBox>;const index:Integer);');
+    Add('  end;');
+    Add('implementation');
+    end;
+  ParseModule;
+end;
+
+procedure TTestGenerics.TestSpecializeNested;
+begin
+  Add([
+    'Type',
+    '  generic TSomeClass<A,B> = class(specialize TOther<A,specialize TAnother<B>>) end;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestInlineSpecializeInStatement;
+begin
+  Add([
+  'begin',
+  '  vec:=TVector<double>.create;',
+  '  b:=a<b;',
+  '  t:=a<b.c<d,e.f>>;',
+  '']);
+  ParseModule;
+end;
+
+initialization
+  RegisterTest(TTestGenerics);
+end.
+
diff --git a/packages/fcl-passrc/tests/tcmoduleparser.pas b/packages/fcl-passrc/tests/tcmoduleparser.pas
index e777f84fb0..20f3a37157 100644
--- a/packages/fcl-passrc/tests/tcmoduleparser.pas
+++ b/packages/fcl-passrc/tests/tcmoduleparser.pas
@@ -15,7 +15,7 @@ Type
   private
     function GetIf: TInterfaceSection;
     function GetIm: TImplementationSection;
-    function CheckUnit(AIndex: Integer; const AName: String; AList: TFPList): TPasUnresolvedUnitRef;
+    function CheckUnit(AIndex: Integer; const AName: String; Section: TPasSection): TPasUnresolvedUnitRef;
   Protected
     Procedure ParseUnit;
     Procedure ParseProgram;
@@ -98,18 +98,32 @@ begin
 end;
 
 function TTestModuleParser.CheckUnit(AIndex: Integer; const AName: String;
-  AList: TFPList) : TPasUnresolvedUnitRef;
+  Section: TPasSection): TPasUnresolvedUnitRef;
 
 Var
   C : string;
+  AList: TFPList;
+  Clause: TPasUsesClause;
 
 begin
+  Result:=nil;
   C:='Unit '+IntTostr(AIndex)+' ';
+
+  AList:=Section.UsesList;
+  AssertNotNull('Have useslist',AList);
   if (AIndex>=AList.Count) then
     Fail(Format('Index %d larger than unit list count %d',[AIndex,AList.Count ]));
   AssertNotNull('Have pascal element',AList[AIndex]);
   AssertEquals(C+'Correct class',TPasUnresolvedUnitRef,TObject(AList[AIndex]).CLassType);
-  Result:=TPasUnresolvedUnitRef(AList[AIndex]);
+
+  Clause:=Section.UsesClause;
+  if AIndex>=length(Clause) then
+    Fail(Format('Index %d larger than unit list count %d',[AIndex,length(Clause) ]));
+  AssertNotNull('Have pascal element',Clause[AIndex]);
+  AssertEquals(C+'Correct class',TPasUsesUnit,Clause[AIndex].ClassType);
+  AssertNotNull(C+'Has Module',Clause[AIndex].Module);
+  AssertEquals(C+'Correct module class',TPasUnresolvedUnitRef,Clause[AIndex].Module.ClassType);
+  Result:=TPasUnresolvedUnitRef(Clause[AIndex].Module);
   AssertEquals(C+'Unit name correct',AName,Result.Name);
 end;
 
@@ -118,8 +132,11 @@ begin
   StartUnit('unit1');
   StartImplementation;
   ParseUnit;
-  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+  AssertEquals('Only system in interface units',1,IntfSection.UsesList.Count);
+  AssertEquals('Only system in interface units',1,length(IntfSection.UsesClause));
+  CheckUnit(0,'System',IntfSection);
   AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
+  AssertEquals('No implementation units',0,length(ImplSection.UsesClause));
 end;
 
 procedure TTestModuleParser.TestUnitOneUses;
@@ -129,9 +146,11 @@ begin
   StartImplementation;
   ParseUnit;
   AssertEquals('Two interface units',2,IntfSection.UsesList.Count);
-  CheckUnit(0,'System',IntfSection.UsesList);
-  CheckUnit(1,'a',IntfSection.UsesList);
+  AssertEquals('Two interface units',2,length(IntfSection.UsesClause));
+  CheckUnit(0,'System',IntfSection);
+  CheckUnit(1,'a',IntfSection);
   AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
+  AssertEquals('No implementation units',0,length(ImplSection.UsesClause));
 end;
 
 procedure TTestModuleParser.TestUnitTwoUses;
@@ -140,11 +159,13 @@ begin
   UsesClause(['a','b']);
   StartImplementation;
   ParseUnit;
-  AssertEquals('Two interface units',3,IntfSection.UsesList.Count);
-  CheckUnit(0,'System',IntfSection.UsesList);
-  CheckUnit(1,'a',IntfSection.UsesList);
-  CheckUnit(2,'b',IntfSection.UsesList);
+  AssertEquals('Three interface units',3,IntfSection.UsesList.Count);
+  AssertEquals('Three interface units',3,length(IntfSection.UsesClause));
+  CheckUnit(0,'System',IntfSection);
+  CheckUnit(1,'a',IntfSection);
+  CheckUnit(2,'b',IntfSection);
   AssertEquals('No implementation units',0,ImplSection.UsesList.Count);
+  AssertEquals('No implementation units',0,length(ImplSection.UsesClause));
 end;
 
 procedure TTestModuleParser.TestUnitOneImplUses;
@@ -154,8 +175,11 @@ begin
   UsesClause(['a']);
   ParseUnit;
   AssertEquals('One implementation units',1,ImplSection.UsesList.Count);
-  CheckUnit(0,'a',ImplSection.UsesList);
-  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+  AssertEquals('One implementation units',1,length(ImplSection.UsesClause));
+  CheckUnit(0,'a',ImplSection);
+  AssertEquals('Only system in interface units',1,IntfSection.UsesList.Count);
+  AssertEquals('Only system in interface units',1,length(IntfSection.UsesClause));
+  CheckUnit(0,'System',IntfSection);
 end;
 
 procedure TTestModuleParser.TestUnitTwoImplUses;
@@ -164,10 +188,13 @@ begin
   StartImplementation;
   UsesClause(['a','b']);
   ParseUnit;
+  AssertEquals('One interface unit',1,IntfSection.UsesList.Count);
+  AssertEquals('One interface unit',1,length(IntfSection.UsesClause));
+  CheckUnit(0,'System',IntfSection);
   AssertEquals('Two implementation units',2,ImplSection.UsesList.Count);
-  CheckUnit(0,'a',ImplSection.UsesList);
-  CheckUnit(1,'b',ImplSection.UsesList);
-  AssertEquals('No interface units',0,IntfSection.UsesList.Count);
+  AssertEquals('Two implementation units',2,length(ImplSection.UsesClause));
+  CheckUnit(0,'a',ImplSection);
+  CheckUnit(1,'b',ImplSection);
 end;
 
 procedure TTestModuleParser.TestEmptyUnitInitialization;
@@ -257,8 +284,9 @@ begin
   Add('begin');
   ParseProgram;
   AssertEquals('Two interface units',2, PasProgram.ProgramSection.UsesList.Count);
-  CheckUnit(0,'System',PasProgram.ProgramSection.UsesList);
-  CheckUnit(1,'a',PasProgram.ProgramSection.UsesList);
+  AssertEquals('Two interface units',2, length(PasProgram.ProgramSection.UsesClause));
+  CheckUnit(0,'System',PasProgram.ProgramSection);
+  CheckUnit(1,'a',PasProgram.ProgramSection);
 end;
 
 procedure TTestModuleParser.TestEmptyProgramUsesTwoUnits;
@@ -267,9 +295,10 @@ begin
   Add('begin');
   ParseProgram;
   AssertEquals('Three interface units',3, PasProgram.ProgramSection.UsesList.Count);
-  CheckUnit(0,'System',PasProgram.ProgramSection.UsesList);
-  CheckUnit(1,'a',PasProgram.ProgramSection.UsesList);
-  CheckUnit(2,'b',PasProgram.ProgramSection.UsesList);
+  AssertEquals('Three interface unit',3, length(PasProgram.ProgramSection.UsesClause));
+  CheckUnit(0,'System',PasProgram.ProgramSection);
+  CheckUnit(1,'a',PasProgram.ProgramSection);
+  CheckUnit(2,'b',PasProgram.ProgramSection);
 end;
 
 procedure TTestModuleParser.TestEmptyProgramUsesUnitIn;
@@ -281,11 +310,12 @@ begin
   UsesClause(['a in ''../a.pas''','b']);
   Add('begin');
   ParseProgram;
-  AssertEquals('One interface unit',3, PasProgram.ProgramSection.UsesList.Count);
-  CheckUnit(0,'System',PasProgram.ProgramSection.UsesList);
-  U:=CheckUnit(1,'a',PasProgram.ProgramSection.UsesList);
+  AssertEquals('Three interface unit',3, PasProgram.ProgramSection.UsesList.Count);
+  AssertEquals('Three interface unit',3, length(PasProgram.ProgramSection.UsesClause));
+  CheckUnit(0,'System',PasProgram.ProgramSection);
+  U:=CheckUnit(1,'a',PasProgram.ProgramSection);
   AssertEquals('Filename','''../a.pas''',U.FileName);
-  CheckUnit(2,'b',PasProgram.ProgramSection.UsesList);
+  CheckUnit(2,'b',PasProgram.ProgramSection);
 end;
 
 procedure TTestModuleParser.TestEmptyLibrary;
@@ -302,8 +332,9 @@ begin
   ParseLibrary;
   AssertEquals('Correct class',TPasLibrary,Module.ClassType);
   AssertEquals('Two interface units',2, PasLibrary.LibrarySection.UsesList.Count);
-  CheckUnit(0,'System',PasLibrary.LibrarySection.UsesList);
-  CheckUnit(1,'a',PasLibrary.LibrarySection.UsesList);
+  AssertEquals('Two interface units',2, length(PasLibrary.LibrarySection.UsesClause));
+  CheckUnit(0,'System',PasLibrary.LibrarySection);
+  CheckUnit(1,'a',PasLibrary.LibrarySection);
 end;
 
 procedure TTestModuleParser.TestEmptyLibraryExports;
diff --git a/packages/fcl-passrc/tests/tconstparser.pas b/packages/fcl-passrc/tests/tconstparser.pas
index 7cfc12f7f0..5829b5529f 100644
--- a/packages/fcl-passrc/tests/tconstparser.pas
+++ b/packages/fcl-passrc/tests/tconstparser.pas
@@ -77,6 +77,8 @@ Type
     Procedure TestTypedExprConst;
     Procedure TestRecordConst;
     Procedure TestArrayConst;
+    Procedure TestRangeConst;
+    Procedure TestArrayOfRangeConst;
   end;
 
   { TTestResourcestringParser }
@@ -205,6 +207,8 @@ begin
   ParseConst('1 + 2');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
   B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.Left.Parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.Parent=B',B,B.right.Parent);
   AssertExpression('Left expression',B.Left,pekNumber,'1');
   AssertExpression('Right expression',B.Right,pekNumber,'2');
 end;
@@ -506,6 +510,28 @@ begin
   AssertExpression('Element 2 value',R.Values[1],pekNumber,'2');
 end;
 
+procedure TTestConstParser.TestRangeConst;
+begin
+  Typed:='0..1';
+  ParseConst('1');
+  AssertEquals('Range type',TPasRangeType,TheConst.VarType.ClassType);
+  AssertExpression('Float const', TheExpr,pekNumber,'1');
+end;
+
+procedure TTestConstParser.TestArrayOfRangeConst;
+Var
+  R : TArrayValues;
+begin
+  Typed:='array [0..7] of 0..1';
+  ParseConst('(0, 0, 0, 0, 0, 0, 0, 0)');
+  AssertEquals('Array Values',TArrayValues,TheExpr.ClassType);
+  R:=TheExpr as TArrayValues;
+  AssertEquals('Expression list of ',pekListOfExp,TheExpr.Kind);
+  AssertEquals('elements',8,Length(R.Values));
+//  AssertEquals('Range type',TPasRangeType,TheConst.VarType.ClassType);
+//  AssertExpression('Float const', TheExpr,pekNumber,'1');
+end;
+
 { TTestResourcestringParser }
 
 function TTestResourcestringParser.ParseResourcestring(ASource: String
@@ -547,24 +573,33 @@ begin
 end;
 
 procedure TTestResourcestringParser.DoTestSum;
+var
+  B: TBinaryExpr;
 begin
   ParseResourcestring('''Something''+'' else''');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
-  AssertEquals('Correct left',TPrimitiveExpr,TBinaryExpr(TheExpr).Left.ClassType);
-  AssertEquals('Correct right',TPrimitiveExpr,TBinaryExpr(TheExpr).Right.ClassType);
-  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(TBinaryExpr(TheExpr).Left).Value);
-  AssertEquals('Correct right expression value',''' else''',TPrimitiveExpr(TBinaryExpr(TheExpr).Right).Value);
+  B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertEquals('Correct left',TPrimitiveExpr,B.Left.ClassType);
+  AssertEquals('Correct right',TPrimitiveExpr,B.Right.ClassType);
+  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(B.Left).Value);
+  AssertEquals('Correct right expression value',''' else''',TPrimitiveExpr(B.Right).Value);
 end;
 
 procedure TTestResourcestringParser.DoTestSum2;
+var
+  B: TBinaryExpr;
 begin
   ParseResourcestring('''Something''+different');
   CheckExprNameKindClass(pekBinary,TBinaryExpr);
-  AssertEquals('Correct left',TPrimitiveExpr,TBinaryExpr(TheExpr).Left.ClassType);
-  AssertEquals('Correct right',TPrimitiveExpr,TBinaryExpr(TheExpr).Right.ClassType);
-  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(TBinaryExpr(TheExpr).Left).Value);
-  AssertEquals('Correct right expression value','different',TPrimitiveExpr(TBinaryExpr(TheExpr).Right).Value);
-
+  B:=TBinaryExpr(TheExpr);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertEquals('Correct left',TPrimitiveExpr,B.Left.ClassType);
+  AssertEquals('Correct right',TPrimitiveExpr,B.Right.ClassType);
+  AssertEquals('Correct left expression value','''Something''',TPrimitiveExpr(B.Left).Value);
+  AssertEquals('Correct right expression value','different',TPrimitiveExpr(B.Right).Value);
 end;
 
 procedure TTestResourcestringParser.TestSimple;
diff --git a/packages/fcl-passrc/tests/tcpassrcutil.pas b/packages/fcl-passrc/tests/tcpassrcutil.pas
index a4d191840e..f85e917a47 100644
--- a/packages/fcl-passrc/tests/tcpassrcutil.pas
+++ b/packages/fcl-passrc/tests/tcpassrcutil.pas
@@ -5,7 +5,7 @@ unit tcpassrcutil;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils,passrcutil, testregistry;
+  Classes, SysUtils, fpcunit,passrcutil, testregistry;
 
 type
 
@@ -16,7 +16,7 @@ type
     FAnalyser : TPasSrcAnalysis;
     FSrc : TStrings;
     FList : TStrings;
-    FStream: TmemoryStream;
+    FStream: TMemoryStream;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -78,7 +78,7 @@ begin
   StartImplementation;
   EndSource;
   Analyser.GetInterfaceUnits(List);
-  AssertList('0 interface units',[]);
+  AssertList('1 interface unit',['System']);
 end;
 
 procedure TPasSrcUtilTest.TestGetImplementationUses;
diff --git a/packages/fcl-passrc/tests/tcprocfunc.pas b/packages/fcl-passrc/tests/tcprocfunc.pas
index 2bc74f6769..1fb053c159 100644
--- a/packages/fcl-passrc/tests/tcprocfunc.pas
+++ b/packages/fcl-passrc/tests/tcprocfunc.pas
@@ -24,10 +24,11 @@ type
       AValue: String='');
     procedure AssertArrayArg(ProcType: TPasProcedureType; AIndex: Integer;
       AName: String; AAccess: TArgumentAccess; const ElementTypeName: String);
-    procedure AssertFunc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
-    procedure AssertProc(Mods: TProcedureModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
+    procedure AssertFunc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasFunction=nil);
+    procedure AssertProc(const Mods: TProcedureModifiers; const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer; P: TPasProcedure=nil);
     function BaseAssertArg(ProcType: TPasProcedureType; AIndex: Integer;
       AName: String; AAccess: TArgumentAccess; AValue: String=''): TPasArgument;
+    procedure CreateForwardTest;
     function GetFT: TPasFunctionType;
     function GetPT: TPasProcedureType;
     Procedure ParseProcedure;
@@ -80,6 +81,7 @@ type
     Procedure TestFunctionOneArgDefaultExpr;
     procedure TestProcedureTwoArgsDefault;
     Procedure TestFunctionTwoArgsDefault;
+    procedure TestFunctionOneArgEnumeratedExplicit;
     procedure TestProcedureOneUntypedVarArg;
     Procedure TestFunctionOneUntypedVarArg;
     procedure TestProcedureTwoUntypedVarArgs;
@@ -128,9 +130,12 @@ type
     Procedure TestFunctionForwardInterface;
     Procedure TestProcedureForward;
     Procedure TestFunctionForward;
+    Procedure TestProcedureFar;
+    Procedure TestFunctionFar;
     Procedure TestProcedureCdeclForward;
     Procedure TestFunctionCDeclForward;
     Procedure TestProcedureCompilerProc;
+    Procedure TestProcedureNoReturn;
     Procedure TestFunctionCompilerProc;
     Procedure TestProcedureCDeclCompilerProc;
     Procedure TestFunctionCDeclCompilerProc;
@@ -144,6 +149,8 @@ type
     Procedure TestFunctionCDeclExport;
     Procedure TestProcedureExternal;
     Procedure TestFunctionExternal;
+    Procedure TestFunctionForwardNoReturnDelphi;
+    procedure TestFunctionForwardNoReturnNoDelphi;
     Procedure TestProcedureExternalLibName;
     Procedure TestFunctionExternalLibName;
     Procedure TestProcedureExternalLibNameName;
@@ -151,6 +158,7 @@ type
     Procedure TestProcedureExternalName;
     Procedure TestFunctionExternalName;
     Procedure TestProcedureCdeclExternal;
+    Procedure TestProcedureAlias;
     Procedure TestFunctionCdeclExternal;
     Procedure TestProcedureCdeclExternalLibName;
     Procedure TestFunctionCdeclExternalLibName;
@@ -158,8 +166,10 @@ type
     Procedure TestFunctionCdeclExternalLibNameName;
     Procedure TestProcedureCdeclExternalName;
     Procedure TestFunctionCdeclExternalName;
+    Procedure TestFunctionAlias;
     Procedure TestOperatorTokens;
     procedure TestOperatorNames;
+    Procedure TestFunctionNoResult;
   end;
 
 implementation
@@ -259,13 +269,16 @@ begin
     CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
 end;
 
-procedure TTestProcedureFunction.AssertProc(Mods : TProcedureModifiers; CC : TCallingConvention; ArgCount : Integer; P : TPasProcedure = Nil);
+procedure TTestProcedureFunction.AssertProc(const Mods: TProcedureModifiers;
+  const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
+  P: TPasProcedure);
 
 begin
   If P=Nil then
     P:=Proc;
   AssertNotNull('No proc to assert',P);
   AssertEquals('Procedure modifiers',Mods,P.Modifiers);
+  AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
   AssertEquals('Procedue calling convention',CC,P.CallingConvention);
   AssertEquals('No message name','',p.MessageName);
   AssertEquals('No message type',pmtNone,P.MessageType);
@@ -275,13 +288,16 @@ begin
   AssertEquals('Not is nested',False,P.ProcType.IsNested);
 end;
 
-procedure TTestProcedureFunction.AssertFunc(Mods : TProcedureModifiers; CC : TCallingConvention; ArgCount : Integer; P : TPasFunction = Nil);
+procedure TTestProcedureFunction.AssertFunc(const Mods: TProcedureModifiers;
+  const TypeMods: TProcTypeModifiers; CC: TCallingConvention; ArgCount: Integer;
+  P: TPasFunction);
 
 begin
   If P=Nil then
     P:=Func;
   AssertNotNull('No func to assert',P);
   AssertEquals('Procedure modifiers',Mods,P.Modifiers);
+  AssertEquals('Procedure type modifiers',TypeMods,P.ProcType.Modifiers);
   AssertEquals('Procedue calling convention',CC,P.CallingConvention);
   AssertEquals('No message name','',p.MessageName);
   AssertEquals('No message type',pmtNone,P.MessageType);
@@ -374,7 +390,7 @@ end;
 procedure TTestProcedureFunction.TestEmptyProcedure;
 begin
   ParseProcedure('');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedureComment;
@@ -386,7 +402,7 @@ end;
 procedure TTestProcedureFunction.TestEmptyFunction;
 begin
   ParseFunction('');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionComment;
@@ -398,50 +414,49 @@ end;
 procedure TTestProcedureFunction.TestEmptyProcedureDeprecated;
 begin
   ParseProcedure('','deprecated');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionDeprecated;
 begin
   ParseFunction('','deprecated');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedurePlatform;
 begin
   ParseProcedure('','platform');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionPlatform;
 begin
   ParseFunction('','platform');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedureExperimental;
 begin
   ParseProcedure('','experimental');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionExperimental;
 begin
   ParseFunction('','experimental');
-  AssertFunc([],ccDefault,0);
+  AssertFunc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyProcedureUnimplemented;
 begin
   ParseProcedure('','unimplemented');
-  AssertProc([],ccDefault,0);
+  AssertProc([],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestEmptyFunctionUnimplemented;
 begin
   ParseFunction('','unimplemented');
-  AssertFunc([],ccDefault,0);
-
+  AssertFunc([],[],ccDefault,0);
 end;
 
 
@@ -449,77 +464,77 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneArg;
 begin
   ParseProcedure('(B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArg;
 begin
   ParseFunction('(B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneVarArg;
 begin
   ParseProcedure('(Var B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argVar,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneVarArg;
 begin
   ParseFunction('(Var B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argVar,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneConstArg;
 begin
   ParseProcedure('(Const B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argConst,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneConstArg;
 begin
   ParseFunction('(Const B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argConst,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneOutArg;
 begin
   ParseProcedure('(Out B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argOut,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneOutArg;
 begin
   ParseFunction('(Out B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argOut,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneConstRefArg;
 begin
   ParseProcedure('(Constref B : Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argConstRef,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneConstRefArg;
 begin
   ParseFunction('(ConstRef B : Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argConstref,'Integer','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoArgs;
 begin
   ParseProcedure('(B,C : Integer)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
@@ -527,7 +542,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoArgs;
 begin
   ParseFunction('(B,C : Integer)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argDefault,'Integer','');
   AssertArg(FuncType,1,'C',argDefault,'Integer','');
 end;
@@ -535,7 +550,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureTwoArgsSeparate;
 begin
   ParseProcedure('(B : Integer; C : Integer)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argDefault,'Integer','');
   AssertArg(ProcType,1,'C',argDefault,'Integer','');
 end;
@@ -543,7 +558,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoArgsSeparate;
 begin
   ParseFunction('(B : Integer;C : Integer)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argDefault,'Integer','');
   AssertArg(FuncType,1,'C',argDefault,'Integer','');
 end;
@@ -551,49 +566,56 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneArgDefault;
 begin
   ParseProcedure('(B : Integer = 1)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'Integer','1');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgDefault;
 begin
   ParseFunction('(B : Integer = 1)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'Integer','1');
 end;
 
+procedure TTestProcedureFunction.TestFunctionOneArgEnumeratedExplicit;
+begin
+  ParseFunction('(B : TSomeEnum = TSomeEnum.False)');
+  AssertFunc([],[],ccDefault,1);
+  AssertArg(FuncType,0,'B',argDefault,'TSomeEnum','TSomeEnum.False');
+end;
+
 procedure TTestProcedureFunction.TestProcedureOneArgDefaultSet;
 begin
   ParseProcedure('(B : MySet = [1,2])');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'MySet','[1, 2]');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgDefaultSet;
 begin
   ParseFunction('(B : MySet = [1,2])');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'MySet','[1, 2]');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOneArgDefaultExpr;
 begin
   ParseProcedure('(B : Integer = 1 + 2)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argDefault,'Integer','1 + 2');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneArgDefaultExpr;
 begin
   ParseFunction('(B : Integer = 1 + 2)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argDefault,'Integer','1 + 2');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoArgsDefault;
 begin
   ParseProcedure('(B : Integer = 1; C : Integer = 2)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argDefault,'Integer','1');
   AssertArg(ProcType,1,'C',argDefault,'Integer','2');
 end;
@@ -601,7 +623,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoArgsDefault;
 begin
   ParseFunction('(B : Integer = 1; C : Integer = 2)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argDefault,'Integer','1');
   AssertArg(FuncType,1,'C',argDefault,'Integer','2');
 end;
@@ -609,21 +631,21 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneUntypedVarArg;
 begin
   ParseProcedure('(Var B)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argVar,'','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneUntypedVarArg;
 begin
   ParseFunction('(Var B)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argVar,'','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoUntypedVarArgs;
 begin
   ParseProcedure('(Var B; Var C)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argVar,'','');
   AssertArg(ProcType,1,'C',argVar,'','');
 end;
@@ -631,7 +653,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoUntypedVarArgs;
 begin
   ParseFunction('(Var B; Var C)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argVar,'','');
   AssertArg(FuncType,1,'C',argVar,'','');
 end;
@@ -639,21 +661,21 @@ end;
 procedure TTestProcedureFunction.TestProcedureOneUntypedConstArg;
 begin
   ParseProcedure('(Const B)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArg(ProcType,0,'B',argConst,'','');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOneUntypedConstArg;
 begin
   ParseFunction('(Const B)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArg(FuncType,0,'B',argConst,'','');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoUntypedConstArgs;
 begin
   ParseProcedure('(Const B; Const C)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArg(ProcType,0,'B',argConst,'','');
   AssertArg(ProcType,1,'C',argConst,'','');
 end;
@@ -661,7 +683,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoUntypedConstArgs;
 begin
   ParseFunction('(Const B; Const C)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArg(FuncType,0,'B',argConst,'','');
   AssertArg(FuncType,1,'C',argConst,'','');
 end;
@@ -669,21 +691,21 @@ end;
 procedure TTestProcedureFunction.TestProcedureOpenArrayArg;
 begin
   ParseProcedure('(B : Array of Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestFunctionOpenArrayArg;
 begin
   ParseFunction('(B : Array of Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestProcedureTwoOpenArrayArgs;
 begin
   ParseProcedure('(B : Array of Integer;C : Array of Integer)');
-  AssertProc([],ccDefault,2);
+  AssertProc([],[],ccDefault,2);
   AssertArrayArg(ProcType,0,'B',argDefault,'Integer');
   AssertArrayArg(ProcType,1,'C',argDefault,'Integer');
 end;
@@ -691,7 +713,7 @@ end;
 procedure TTestProcedureFunction.TestFunctionTwoOpenArrayArgs;
 begin
   ParseFunction('(B : Array of Integer;C : Array of Integer)');
-  AssertFunc([],ccDefault,2);
+  AssertFunc([],[],ccDefault,2);
   AssertArrayArg(FuncType,0,'B',argDefault,'Integer');
   AssertArrayArg(FuncType,1,'C',argDefault,'Integer');
 end;
@@ -699,142 +721,142 @@ end;
 procedure TTestProcedureFunction.TestProcedureConstOpenArrayArg;
 begin
   ParseProcedure('(Const B : Array of Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argConst,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestFunctionConstOpenArrayArg;
 begin
   ParseFunction('(Const B : Array of Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argConst,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestProcedureVarOpenArrayArg;
 begin
   ParseProcedure('(Var B : Array of Integer)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argVar,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestFunctionVarOpenArrayArg;
 begin
   ParseFunction('(Var B : Array of Integer)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argVar,'Integer');
 end;
 
 procedure TTestProcedureFunction.TestProcedureArrayOfConstArg;
 begin
   ParseProcedure('(B : Array of Const)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argDefault,'');
 end;
 
 procedure TTestProcedureFunction.TestFunctionArrayOfConstArg;
 begin
   ParseFunction('(B : Array of Const)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argDefault,'');
 end;
 
 procedure TTestProcedureFunction.TestProcedureConstArrayOfConstArg;
 begin
   ParseProcedure('(Const B : Array of Const)');
-  AssertProc([],ccDefault,1);
+  AssertProc([],[],ccDefault,1);
   AssertArrayArg(ProcType,0,'B',argConst,'');
 end;
 
 procedure TTestProcedureFunction.TestFunctionConstArrayOfConstArg;
 begin
   ParseFunction('(Const B : Array of Const)');
-  AssertFunc([],ccDefault,1);
+  AssertFunc([],[],ccDefault,1);
   AssertArrayArg(FuncType,0,'B',argConst,'');
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdecl;
 begin
   ParseProcedure('; cdecl');
-  AssertProc([],ccCdecl,0);
+  AssertProc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCdecl;
 begin
   ParseFunction('','','',ccCdecl);
-  AssertFunc([],ccCdecl,0);
+  AssertFunc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclDeprecated;
 begin
   ParseProcedure('; cdecl;','deprecated');
-  AssertProc([],ccCdecl,0);
+  AssertProc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCdeclDeprecated;
 begin
   ParseFunction('','','deprecated',ccCdecl);
-  AssertFunc([],ccCdecl,0);
+  AssertFunc([],[],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureSafeCall;
 begin
   ParseProcedure('; safecall;','');
-  AssertProc([],ccSafeCall,0);
+  AssertProc([],[],ccSafeCall,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionSafeCall;
 begin
   ParseFunction('','','',ccSafecall);
-  AssertFunc([],ccSafecall,0);
+  AssertFunc([],[],ccSafecall,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedurePascal;
 begin
   ParseProcedure('; pascal;','');
-  AssertProc([],ccPascal,0);
+  AssertProc([],[],ccPascal,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionPascal;
 begin
   ParseFunction('','','',ccPascal);
-  AssertFunc([],ccPascal,0);
+  AssertFunc([],[],ccPascal,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureStdCall;
 begin
   ParseProcedure('; stdcall;','');
-  AssertProc([],ccstdcall,0);
+  AssertProc([],[],ccstdcall,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionStdCall;
 begin
   ParseFunction('','','',ccStdCall);
-  AssertFunc([],ccStdCall,0);
+  AssertFunc([],[],ccStdCall,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureOldFPCCall;
 begin
   ParseProcedure('; oldfpccall;','');
-  AssertProc([],ccoldfpccall,0);
+  AssertProc([],[],ccoldfpccall,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionOldFPCCall;
 begin
   ParseFunction('','','',ccOldFPCCall);
-  AssertFunc([],ccOldFPCCall,0);
+  AssertFunc([],[],ccOldFPCCall,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedurePublic;
 begin
   ParseProcedure('; public name ''myfunc'';','');
-  AssertProc([pmPublic],ccDefault,0);
+  AssertProc([pmPublic],[],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekString,'''myfunc''');
 end;
 
 procedure TTestProcedureFunction.TestProcedurePublicIdent;
 begin
   ParseProcedure('; public name exportname;','');
-  AssertProc([pmPublic],ccDefault,0);
+  AssertProc([pmPublic],[],ccDefault,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
@@ -842,14 +864,14 @@ procedure TTestProcedureFunction.TestFunctionPublic;
 begin
   AddDeclaration('function A : Integer; public name exportname');
   ParseFunction;
-  AssertFunc([pmPublic],ccDefault,0);
+  AssertFunc([pmPublic],[],ccDefault,0);
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclPublic;
 begin
   ParseProcedure('; cdecl; public name exportname;','');
-  AssertProc([pmPublic],ccCDecl,0);
+  AssertProc([pmPublic],[],ccCDecl,0);
   AssertExpression('Public name',Proc.PublicName,pekIdent,'exportname');
 end;
 
@@ -857,47 +879,47 @@ procedure TTestProcedureFunction.TestFunctionCdeclPublic;
 begin
   AddDeclaration('function A : Integer; cdecl; public name exportname');
   ParseFunction;
-  AssertFunc([pmPublic],ccCDecl,0);
+  AssertFunc([pmPublic],[],ccCDecl,0);
   AssertExpression('Public name',Func.PublicName,pekIdent,'exportname');
 end;
 
 procedure TTestProcedureFunction.TestProcedureOverload;
 begin
   ParseProcedure('; overload;','');
-  AssertProc([pmOverload],ccDefault,0);
+  AssertProc([pmOverload],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionOverload;
 begin
   AddDeclaration('function A : Integer; overload');
   ParseFunction;
-  AssertFunc([pmOverload],ccDefault,0);
+  AssertFunc([pmOverload],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureVarargs;
 begin
   ParseProcedure('; varargs;','');
-  AssertProc([pmVarArgs],ccDefault,0);
+  AssertProc([],[ptmVarArgs],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionVarArgs;
 begin
   AddDeclaration('function A : Integer; varargs');
   ParseFunction;
-  AssertFunc([pmVarArgs],ccDefault,0);
+  AssertFunc([],[ptmVarArgs],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclVarargs;
 begin
   ParseProcedure(';cdecl; varargs;','');
-  AssertProc([pmVarArgs],ccCDecl,0);
+  AssertProc([],[ptmVarArgs],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclVarArgs;
 begin
   AddDeclaration('function A : Integer; cdecl; varargs');
   ParseFunction;
-  AssertFunc([pmVarArgs],ccCdecl,0);
+  AssertFunc([],[ptmVarArgs],ccCdecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureForwardInterface;
@@ -917,7 +939,7 @@ begin
   UseImplementation:=True;
   AddDeclaration('procedure A; forward;');
   ParseProcedure;
-  AssertProc([pmforward],ccDefault,0);
+  AssertProc([pmforward],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionForward;
@@ -925,7 +947,21 @@ begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; forward;');
   ParseFunction;
-  AssertFunc([pmforward],ccDefault,0);
+  AssertFunc([pmforward],[],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureFar;
+begin
+  AddDeclaration('procedure A; far;');
+  ParseProcedure;
+  AssertProc([pmfar],[],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestFunctionFar;
+begin
+  AddDeclaration('function A : integer; far;');
+  ParseFunction;
+  AssertFunc([pmfar],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclForward;
@@ -933,7 +969,7 @@ begin
   UseImplementation:=True;
   AddDeclaration('procedure A; cdecl; forward;');
   ParseProcedure;
-  AssertProc([pmforward],ccCDecl,0);
+  AssertProc([pmforward],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclForward;
@@ -941,91 +977,97 @@ begin
   UseImplementation:=True;
   AddDeclaration('function A : integer; cdecl; forward;');
   ParseFunction;
-  AssertFunc([pmforward],ccCDecl,0);
+  AssertFunc([pmforward],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCompilerProc;
 begin
   ParseProcedure(';compilerproc;','');
-  AssertProc([pmCompilerProc],ccDefault,0);
+  AssertProc([pmCompilerProc],[],ccDefault,0);
+end;
+
+procedure TTestProcedureFunction.TestProcedureNoReturn;
+begin
+  ParseProcedure(';noreturn;','');
+  AssertProc([pmnoreturn],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCompilerProc;
 begin
   AddDeclaration('function A : Integer; compilerproc');
   ParseFunction;
-  AssertFunc([pmCompilerProc],ccDefault,0);
+  AssertFunc([pmCompilerProc],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclCompilerProc;
 begin
   ParseProcedure(';cdecl;compilerproc;','');
-  AssertProc([pmCompilerProc],ccCDecl,0);
+  AssertProc([pmCompilerProc],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclCompilerProc;
 begin
   AddDeclaration('function A : Integer; cdecl; compilerproc');
   ParseFunction;
-  AssertFunc([pmCompilerProc],ccCDecl,0);
+  AssertFunc([pmCompilerProc],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureAssembler;
 begin
   ParseProcedure(';assembler;','');
-  AssertProc([pmAssembler],ccDefault,0);
+  AssertProc([pmAssembler],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionAssembler;
 begin
   AddDeclaration('function A : Integer; assembler');
   ParseFunction;
-  AssertFunc([pmAssembler],ccDefault,0);
+  AssertFunc([pmAssembler],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclAssembler;
 begin
   ParseProcedure(';cdecl;assembler;','');
-  AssertProc([pmAssembler],ccCDecl,0);
+  AssertProc([pmAssembler],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclAssembler;
 begin
   AddDeclaration('function A : Integer; cdecl; assembler');
   ParseFunction;
-  AssertFunc([pmAssembler],ccCDecl,0);
+  AssertFunc([pmAssembler],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureExport;
 begin
   ParseProcedure(';export;','');
-  AssertProc([pmExport],ccDefault,0);
+  AssertProc([pmExport],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionExport;
 begin
   AddDeclaration('function A : Integer; export');
   ParseFunction;
-  AssertFunc([pmExport],ccDefault,0);
+  AssertFunc([pmExport],[],ccDefault,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCDeclExport;
 begin
   ParseProcedure('cdecl;export;','');
-  AssertProc([pmExport],ccCDecl,0);
+  AssertProc([pmExport],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestFunctionCDeclExport;
 begin
   AddDeclaration('function A : Integer; cdecl; export');
   ParseFunction;
-  AssertFunc([pmExport],ccCDecl,0);
+  AssertFunc([pmExport],[],ccCDecl,0);
 end;
 
 procedure TTestProcedureFunction.TestProcedureExternal;
 begin
   ParseProcedure(';external','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
@@ -1033,14 +1075,47 @@ procedure TTestProcedureFunction.TestFunctionExternal;
 begin
   AddDeclaration('function A : Integer; external');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
+procedure TTestProcedureFunction.CreateForwardTest;
+
+begin
+  With Source do
+    begin
+    Add('type');
+    Add('');
+    Add('Entity=object');
+    Add('  function test:Boolean;');
+    Add('end;');
+    Add('');
+    Add('Function Entity.test;');
+    Add('begin');
+    Add('end;');
+    Add('');
+    Add('begin');
+    // End is added by ParseModule
+    end;
+end;
+
+procedure TTestProcedureFunction.TestFunctionForwardNoReturnDelphi;
+begin
+  Source.Add('{$MODE DELPHI}');
+  CreateForwardTest;
+  ParseModule;
+end;
+
+procedure TTestProcedureFunction.TestFunctionForwardNoReturnNoDelphi;
+begin
+  CreateForwardTest;
+  AssertException('Only in delphi mode can result be omitted',EParserError,@ParseModule);
+end;
+
 procedure TTestProcedureFunction.TestProcedureExternalLibName;
 begin
   ParseProcedure(';external ''libname''','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
@@ -1048,14 +1123,14 @@ procedure TTestProcedureFunction.TestFunctionExternalLibName;
 begin
   AddDeclaration('function A : Integer; external ''libname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
 procedure TTestProcedureFunction.TestProcedureExternalLibNameName;
 begin
   ParseProcedure(';external ''libname'' name ''symbolname''','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1064,7 +1139,7 @@ procedure TTestProcedureFunction.TestFunctionExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; external ''libname'' name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1072,7 +1147,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureExternalName;
 begin
   ParseProcedure(';external name ''symbolname''','');
-  AssertProc([pmExternal],ccDefault,0);
+  AssertProc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1081,7 +1156,7 @@ procedure TTestProcedureFunction.TestFunctionExternalName;
 begin
   AddDeclaration('function A : Integer; external name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccDefault,0);
+  AssertFunc([pmExternal],[],ccDefault,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1089,7 +1164,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureCdeclExternal;
 begin
   ParseProcedure('; cdecl; external','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
 end;
 
@@ -1097,14 +1172,14 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternal;
 begin
   AddDeclaration('function A : Integer; cdecl; external');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclExternalLibName;
 begin
   ParseProcedure('; cdecl; external ''libname''','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
 end;
 
@@ -1112,14 +1187,14 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternalLibName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
 end;
 
 procedure TTestProcedureFunction.TestProcedureCdeclExternalLibNameName;
 begin
   ParseProcedure('; cdecl; external ''libname'' name ''symbolname''','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Proc.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1128,7 +1203,7 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternalLibNameName;
 begin
   AddDeclaration('function A : Integer; cdecl; external ''libname'' name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertExpression('Library name expression',Func.LibraryExpr,pekString,'''libname''');
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1136,7 +1211,7 @@ end;
 procedure TTestProcedureFunction.TestProcedureCdeclExternalName;
 begin
   ParseProcedure('; cdecl; external name ''symbolname''','');
-  AssertProc([pmExternal],ccCdecl,0);
+  AssertProc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Proc.LibraryExpr);
   AssertExpression('Library symbol expression',Proc.LibrarySymbolName,pekString,'''symbolname''');
 end;
@@ -1145,33 +1220,51 @@ procedure TTestProcedureFunction.TestFunctionCdeclExternalName;
 begin
   AddDeclaration('function A : Integer; cdecl; external name ''symbolname''');
   ParseFunction;
-  AssertFunc([pmExternal],ccCdecl,0);
+  AssertFunc([pmExternal],[],ccCdecl,0);
   AssertNull('No Library name expression',Func.LibraryExpr);
   AssertExpression('Library symbol expression',Func.LibrarySymbolName,pekString,'''symbolname''');
 end;
 
+procedure TTestProcedureFunction.TestFunctionAlias;
+begin
+  AddDeclaration('function A : Integer; alias: ''myalias''');
+  ParseFunction;
+  AssertFunc([],[],ccDefault,0);
+  AssertEquals('Alias name','''myalias''',Func.AliasName);
+end;
+
+procedure TTestProcedureFunction.TestProcedureAlias;
+begin
+  AddDeclaration('Procedure A; Alias : ''myalias''');
+  ParseProcedure;
+  AssertProc([],[],ccDefault,0);
+  AssertEquals('Alias name','''myalias''',Proc.AliasName);
+end;
+
 procedure TTestProcedureFunction.TestOperatorTokens;
 
 Var
   t : TOperatorType;
+  s : string;
 
 begin
   For t:=otMul to High(TOperatorType) do
     // No way to distinguish between logical/bitwise or/and/Xor
     if not (t in [otBitwiseOr,otBitwiseAnd,otBitwiseXor]) then
       begin
+      S:=GetEnumName(TypeInfo(TOperatorType),Ord(T));
       ResetParser;
       if t in UnaryOperators then
         AddDeclaration(Format('operator %s (a: Integer) : te',[OperatorTokens[t]]))
       else
         AddDeclaration(Format('operator %s (a: Integer; b: integer) : te',[OperatorTokens[t]]));
       ParseOperator;
-      AssertEquals('Token based',Not (T in [otInc,otDec]),FOperator.TokenBased);
-      AssertEquals('Correct operator type',T,FOperator.OperatorType);
+      AssertEquals(S+': Token based ',Not (T in [otInc,otDec,otEnumerator]),FOperator.TokenBased);
+      AssertEquals(S+': Correct operator type',T,FOperator.OperatorType);
       if t in UnaryOperators then
-        AssertEquals('Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
+        AssertEquals(S+': Correct operator name',format('%s(Integer):te',[OperatorNames[t]]),FOperator.Name)
       else
-        AssertEquals('Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
+        AssertEquals(S+': Correct operator name',format('%s(Integer,Integer):te',[OperatorNames[t]]),FOperator.Name);
       end;
 end;
 
@@ -1198,6 +1291,21 @@ begin
       end;
 end;
 
+procedure TTestProcedureFunction.TestFunctionNoResult;
+begin
+  Add('unit afile;');
+  Add('{$mode delphi}');
+  Add('interface');
+  Add('function TestDelphiModeFuncs(d:double):string;');
+  Add('implementation');
+  Add('function TestDelphiModeFuncs;');
+  Add('begin');
+  Add('end;');
+  EndSource;
+  Parser.Options:=[po_delphi];
+  ParseModule;
+end;
+
 procedure TTestProcedureFunction.SetUp;
 begin
    Inherited;
diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas
new file mode 100644
index 0000000000..3a8f1e4a7f
--- /dev/null
+++ b/packages/fcl-passrc/tests/tcresolver.pas
@@ -0,0 +1,9739 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestResolver.TestEmpty
+}
+(*
+  CheckReferenceDirectives:
+    {#a} label "a", labels all elements at the following token
+    {@a} reference "a", search at next token for an element e with
+           TResolvedReference(e.CustomData).Declaration points to an element
+           labeled "a".
+    {=a} is "a", search at next token for a TPasAliasType t with t.DestType
+           points to an element labeled "a"
+*)
+unit tcresolver;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs, strutils, fpcunit, testregistry,
+  PasTree, PScanner, PParser, PasResolver, PasResolveEval,
+  tcbaseparser;
+
+type
+  TSrcMarkerKind = (
+    mkLabel,
+    mkResolverReference,
+    mkDirectReference
+    );
+  PSrcMarker = ^TSrcMarker;
+  TSrcMarker = record
+    Kind: TSrcMarkerKind;
+    Filename: string;
+    Row: integer;
+    StartCol, EndCol: integer; // token start, end column
+    Identifier: string;
+    Next: PSrcMarker;
+  end;
+
+const
+  SrcMarker: array[TSrcMarkerKind] of char = (
+    '#', // mkLabel
+    '@', // mkResolverReference
+    '='  // mkDirectReference
+    );
+type
+  TOnFindUnit = function(Sender: TPasResolver; const aUnitName: String): TPasModule of object;
+
+  { TTestEnginePasResolver }
+
+  TTestEnginePasResolver = class(TPasResolver)
+  private
+    FFilename: string;
+    FModule: TPasModule;
+    FOnFindUnit: TOnFindUnit;
+    FParser: TPasParser;
+    FResolver: TStreamResolver;
+    FScanner: TPascalScanner;
+    FSource: string;
+    procedure SetModule(AValue: TPasModule);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function FindModule(const AName: String): TPasModule; override;
+    property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
+    property Filename: string read FFilename write FFilename;
+    property Resolver: TStreamResolver read FResolver write FResolver;
+    property Scanner: TPascalScanner read FScanner write FScanner;
+    property Parser: TPasParser read FParser write FParser;
+    property Source: string read FSource write FSource;
+    property Module: TPasModule read FModule write SetModule;
+  end;
+
+  { TTestResolverMessage }
+
+  TTestResolverMessage = class
+  public
+    Id: int64;
+    MsgType: TMessageType;
+    MsgNumber: integer;
+    Msg: string;
+  end;
+
+  TTestResolverReferenceData = record
+    Filename: string;
+    Row: integer;
+    StartCol: integer;
+    EndCol: integer;
+    Found: TFPList; // list of TPasElement at this token
+  end;
+  PTestResolverReferenceData = ^TTestResolverReferenceData;
+
+  TSystemUnitPart = (
+    supTObject
+    );
+  TSystemUnitParts = set of TSystemUnitPart;
+
+  { TCustomTestResolver }
+
+  TCustomTestResolver = Class(TTestParser)
+  Private
+    FFirstStatement: TPasImplBlock;
+    FModules: TObjectList;// list of TTestEnginePasResolver
+    FResolverEngine: TTestEnginePasResolver;
+    FResolverMsgs: TObjectList; // list of TTestResolverMessage
+    FResolverGoodMsgs: TFPList; // list of TTestResolverMessage marked as expected
+    function GetModuleCount: integer;
+    function GetModules(Index: integer): TTestEnginePasResolver;
+    function GetMsgCount: integer;
+    function GetMsgs(Index: integer): TTestResolverMessage;
+    function OnPasResolverFindUnit(SrcResolver: TPasResolver;
+      const aUnitName: String): TPasModule;
+    procedure OnFindReference(El: TPasElement; FindData: pointer);
+    procedure OnCheckElementParent(El: TPasElement; arg: pointer);
+    procedure FreeSrcMarkers;
+    procedure OnPasResolverLog(Sender: TObject; const Msg: String);
+  Protected
+    FirstSrcMarker, LastSrcMarker: PSrcMarker;
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure CreateEngine(var TheEngine: TPasTreeContainer); override;
+    procedure ParseProgram; virtual;
+    procedure ParseUnit; virtual;
+    procedure CheckReferenceDirectives; virtual;
+    procedure CheckResolverHint(MsgType: TMessageType; MsgNumber: integer; Msg: string); virtual;
+    procedure CheckResolverUnexpectedHints; virtual;
+    procedure CheckResolverException(Msg: string; MsgNumber: integer);
+    procedure CheckParserException(Msg: string; MsgNumber: integer);
+    procedure CheckAccessMarkers; 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
+    function FindSrcLabel(const Identifier: string): PSrcMarker;
+    function FindElementsAtSrcLabel(const Identifier: string; ErrorOnNoElements: boolean = true): TFPList;// list of TPasElement
+    procedure WriteSources(const aFilename: string; aRow, aCol: integer);
+    procedure RaiseErrorAtSrc(Msg: string; const aFilename: string; aRow, aCol: integer);
+    procedure RaiseErrorAtSrcMarker(Msg: string; aMarker: PSrcMarker);
+  Public
+    constructor Create; override;
+    destructor Destroy; override;
+    function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver;
+    function AddModule(aFilename: string): TTestEnginePasResolver;
+    function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver;
+    function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+      ImplementationSrc: string): TTestEnginePasResolver;
+    procedure AddSystemUnit(Parts: TSystemUnitParts = []);
+    procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
+    procedure StartUnit(NeedSystemUnit: boolean);
+    property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
+    property ModuleCount: integer read GetModuleCount;
+    property ResolverEngine: TTestEnginePasResolver read FResolverEngine;
+    property MsgCount: integer read GetMsgCount;
+    property Msgs[Index: integer]: TTestResolverMessage read GetMsgs;
+  end;
+
+  { TTestResolver }
+
+  TTestResolver = Class(TCustomTestResolver)
+  Published
+    Procedure TestEmpty;
+
+    // alias
+    Procedure TestAliasType;
+    Procedure TestAlias2Type;
+    Procedure TestAliasTypeRefs;
+    Procedure TestAliasOfVarFail;
+    Procedure TestAliasType_UnitPrefix;
+    Procedure TestAliasType_UnitPrefix_CycleFail;
+    Procedure TestAliasTypeNotFoundPosition;
+    Procedure TestTypeAliasType; // ToDo
+
+    // var, const
+    Procedure TestVarLongint;
+    Procedure TestVarInteger;
+    Procedure TestConstInteger;
+    Procedure TestConstInteger2;
+    Procedure TestDuplicateVar;
+    Procedure TestVarInitConst;
+    Procedure TestVarOfVarFail;
+    Procedure TestConstOfVarFail;
+    Procedure TestTypedConstWrongExprFail;
+    Procedure TestVarWrongExprFail;
+    Procedure TestArgWrongExprFail;
+    Procedure TestVarExternal;
+    Procedure TestVarNoSemicolonBeginFail;
+    Procedure TestIntegerRange;
+    Procedure TestIntegerRangeHighLowerLowFail;
+    Procedure TestIntegerRangeLowHigh;
+    Procedure TestAssignIntRangeFail;
+    Procedure TestByteRangeFail;
+    Procedure TestCustomIntRangeFail;
+    Procedure TestConstIntOperators;
+    // ToDo: TestConstBitwiseOps  3 and not 2, 3 and not longword(2)
+    Procedure TestConstBoolOperators;
+
+    // strings
+    Procedure TestChar_Ord;
+    Procedure TestChar_Chr;
+    Procedure TestString_SetLength;
+    Procedure TestString_Element;
+    Procedure TestStringElement_MissingArgFail;
+    Procedure TestStringElement_IndexNonIntFail;
+    Procedure TestStringElement_AsVarArgFail;
+    Procedure TestString_DoubleQuotesFail;
+    Procedure TestString_ShortstringType;
+    Procedure TestConstStringOperators;
+
+    // enums
+    Procedure TestEnums;
+    Procedure TestEnumRangeFail; // ToDo
+    Procedure TestSets;
+    Procedure TestSetOperators;
+    Procedure TestEnumParams;
+    Procedure TestSetParams;
+    Procedure TestSetFunctions;
+    Procedure TestEnumHighLow;
+    Procedure TestEnumOrd;
+    Procedure TestEnumPredSucc;
+    Procedure TestEnum_EqualNilFail;
+    Procedure TestEnum_CastIntegerToEnum;
+    Procedure TestEnum_Str;
+    Procedure TestSetConstRange;
+    Procedure TestSet_AnonymousEnumtype;
+    Procedure TestSet_AnonymousEnumtypeName;
+    Procedure TestSet_Const; // ToDo
+
+    // operators
+    Procedure TestPrgAssignment;
+    Procedure TestPrgProcVar;
+    Procedure TestUnitProcVar;
+    Procedure TestAssignIntegers;
+    Procedure TestAssignString;
+    Procedure TestAssignIntToStringFail;
+    Procedure TestAssignStringToIntFail;
+    Procedure TestIntegerOperators;
+    Procedure TestBooleanOperators;
+    Procedure TestStringOperators;
+    Procedure TestFloatOperators;
+    Procedure TestCAssignments;
+    Procedure TestTypeCastBaseTypes;
+    Procedure TestTypeCastAliasBaseTypes;
+    Procedure TestTypeCastStrToIntFail;
+    Procedure TestTypeCastStrToCharFail;
+    Procedure TestTypeCastIntToStrFail;
+    Procedure TestTypeCastDoubleToStrFail;
+    Procedure TestTypeCastDoubleToIntFail;
+    Procedure TestTypeCastDoubleToBoolFail;
+    Procedure TestTypeCastBooleanToDoubleFail;
+    Procedure TestAssign_Access;
+    Procedure TestAssignedIntFail;
+
+    // misc built-in functions
+    Procedure TestHighLow;
+    Procedure TestStr_BaseTypes;
+    Procedure TestStr_StringFail;
+    Procedure TestStr_CharFail;
+    Procedure TestIncDec;
+    Procedure TestIncStringFail;
+    Procedure TestTypeInfo;
+
+    // statements
+    Procedure TestForLoop;
+    Procedure TestStatements;
+    Procedure TestCaseStatement;
+    Procedure TestTryStatement;
+    Procedure TestTryExceptOnNonTypeFail;
+    Procedure TestTryExceptOnNonClassFail;
+    Procedure TestRaiseNonVarFail;
+    Procedure TestRaiseNonClassFail;
+    Procedure TestRaiseDescendant;
+    Procedure TestStatementsRefs;
+    Procedure TestRepeatUntilNonBoolFail;
+    Procedure TestWhileDoNonBoolFail;
+    Procedure TestIfThenNonBoolFail;
+    Procedure TestForLoopVarNonVarFail;
+    Procedure TestForLoopStartIncompFail;
+    Procedure TestForLoopEndIncompFail;
+    Procedure TestCaseOf;
+    Procedure TestCaseExprNonOrdFail;
+    Procedure TestCaseIncompatibleValueFail;
+    Procedure TestSimpleStatement_VarFail;
+
+    // units
+    Procedure TestUnitOverloads;
+    Procedure TestUnitIntfInitialization;
+    Procedure TestUnitUseIntf;
+    Procedure TestUnitUseImplFail;
+    Procedure TestUnit_DuplicateUsesFail;
+    Procedure TestUnit_NestedFail;
+    Procedure TestUnitUseDotted;
+    Procedure TestUnit_ProgramDefaultNamespace;
+    Procedure TestUnit_DottedIdentifier;
+    Procedure TestUnit_DottedPrg;
+    Procedure TestUnit_DottedUnit;
+    Procedure TestUnit_DottedExpr;
+    Procedure TestUnit_DuplicateDottedUsesFail;
+    Procedure TestUnit_DuplicateUsesDiffNameFail;
+    Procedure TestUnit_Unit1DotUnit2Fail;
+    Procedure TestUnit_InFilename; // ToDo
+
+    // procs
+    Procedure TestProcParam;
+    Procedure TestProcParamAccess;
+    Procedure TestFunctionResult;
+    Procedure TestProcedureResultFail;
+    Procedure TestProcOverload;
+    Procedure TestProcOverloadWithBaseTypes;
+    Procedure TestProcOverloadWithBaseTypes2;
+    Procedure TestProcOverloadNearestHigherPrecision;
+    Procedure TestProcCallLowPrecision;
+    Procedure TestProcOverloadMultiLowPrecisionFail;
+    Procedure TestProcOverloadWithClassTypes;
+    Procedure TestProcOverloadWithInhClassTypes;
+    Procedure TestProcOverloadWithInhAliasClassTypes;
+    Procedure TestProcOverloadBaseTypeOtherUnit;
+    Procedure TestProcDuplicate;
+    Procedure TestNestedProc;
+    Procedure TestForwardProc;
+    Procedure TestForwardProcUnresolved;
+    Procedure TestNestedForwardProc;
+    Procedure TestNestedForwardProcUnresolved;
+    Procedure TestForwardProcFuncMismatch;
+    Procedure TestForwardFuncResultMismatch;
+    Procedure TestUnitIntfProc;
+    Procedure TestUnitIntfProcUnresolved;
+    Procedure TestUnitIntfMismatchArgName;
+    Procedure TestProcOverloadIsNotFunc;
+    Procedure TestProcCallMissingParams;
+    Procedure TestProcArgDefaultValue;
+    Procedure TestProcArgDefaultValueTypeMismatch;
+    Procedure TestProcPassConstToVar;
+    Procedure TestBuiltInProcCallMissingParams;
+    Procedure TestAssignFunctionResult;
+    Procedure TestAssignProcResultFail;
+    Procedure TestFunctionResultInCondition;
+    Procedure TestExit;
+    Procedure TestBreak;
+    Procedure TestContinue;
+    Procedure TestProcedureExternal;
+    Procedure TestProc_UntypedParam_Forward;
+    Procedure TestProc_Varargs;
+    Procedure TestProc_ParameterExprAccess;
+    Procedure TestProc_FunctionResult_DeclProc;
+    Procedure TestProc_TypeCastFunctionResult;
+    // ToDo: fail builtin functions in constant with non const param
+
+    // record
+    Procedure TestRecord;
+    Procedure TestRecordVariant;
+    Procedure TestRecordVariantNested;
+    Procedure TestRecord_WriteConstParamFail;
+    Procedure TestRecord_WriteConstParam_WithFail;
+    Procedure TestRecord_WriteNestedConstParamFail;
+    Procedure TestRecord_WriteNestedConstParamWithFail;
+    Procedure TestRecord_TypeCast;
+
+    // class
+    Procedure TestClass;
+    Procedure TestClassDefaultInheritance;
+    Procedure TestClassTripleInheritance;
+    Procedure TestClassInheritanceCycleFail;
+    Procedure TestClassForward;
+    Procedure TestClassForwardAsAncestorFail;
+    Procedure TestClassForwardNotResolved;
+    Procedure TestClass_Method;
+    Procedure TestClass_ConstructorMissingDotFail;
+    Procedure TestClass_MethodWithoutClassFail;
+    Procedure TestClass_MethodWithParams;
+    Procedure TestClass_MethodUnresolvedPrg;
+    Procedure TestClass_MethodUnresolvedUnit;
+    Procedure TestClass_MethodAbstract;
+    Procedure TestClass_MethodAbstractWithoutVirtualFail;
+    Procedure TestClass_MethodAbstractHasBodyFail;
+    Procedure TestClass_MethodUnresolvedWithAncestor;
+    Procedure TestClass_ProcFuncMismatch;
+    Procedure TestClass_MethodOverload;
+    Procedure TestClass_MethodInvalidOverload;
+    Procedure TestClass_MethodOverride;
+    Procedure TestClass_MethodOverride2;
+    Procedure TestClass_MethodOverrideFixCase;
+    Procedure TestClass_MethodOverrideSameResultType;
+    Procedure TestClass_MethodOverrideDiffResultTypeFail;
+    Procedure TestClass_MethodOverloadAncestor;
+    Procedure TestClass_MethodOverloadArrayOfTClass;
+    Procedure TestClass_MethodScope;
+    Procedure TestClass_IdentifierSelf;
+    Procedure TestClassCallInherited;
+    Procedure TestClassCallInheritedNoParamsAbstractFail;
+    Procedure TestClassCallInheritedWithParamsAbstractFail;
+    Procedure TestClassCallInheritedConstructor;
+    Procedure TestClassCallInheritedNested;
+    Procedure TestClassAssignNil;
+    Procedure TestClassAssign;
+    Procedure TestClassNilAsParam;
+    Procedure TestClass_Operators_Is_As;
+    Procedure TestClass_OperatorIsOnNonTypeFail;
+    Procedure TestClass_OperatorAsOnNonDescendantFail;
+    Procedure TestClass_OperatorAsOnNonTypeFail;
+    Procedure TestClassAsFuncResult;
+    Procedure TestClassTypeCast;
+    Procedure TestClassTypeCastUnrelatedFail;
+    Procedure TestClass_TypeCastSelf;
+    Procedure TestClass_TypeCaseMultipleParamsFail;
+    Procedure TestClass_TypeCastAssign;
+    Procedure TestClass_AccessMemberViaClassFail;
+    Procedure TestClass_FuncReturningObjectMember;
+    Procedure TestClass_StaticWithoutClassFail;
+    Procedure TestClass_SelfInStaticFail;
+    Procedure TestClass_PrivateProtectedInSameUnit;
+    Procedure TestClass_PrivateInMainBeginFail;
+    Procedure TestClass_PrivateInDescendantFail;
+    Procedure TestClass_ProtectedInDescendant;
+    Procedure TestClass_StrictPrivateInMainBeginFail;
+    Procedure TestClass_StrictProtectedInMainBeginFail;
+    Procedure TestClass_Constructor_NewInstance;
+    Procedure TestClass_Constructor_InstanceCallResultFail;
+    Procedure TestClass_Destructor_FreeInstance;
+    Procedure TestClass_ConDestructor_CallInherited;
+    Procedure TestClass_Constructor_Inherited;
+    Procedure TestClass_SubObject;
+    Procedure TestClass_WithClassInstance;
+    Procedure TestClass_ProcedureExternal;
+    Procedure TestClass_ReintroducePublicVarFail;
+    Procedure TestClass_ReintroducePrivateVar;
+    Procedure TestClass_ReintroduceProc;
+    Procedure TestClass_UntypedParam_TypeCast;
+    Procedure TestClass_Sealed;
+    Procedure TestClass_SealedDescendFail;
+    Procedure TestClass_VarExternal;
+    Procedure TestClass_WarnOverrideLowerVisibility;
+    Procedure TestClass_Const;
+    // Todo: Fail to use class.method in constant or type, e.g. const p = @o.doit;
+
+    // published
+    Procedure TestClass_PublishedClassVarFail;
+    Procedure TestClass_PublishedClassPropertyFail;
+    Procedure TestClass_PublishedClassFunctionFail;
+    Procedure TestClass_PublishedOverloadFail;
+
+    // external class
+    Procedure TestExternalClass;
+    Procedure TestExternalClass_Descendant;
+
+    // class of
+    Procedure TestClassOf;
+    Procedure TestClassOfNonClassFail;
+    Procedure TestClassOfIsOperatorFail;
+    Procedure TestClassOfAsOperatorFail;
+    Procedure TestClassOfIsOperator;
+    Procedure TestClass_ClassVar;
+    Procedure TestClassOfDotClassVar;
+    Procedure TestClassOfDotVarFail;
+    Procedure TestClassOfDotClassProc;
+    Procedure TestClassOfDotProcFail;
+    Procedure TestClassOfDotClassProperty;
+    Procedure TestClassOfDotPropertyFail;
+    Procedure TestClass_ClassProcSelf;
+    Procedure TestClass_ClassProcSelfTypeCastFail;
+    Procedure TestClass_ClassMembers;
+    Procedure TestClassOf_AsFail;
+    Procedure TestClassOf_MemberAsFail;
+    Procedure TestClassOf_IsFail;
+    Procedure TestClass_TypeCast;
+    Procedure TestClassOf_AlwaysForward;
+    Procedure TestClassOf_ClassOfBeforeClass_FuncResult;
+
+    // property
+    Procedure TestProperty1;
+    Procedure TestPropertyAccessorNotInFront;
+    Procedure TestPropertyReadAccessorVarWrongType;
+    Procedure TestPropertyReadAccessorProcNotFunc;
+    Procedure TestPropertyReadAccessorFuncWrongResult;
+    Procedure TestPropertyReadAccessorFuncWrongArgCount;
+    Procedure TestPropertyReadAccessorFunc;
+    // ToDo: read accessor allow ancestor of field
+    Procedure TestPropertyWriteAccessorVarWrongType;
+    Procedure TestPropertyWriteAccessorFuncNotProc;
+    Procedure TestPropertyWriteAccessorProcWrongArgCount;
+    Procedure TestPropertyWriteAccessorProcWrongArg;
+    Procedure TestPropertyWriteAccessorProcWrongArgType;
+    Procedure TestPropertyWriteAccessorProc;
+    Procedure TestPropertyTypeless;
+    Procedure TestPropertyTypelessNoAncestorFail;
+    Procedure TestPropertyStoredAccessor;
+    Procedure TestPropertyStoredAccessorVarWrongType;
+    Procedure TestPropertyStoredAccessorProcNotFunc;
+    Procedure TestPropertyStoredAccessorFuncWrongResult;
+    Procedure TestPropertyStoredAccessorFuncWrongArgCount;
+    Procedure TestPropertyAssign;
+    Procedure TestPropertyAssignReadOnlyFail;
+    Procedure TestProperty_PassAsParam;
+    Procedure TestPropertyReadNonReadableFail;
+    Procedure TestPropertyArgs1;
+    Procedure TestPropertyArgs2;
+    Procedure TestPropertyArgsWithDefaultsFail;
+    Procedure TestProperty_Index;
+    Procedure TestProperty_WrongTypeAsIndexFail;
+    Procedure TestProperty_Option_ClassPropertyNonStatic;
+    Procedure TestDefaultProperty;
+    Procedure TestMissingDefaultProperty;
+
+    // with
+    Procedure TestWithBlock1;
+    Procedure TestWithBlock2;
+    Procedure TestWithBlockFuncResult;
+    Procedure TestWithBlockConstructor;
+
+    // arrays
+    Procedure TestDynArrayOfLongint;
+    Procedure TestStaticArray;
+    Procedure TestArrayOfArray;
+    Procedure TestArrayOfArray_NameAnonymous;
+    Procedure TestFunctionReturningArray;
+    Procedure TestArray_LowHigh;
+    Procedure TestArray_AssignSameSignatureFail;
+    Procedure TestArray_Assigned;
+    Procedure TestPropertyOfTypeArray;
+    Procedure TestArrayElementFromFuncResult_AsParams;
+    Procedure TestArrayEnumTypeRange;
+    Procedure TestArrayEnumTypeConstNotEnoughValuesFail1;
+    Procedure TestArrayEnumTypeConstNotEnoughValuesFail2;
+    Procedure TestArrayEnumTypeConstWrongTypeFail;
+    Procedure TestArrayEnumTypeConstNonConstFail;
+    Procedure TestArrayEnumTypeSetLengthFail;
+    Procedure TestArray_DynArrayConst;
+    Procedure TestArray_AssignNilToStaticArrayFail1;
+    Procedure TestArray_SetLengthProperty;
+    Procedure TestArray_PassArrayElementToVarParam;
+    Procedure TestArray_OpenArrayOfString;
+    Procedure TestArray_OpenArrayOfString_IntFail;
+    Procedure TestArray_OpenArrayOverride;
+    Procedure TestArray_CopyConcat;
+    Procedure TestArray_CopyMismatchFail;
+    Procedure TestArray_InsertDelete;
+    Procedure TestArray_InsertItemMismatchFail;
+    Procedure TestArray_TypeCast;
+    Procedure TestArray_TypeCastWrongElTypeFail;
+    Procedure TestArray_ConstDynArrayWrite;
+    Procedure TestArray_ConstOpenArrayWriteFail;
+
+    // static arrays
+    Procedure TestArrayIntRange_OutOfRange;
+    Procedure TestArrayEnumRange_OutOfRange;
+    Procedure TestArrayCharRange_OutOfRange;
+
+    // procedure types
+    Procedure TestProcTypesAssignObjFPC;
+    Procedure TestMethodTypesAssignObjFPC;
+    Procedure TestProcTypeCall;
+    Procedure TestProcType_FunctionFPC;
+    Procedure TestProcType_FunctionDelphi;
+    Procedure TestProcType_MethodFPC;
+    Procedure TestProcType_MethodDelphi;
+    Procedure TestAssignProcToMethodFail;
+    Procedure TestAssignMethodToProcFail;
+    Procedure TestAssignProcToFunctionFail;
+    Procedure TestAssignProcWrongArgsFail;
+    Procedure TestAssignProcWrongArgAccessFail;
+    Procedure TestProcType_AssignNestedProcFail;
+    Procedure TestArrayOfProc;
+    Procedure TestProcType_Assigned;
+    Procedure TestProcType_TNotifyEvent;
+    Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail1;
+    Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail2;
+    Procedure TestProcType_TNotifyEvent_NoAtFPC_Fail3;
+    Procedure TestProcType_WhileListCompare;
+    Procedure TestProcType_IsNested;
+    Procedure TestProcType_IsNested_AssignProcFail;
+    Procedure TestProcType_ReferenceTo;
+    Procedure TestProcType_AllowNested;
+    Procedure TestProcType_AllowNestedOfObject;
+    Procedure TestProcType_AsArgOtherUnit;
+    Procedure TestProcType_Property;
+    Procedure TestProcType_PropertyCallWrongArgFail;
+    Procedure TestProcType_Typecast;
+    Procedure TestProcType_InsideFunction;
+    Procedure TestProcType_PassProcToUntyped;
+
+    // pointer
+    Procedure TestPointer;
+    Procedure TestPointer_AssignPointerToClassFail;
+    Procedure TestPointer_TypecastToMethodTypeFail;
+    Procedure TestPointer_TypecastFromMethodTypeFail;
+    Procedure TestPointer_TypecastMethod_proMethodAddrAsPointer;
+    Procedure TestPointer_OverloadSignature;
+
+    // hints
+    Procedure TestHint_ElementHints;
+    Procedure TestHint_ElementHintsMsg;
+  end;
+
+function LinesToStr(Args: array of const): string;
+
+implementation
+
+function LinesToStr(Args: array of const): string;
+var
+  s: String;
+  i: Integer;
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+    case Args[i].VType of
+      vtChar:         s += Args[i].VChar+LineEnding;
+      vtString:       s += Args[i].VString^+LineEnding;
+      vtPChar:        s += Args[i].VPChar+LineEnding;
+      vtWideChar:     s += AnsiString(Args[i].VWideChar)+LineEnding;
+      vtPWideChar:    s += AnsiString(Args[i].VPWideChar)+LineEnding;
+      vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding;
+      vtWidestring:   s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
+      vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
+    end;
+  Result:=s;
+end;
+
+{ TTestEnginePasResolver }
+
+procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
+begin
+  if FModule=AValue then Exit;
+  if Module<>nil then
+    Module.Release;
+  FModule:=AValue;
+  if Module<>nil then
+    Module.AddRef;
+end;
+
+constructor TTestEnginePasResolver.Create;
+begin
+  inherited Create;
+  StoreSrcColumns:=true;
+end;
+
+destructor TTestEnginePasResolver.Destroy;
+begin
+  FResolver:=nil;
+  Module:=nil;
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  inherited Destroy;
+end;
+
+function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
+begin
+  Result:=nil;
+  if Assigned(OnFindUnit) then
+    Result:=OnFindUnit(Self,AName);
+end;
+
+{ TCustomTestResolver }
+
+procedure TCustomTestResolver.SetUp;
+begin
+  FirstSrcMarker:=nil;
+  LastSrcMarker:=nil;
+  FModules:=TObjectList.Create(true);
+  inherited SetUp;
+  Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
+end;
+
+procedure TCustomTestResolver.TearDown;
+begin
+  FResolverMsgs.Clear;
+  FResolverGoodMsgs.Clear;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestResolver.TearDown START FreeSrcMarkers');
+  {$ENDIF}
+  FreeSrcMarkers;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestResolver.TearDown ResolverEngine.Clear');
+  {$ENDIF}
+  ResolverEngine.Clear;
+  if FModules<>nil then
+    begin
+    {$IFDEF VerbosePasResolverMem}
+    writeln('TTestResolver.TearDown FModules');
+    {$ENDIF}
+    FModules.OwnsObjects:=false;
+    FModules.Remove(ResolverEngine); // remove reference
+    FModules.OwnsObjects:=true;
+    FreeAndNil(FModules);// free all other modules
+    end;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestResolver.TearDown inherited');
+  {$ENDIF}
+  inherited TearDown;
+  FResolverEngine:=nil;
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TTestResolver.TearDown END');
+  {$ENDIF}
+end;
+
+procedure TCustomTestResolver.CreateEngine(var TheEngine: TPasTreeContainer);
+begin
+  FResolverEngine:=AddModule(MainFilename);
+  TheEngine:=ResolverEngine;
+end;
+
+procedure TCustomTestResolver.ParseProgram;
+var
+  aFilename: String;
+  aRow, aCol: Integer;
+begin
+  FFirstStatement:=nil;
+  try
+    ParseModule;
+  except
+    on E: EParserError do
+      begin
+      aFilename:=E.Filename;
+      aRow:=E.Row;
+      aCol:=E.Column;
+      WriteSources(aFilename,aRow,aCol);
+      writeln('ERROR: TTestResolver.ParseProgram Parser: '+E.ClassName+':'+E.Message
+        +' Scanner at'
+        +' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')'
+        +' Line="'+Scanner.CurLine+'"');
+      Fail(E.Message);
+      end;
+    on E: EPasResolve do
+      begin
+      aFilename:=Scanner.CurFilename;
+      aRow:=Scanner.CurRow;
+      aCol:=Scanner.CurColumn;
+      if E.PasElement<>nil then
+        begin
+        aFilename:=E.PasElement.SourceFilename;
+        ResolverEngine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,aRow,aCol);
+        end;
+      WriteSources(aFilename,aRow,aCol);
+      writeln('ERROR: TTestResolver.ParseProgram PasResolver: '+E.ClassName+':'+E.Message
+        +' at '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+')');
+      Fail(E.Message);
+      end;
+    on E: Exception do
+      begin
+      writeln('ERROR: TTestResolver.ParseProgram Exception: '+E.ClassName+':'+E.Message);
+      Fail(E.Message);
+      end;
+  end;
+  TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
+  AssertEquals('Has program',TPasProgram,Module.ClassType);
+  AssertNotNull('Has program section',PasProgram.ProgramSection);
+  AssertNotNull('Has initialization section',PasProgram.InitializationSection);
+  if (PasProgram.InitializationSection.Elements.Count>0) then
+    if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
+      FFirstStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
+  CheckReferenceDirectives;
+end;
+
+procedure TCustomTestResolver.ParseUnit;
+begin
+  FFirstStatement:=nil;
+  try
+    ParseModule;
+  except
+    on E: EParserError do
+      begin
+      writeln('ERROR: TTestResolver.ParseUnit Parser: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      Fail(E.Message);
+      end;
+    on E: EPasResolve do
+      begin
+      writeln('ERROR: TTestResolver.ParseUnit PasResolver: '+E.ClassName+':'+E.Message
+        +' File='+Scanner.CurFilename
+        +' LineNo='+IntToStr(Scanner.CurRow)
+        +' Col='+IntToStr(Scanner.CurColumn)
+        +' Line="'+Scanner.CurLine+'"'
+        );
+      Fail(E.Message);
+      end;
+    on E: Exception do
+      begin
+      writeln('ERROR: TTestResolver.ParseUnit Exception: '+E.ClassName+':'+E.Message);
+      Fail(E.Message);
+      end;
+  end;
+  TAssert.AssertSame('Has resolver',ResolverEngine,Parser.Engine);
+  AssertEquals('Has unit',TPasModule,Module.ClassType);
+  AssertNotNull('Has interface section',Module.InterfaceSection);
+  AssertNotNull('Has implementation section',Module.ImplementationSection);
+  if (Module.InitializationSection<>nil)
+  and (Module.InitializationSection.Elements.Count>0) then
+    if TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock then
+      FFirstStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
+  CheckReferenceDirectives;
+end;
+
+procedure TCustomTestResolver.CheckReferenceDirectives;
+var
+  Filename: string;
+  LineNumber: Integer;
+  SrcLine: String;
+  CommentStartP, CommentEndP: PChar;
+
+  procedure RaiseError(Msg: string; p: PChar);
+  begin
+    RaiseErrorAtSrc(Msg,Filename,LineNumber,p-PChar(SrcLine)+1);
+  end;
+
+  procedure AddMarker(Marker: PSrcMarker);
+  begin
+    if LastSrcMarker<>nil then
+      LastSrcMarker^.Next:=Marker
+    else
+      FirstSrcMarker:=Marker;
+    LastSrcMarker:=Marker;
+  end;
+
+  function AddMarker(Kind: TSrcMarkerKind; const aFilename: string;
+    aLine, aStartCol, aEndCol: integer; const Identifier: string): PSrcMarker;
+  begin
+    New(Result);
+    Result^.Kind:=Kind;
+    Result^.Filename:=aFilename;
+    Result^.Row:=aLine;
+    Result^.StartCol:=aStartCol;
+    Result^.EndCol:=aEndCol;
+    Result^.Identifier:=Identifier;
+    Result^.Next:=nil;
+    //writeln('AddMarker Line="',SrcLine,'" Identifier=',Identifier,' Col=',aStartCol,'-',aEndCol,' "',copy(SrcLine,aStartCol,aEndCol-aStartCol),'"');
+    AddMarker(Result);
+  end;
+
+  function AddMarkerForTokenBehindComment(Kind: TSrcMarkerKind;
+    const Identifier: string): PSrcMarker;
+  var
+    TokenStart, p: PChar;
+  begin
+    p:=CommentEndP;
+    ReadNextPascalToken(p,TokenStart,false,false);
+    Result:=AddMarker(Kind,Filename,LineNumber,
+      CommentEndP-PChar(SrcLine)+1,p-PChar(SrcLine)+1,Identifier);
+  end;
+
+  function ReadIdentifier(var p: PChar): string;
+  var
+    StartP: PChar;
+  begin
+    if not (p^ in ['a'..'z','A'..'Z','_']) then
+      RaiseError('identifier expected',p);
+    StartP:=p;
+    inc(p);
+    while p^ in ['a'..'z','A'..'Z','_','0'..'9'] do inc(p);
+    SetLength(Result,p-StartP);
+    Move(StartP^,Result[1],length(Result));
+  end;
+
+  procedure AddLabel;
+  var
+    Identifier: String;
+    p: PChar;
+  begin
+    p:=CommentStartP+2;
+    Identifier:=ReadIdentifier(p);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddLabel ',Identifier);
+    if FindSrcLabel(Identifier)<>nil then
+      RaiseError('duplicate label "'+Identifier+'"',p);
+    AddMarkerForTokenBehindComment(mkLabel,Identifier);
+  end;
+
+  procedure AddResolverReference;
+  var
+    Identifier: String;
+    p: PChar;
+  begin
+    p:=CommentStartP+2;
+    Identifier:=ReadIdentifier(p);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddReference ',Identifier);
+    AddMarkerForTokenBehindComment(mkResolverReference,Identifier);
+  end;
+
+  procedure AddDirectReference;
+  var
+    Identifier: String;
+    p: PChar;
+  begin
+    p:=CommentStartP+2;
+    Identifier:=ReadIdentifier(p);
+    //writeln('TTestResolver.CheckReferenceDirectives.AddDirectReference ',Identifier);
+    AddMarkerForTokenBehindComment(mkDirectReference,Identifier);
+  end;
+
+  procedure ParseCode(SrcLines: TStringList; aFilename: string);
+  var
+    p: PChar;
+    IsDirective: Boolean;
+  begin
+    //writeln('TTestResolver.CheckReferenceDirectives.ParseCode File=',aFilename);
+    Filename:=aFilename;
+    // parse code, find all labels
+    LineNumber:=0;
+    while LineNumber<SrcLines.Count do
+      begin
+      inc(LineNumber);
+      SrcLine:=SrcLines[LineNumber-1];
+      if SrcLine='' then continue;
+      //writeln('TTestResolver.CheckReferenceDirectives Line=',SrcLine);
+      p:=PChar(SrcLine);
+      repeat
+        case p^ of
+          #0: if (p-PChar(SrcLine)=length(SrcLine)) then break;
+          '{':
+            begin
+            CommentStartP:=p;
+            inc(p);
+            IsDirective:=p^ in ['#','@','='];
+
+            // skip to end of comment
+            repeat
+              case p^ of
+              #0:
+                if (p-PChar(SrcLine)=length(SrcLine)) then
+                  begin
+                  // multi line comment
+                  if IsDirective then
+                    RaiseError('directive missing closing bracket',CommentStartP);
+                  repeat
+                    inc(LineNumber);
+                    if LineNumber>SrcLines.Count then exit;
+                    SrcLine:=SrcLines[LineNumber-1];
+                    //writeln('TTestResolver.CheckReferenceDirectives Comment Line=',SrcLine);
+                  until SrcLine<>'';
+                  p:=PChar(SrcLine);
+                  continue;
+                  end;
+              '}':
+                begin
+                inc(p);
+                break;
+                end;
+              end;
+              inc(p);
+            until false;
+
+            CommentEndP:=p;
+            case CommentStartP[1] of
+            '#': AddLabel;
+            '@': AddResolverReference;
+            '=': AddDirectReference;
+            end;
+            p:=CommentEndP;
+            continue;
+
+            end;
+          '/':
+            if p[1]='/' then
+              break; // rest of line is comment -> skip
+        end;
+        inc(p);
+      until false;
+      end;
+  end;
+
+  procedure CheckResolverReference(aMarker: PSrcMarker);
+  // check if one element at {@a} has a TResolvedReference to an element labeled {#a}
+  var
+    aLabel: PSrcMarker;
+    ReferenceElements, LabelElements: TFPList;
+    i, j, aLine, aCol: Integer;
+    El, Ref, LabelEl: TPasElement;
+  begin
+    //writeln('CheckResolverReference searching reference: ',aMarker^.Filename,' Line=',aMarker^.Row,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
+    aLabel:=FindSrcLabel(aMarker^.Identifier);
+    if aLabel=nil then
+      RaiseErrorAtSrc('label "'+aMarker^.Identifier+'" not found',aMarker^.Filename,aMarker^.Row,aMarker^.StartCol);
+
+    LabelElements:=nil;
+    ReferenceElements:=nil;
+    try
+      LabelElements:=FindElementsAt(aLabel);
+      ReferenceElements:=FindElementsAt(aMarker);
+
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        Ref:=nil;
+        if El.CustomData is TResolvedReference then
+          Ref:=TResolvedReference(El.CustomData).Declaration
+        else if El.CustomData is TPasPropertyScope then
+          Ref:=TPasPropertyScope(El.CustomData).AncestorProp;
+        if Ref<>nil then
+          for j:=0 to LabelElements.Count-1 do
+            begin
+            LabelEl:=TPasElement(LabelElements[j]);
+            if Ref=LabelEl then
+              exit; // success
+            end;
+        end;
+
+      // failure write candidates
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')');
+        write(' El=',GetObjName(El));
+        Ref:=nil;
+        if El.CustomData is TResolvedReference then
+          Ref:=TResolvedReference(El.CustomData).Declaration
+        else if El.CustomData is TPasPropertyScope then
+          Ref:=TPasPropertyScope(El.CustomData).AncestorProp;
+        if Ref<>nil then
+          begin
+          write(' Decl=',GetObjName(Ref));
+          ResolverEngine.UnmangleSourceLineNumber(Ref.SourceLinenumber,aLine,aCol);
+          write(',',Ref.SourceFilename,'(',aLine,',',aCol,')');
+          end
+        else
+          write(' has no TResolvedReference');
+        writeln;
+        end;
+      for i:=0 to LabelElements.Count-1 do
+        begin
+        El:=TPasElement(LabelElements[i]);
+        write('Label candidate for "',aLabel^.Identifier,'" at reference ',aLabel^.Filename,'(',aLabel^.Row,',',aLabel^.StartCol,'-',aLabel^.EndCol,')');
+        write(' El=',GetObjName(El));
+        writeln;
+        end;
+
+      RaiseErrorAtSrcMarker('wrong resolved reference "'+aMarker^.Identifier+'"',aMarker);
+    finally
+      LabelElements.Free;
+      ReferenceElements.Free;
+    end;
+  end;
+
+  procedure CheckDirectReference(aMarker: PSrcMarker);
+  // check if one element at {=a} is a TPasAliasType pointing to an element labeled {#a}
+  var
+    aLabel: PSrcMarker;
+    ReferenceElements, LabelElements: TFPList;
+    i, LabelLine, LabelCol, j: Integer;
+    El, LabelEl: TPasElement;
+    DeclEl, TypeEl: TPasType;
+  begin
+    //writeln('CheckDirectReference searching pointer: ',aMarker^.Filename,' Line=',aMarker^.Row,' Col=',aMarker^.StartCol,'-',aMarker^.EndCol,' Label="',aMarker^.Identifier,'"');
+    aLabel:=FindSrcLabel(aMarker^.Identifier);
+    if aLabel=nil then
+      RaiseErrorAtSrcMarker('label "'+aMarker^.Identifier+'" not found',aMarker);
+
+    LabelElements:=nil;
+    ReferenceElements:=nil;
+    try
+      //writeln('CheckDirectReference finding elements at label ...');
+      LabelElements:=FindElementsAt(aLabel);
+      //writeln('CheckDirectReference finding elements at reference ...');
+      ReferenceElements:=FindElementsAt(aMarker);
+
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDesc(El,2));
+        if El.ClassType=TPasVariable then
+          begin
+          if TPasVariable(El).VarType=nil then
+            begin
+            //writeln('CheckDirectReference Var without Type: ',GetObjName(El),' El.Parent=',GetObjName(El.Parent));
+            AssertNotNull('TPasVariable(El='+El.Name+').VarType',TPasVariable(El).VarType);
+            end;
+          TypeEl:=TPasVariable(El).VarType;
+          for j:=0 to LabelElements.Count-1 do
+            begin
+            LabelEl:=TPasElement(LabelElements[j]);
+            if TypeEl=LabelEl then
+              exit; // success
+            end;
+          end
+        else if El is TPasAliasType then
+          begin
+          DeclEl:=TPasAliasType(El).DestType;
+          ResolverEngine.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
+          if (aLabel^.Filename=DeclEl.SourceFilename)
+          and (aLabel^.Row=LabelLine)
+          and (aLabel^.StartCol<=LabelCol)
+          and (aLabel^.EndCol>=LabelCol) then
+            exit; // success
+          end
+        else if El.ClassType=TPasArgument then
+          begin
+          TypeEl:=TPasArgument(El).ArgType;
+          for j:=0 to LabelElements.Count-1 do
+            begin
+            LabelEl:=TPasElement(LabelElements[j]);
+            if TypeEl=LabelEl then
+              exit; // success
+            end;
+          end;
+        end;
+      // failed -> show candidates
+      writeln('CheckDirectReference failed: Labels:');
+      for j:=0 to LabelElements.Count-1 do
+        begin
+        LabelEl:=TPasElement(LabelElements[j]);
+        writeln('  Label ',GetObjName(LabelEl),' at ',ResolverEngine.GetElementSourcePosStr(LabelEl));
+        end;
+      writeln('CheckDirectReference failed: References:');
+      for i:=0 to ReferenceElements.Count-1 do
+        begin
+        El:=TPasElement(ReferenceElements[i]);
+        writeln('  Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El));
+        end;
+      RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
+    finally
+      LabelElements.Free;
+      ReferenceElements.Free;
+    end;
+  end;
+
+var
+  aMarker: PSrcMarker;
+  i: Integer;
+  SrcLines: TStringList;
+begin
+  Module.ForEachCall(@OnCheckElementParent,nil);
+  //writeln('TTestResolver.CheckReferenceDirectives find all markers');
+  // find all markers
+  for i:=0 to Resolver.Streams.Count-1 do
+    begin
+    GetSrc(i,SrcLines,Filename);
+    ParseCode(SrcLines,Filename);
+    SrcLines.Free;
+    end;
+
+  //writeln('TTestResolver.CheckReferenceDirectives check references');
+  // check references
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    case aMarker^.Kind of
+    mkResolverReference: CheckResolverReference(aMarker);
+    mkDirectReference: CheckDirectReference(aMarker);
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+  //writeln('TTestResolver.CheckReferenceDirectives COMPLETE');
+end;
+
+procedure TCustomTestResolver.CheckResolverHint(MsgType: TMessageType;
+  MsgNumber: integer; Msg: string);
+var
+  i: Integer;
+  Item: TTestResolverMessage;
+  Expected,Actual: string;
+begin
+  //writeln('TCustomTestResolver.CheckResolverHint MsgCount=',MsgCount);
+  for i:=0 to MsgCount-1 do
+    begin
+    Item:=Msgs[i];
+    if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
+    // found
+    FResolverGoodMsgs.Add(Item);
+    str(Item.MsgType,Actual);
+    str(MsgType,Expected);
+    AssertEquals('MsgType',Expected,Actual);
+    exit;
+    end;
+
+  // needed message missing -> show emitted messages
+  WriteSources('',0,0);
+  for i:=0 to MsgCount-1 do
+    begin
+    Item:=Msgs[i];
+    writeln('TCustomTestResolver.CheckResolverHint ',i,'/',MsgCount,' ',Item.MsgType,' ('+IntToStr(Item.MsgNumber),') {',Item.Msg,'}');
+    end;
+  str(MsgType,Expected);
+  Fail('Missing '+Expected+' ('+IntToStr(MsgNumber)+') '+Msg);
+end;
+
+procedure TCustomTestResolver.CheckResolverUnexpectedHints;
+var
+  i: Integer;
+  s: String;
+  Msg: TTestResolverMessage;
+begin
+  for i:=0 to MsgCount-1 do
+    begin
+    Msg:=Msgs[i];
+    if FResolverGoodMsgs.IndexOf(Msg)>=0 then continue;
+    s:='';
+    str(Msg.MsgType,s);
+    Fail('Unexpected resolver message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.Msg+'}');
+    end;
+end;
+
+procedure TCustomTestResolver.CheckResolverException(Msg: string; MsgNumber: integer);
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EPasResolve do
+      begin
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
+        MsgNumber,E.MsgNumber);
+      if (Msg<>E.Message) and (Msg<>E.MsgPattern) then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'}');
+        {$ENDIF}
+        AssertEquals('Expected message ('+IntToStr(MsgNumber)+')',
+          '{'+Msg+'}','{'+E.Message+'}');
+        end;
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing resolver error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
+procedure TCustomTestResolver.CheckParserException(Msg: string; MsgNumber: integer);
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseModule;
+  except
+    on E: EParserError do
+      begin
+      if (Parser.LastMsg<>Msg) and (Parser.LastMsgPattern<>Msg) then
+        Fail('Expected msg {'+Msg+'}, but got {'+Parser.LastMsg+'} OR pattern {'+Parser.LastMsgPattern+'}');
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+E.Message+'} number',
+        MsgNumber,Parser.LastMsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing parser error '+Msg+' ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
+procedure TCustomTestResolver.CheckAccessMarkers;
+const
+  AccessNames: array[TResolvedRefAccess] of string = (
+    'none',
+    'read',
+    'assign',
+    'readandassign',
+    'var',
+    'out',
+    'paramtest'
+    );
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualAccess, ExpectedAccess: TResolvedRefAccess;
+  i, j: Integer;
+  El, El2: TPasElement;
+  Ref: TResolvedReference;
+  p: SizeInt;
+  AccessPostfix: String;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.CheckAccessMarkers ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    p:=RPos('_',aMarker^.Identifier);
+    if p>1 then
+      begin
+      AccessPostfix:=copy(aMarker^.Identifier,p+1);
+      ExpectedAccess:=High(TResolvedRefAccess);
+      repeat
+        if CompareText(AccessPostfix,AccessNames[ExpectedAccess])=0 then break;
+        if ExpectedAccess=Low(TResolvedRefAccess) then
+          RaiseErrorAtSrcMarker('unknown access postfix of reference at "#'+aMarker^.Identifier+'"',aMarker);
+        ExpectedAccess:=Pred(ExpectedAccess);
+      until false;
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        ActualAccess:=rraNone;
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          //writeln('TTestResolver.CheckAccessMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          if not (El.CustomData is TResolvedReference) then continue;
+          Ref:=TResolvedReference(El.CustomData);
+          if ActualAccess<>rraNone then
+            begin
+            //writeln('TTestResolver.CheckAccessMarkers multiple references at "#'+aMarker^.Identifier+'":');
+            for j:=0 to Elements.Count-1 do
+              begin
+              El2:=TPasElement(Elements[i]);
+              if not (El2.CustomData is TResolvedReference) then continue;
+              //writeln('TTestResolver.CheckAccessMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+              Ref:=TResolvedReference(El.CustomData);
+              //writeln('  ',j,'/',Elements.Count,' Element=',GetObjName(El2),' ',AccessNames[Ref.Access],' Declaration="',El2.GetDeclaration(true),'"');
+              end;
+            RaiseErrorAtSrcMarker('multiple references at "#'+aMarker^.Identifier+'"',aMarker);
+            end;
+          ActualAccess:=Ref.Access;
+          if ActualAccess=rraNone then
+            RaiseErrorAtSrcMarker('missing Access in reference at "#'+aMarker^.Identifier+'"',aMarker);
+          end;
+        if ActualAccess<>ExpectedAccess then
+          RaiseErrorAtSrcMarker('expected "'+AccessNames[ExpectedAccess]+'" at "#'+aMarker^.Identifier+'", but got "'+AccessNames[ActualAccess]+'"',aMarker);
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TCustomTestResolver.GetSrc(Index: integer; out SrcLines: TStringList; out
+  aFilename: string);
+var
+  aStream: TStream;
+begin
+  SrcLines:=TStringList.Create;
+  aStream:=Resolver.Streams.Objects[Index] as TStream;
+  aStream.Position:=0;
+  SrcLines.LoadFromStream(aStream);
+  aFilename:=Resolver.Streams[Index];
+end;
+
+function TCustomTestResolver.FindElementsAt(aFilename: string; aLine, aStartCol,
+  aEndCol: integer): TFPList;
+var
+  ok: Boolean;
+  FoundRefs: TTestResolverReferenceData;
+begin
+  FoundRefs:=Default(TTestResolverReferenceData);
+  FoundRefs.Filename:=aFilename;
+  FoundRefs.Row:=aLine;
+  FoundRefs.StartCol:=aStartCol;
+  FoundRefs.EndCol:=aEndCol;
+  FoundRefs.Found:=TFPList.Create;
+  ok:=false;
+  try
+    Module.ForEachCall(@OnFindReference,@FoundRefs);
+    ok:=true;
+  finally
+    if not ok then
+      FreeAndNil(FoundRefs.Found);
+  end;
+  Result:=FoundRefs.Found;
+  FoundRefs.Found:=nil;
+end;
+
+function TCustomTestResolver.FindElementsAt(aMarker: PSrcMarker;
+  ErrorOnNoElements: boolean): TFPList;
+begin
+  Result:=FindElementsAt(aMarker^.Filename,aMarker^.Row,aMarker^.StartCol,aMarker^.EndCol);
+  if ErrorOnNoElements and ((Result=nil) or (Result.Count=0)) then
+    RaiseErrorAtSrcMarker('marker '+SrcMarker[aMarker^.Kind]+aMarker^.Identifier+' has no elements',aMarker);
+end;
+
+function TCustomTestResolver.FindSrcLabel(const Identifier: string): PSrcMarker;
+begin
+  Result:=FirstSrcMarker;
+  while Result<>nil do
+    begin
+    if (Result^.Kind=mkLabel)
+    and (CompareText(Result^.Identifier,Identifier)=0) then
+      exit;
+    Result:=Result^.Next;
+    end;
+end;
+
+function TCustomTestResolver.FindElementsAtSrcLabel(const Identifier: string;
+  ErrorOnNoElements: boolean): TFPList;
+var
+  SrcLabel: PSrcMarker;
+begin
+  SrcLabel:=FindSrcLabel(Identifier);
+  if SrcLabel=nil then
+    Fail('missing label "'+Identifier+'"');
+  Result:=FindElementsAt(SrcLabel,ErrorOnNoElements);
+end;
+
+procedure TCustomTestResolver.WriteSources(const aFilename: string; aRow,
+  aCol: integer);
+var
+  IsSrc: Boolean;
+  i, j: Integer;
+  SrcLines: TStringList;
+  SrcFilename, Line: string;
+begin
+  for i:=0 to Resolver.Streams.Count-1 do
+    begin
+    GetSrc(i,SrcLines,SrcFilename);
+    IsSrc:=ExtractFilename(SrcFilename)=ExtractFileName(aFilename);
+    writeln('Testcode:-File="',SrcFilename,'"----------------------------------:');
+    for j:=1 to SrcLines.Count do
+      begin
+      Line:=SrcLines[j-1];
+      if IsSrc and (j=aRow) then
+        begin
+        write('*');
+        Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
+        end;
+      writeln(Format('%:4d: ',[j]),Line);
+      end;
+    SrcLines.Free;
+    end;
+end;
+
+procedure TCustomTestResolver.RaiseErrorAtSrc(Msg: string; const aFilename: string;
+  aRow, aCol: integer);
+var
+  s: String;
+begin
+  WriteSources(aFilename,aRow,aCol);
+  s:='[TTestResolver.RaiseErrorAtSrc] '+aFilename+'('+IntToStr(aRow)+','+IntToStr(aCol)+') Error: '+Msg;
+  writeln('ERROR: ',s);
+  Fail(s);
+end;
+
+procedure TCustomTestResolver.RaiseErrorAtSrcMarker(Msg: string; aMarker: PSrcMarker);
+begin
+  RaiseErrorAtSrc(Msg,aMarker^.Filename,aMarker^.Row,aMarker^.StartCol);
+end;
+
+constructor TCustomTestResolver.Create;
+begin
+  inherited Create;
+  FResolverMsgs:=TObjectList.Create(true);
+  FResolverGoodMsgs:=TFPList.Create;
+end;
+
+destructor TCustomTestResolver.Destroy;
+begin
+  FreeAndNil(FResolverMsgs);
+  FreeAndNil(FResolverGoodMsgs);
+  inherited Destroy;
+end;
+
+function TCustomTestResolver.FindModuleWithFilename(aFilename: string
+  ): TTestEnginePasResolver;
+var
+  i: Integer;
+begin
+  for i:=0 to ModuleCount-1 do
+    if CompareText(Modules[i].Filename,aFilename)=0 then
+      exit(Modules[i]);
+  Result:=nil;
+end;
+
+function TCustomTestResolver.AddModule(aFilename: string): TTestEnginePasResolver;
+begin
+  //writeln('TTestResolver.AddModule ',aFilename);
+  if FindModuleWithFilename(aFilename)<>nil then
+    Fail('TTestResolver.AddModule: file "'+aFilename+'" already exists');
+  Result:=TTestEnginePasResolver.Create;
+  Result.Filename:=aFilename;
+  Result.AddObjFPCBuiltInIdentifiers;
+  Result.OnFindUnit:=@OnPasResolverFindUnit;
+  Result.OnLog:=@OnPasResolverLog;
+  FModules.Add(Result);
+end;
+
+function TCustomTestResolver.AddModuleWithSrc(aFilename, Src: string
+  ): TTestEnginePasResolver;
+begin
+  Result:=AddModule(aFilename);
+  Result.Source:=Src;
+end;
+
+function TCustomTestResolver.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+  ImplementationSrc: string): TTestEnginePasResolver;
+var
+  Src: String;
+begin
+  Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
+  Src+=LineEnding;
+  Src+='interface'+LineEnding;
+  Src+=LineEnding;
+  Src+=InterfaceSrc;
+  Src+='implementation'+LineEnding;
+  Src+=LineEnding;
+  Src+=ImplementationSrc;
+  Src+='end.'+LineEnding;
+  Result:=AddModuleWithSrc(aFilename,Src);
+end;
+
+procedure TCustomTestResolver.AddSystemUnit(Parts: TSystemUnitParts);
+var
+  Intf, Impl: TStringList;
+begin
+  Intf:=TStringList.Create;
+  // interface
+  Intf.Add('type');
+  Intf.Add('  integer=longint;');
+  Intf.Add('  sizeint=int64;');
+    //'const',
+    //'  LineEnding = #10;',
+    //'  DirectorySeparator = ''/'';',
+    //'  DriveSeparator = '''';',
+    //'  AllowDirectorySeparators : set of char = [''\'',''/''];',
+    //'  AllowDriveSeparators : set of char = [];',
+  if supTObject in Parts then
+    begin
+    Intf.AddStrings([
+    'type',
+    '  TClass = class of TObject;',
+    '  TObject = class',
+    '    constructor Create;',
+    '    destructor Destroy; virtual;',
+    '    class function ClassType: TClass; assembler;',
+    '    class function ClassName: String; assembler;',
+    '    class function ClassNameIs(const Name: string): boolean;',
+    '    class function ClassParent: TClass; assembler;',
+    '    class function InheritsFrom(aClass: TClass): boolean; assembler;',
+    '    class function UnitName: String; assembler;',
+    '    procedure AfterConstruction; virtual;',
+    '    procedure BeforeDestruction;virtual;',
+    '    function Equals(Obj: TObject): boolean; virtual;',
+    '    function ToString: String; virtual;',
+    '  end;']);
+    end;
+  Intf.Add('var');
+  Intf.Add('  ExitCode: Longint = 0;');
+
+  // implementation
+  Impl:=TStringList.Create;
+  if supTObject in Parts then
+    begin
+    Impl.AddStrings([
+      '// needed by ClassNameIs, the real SameText is in SysUtils',
+      'function SameText(const s1, s2: String): Boolean; assembler;',
+      'asm',
+      'end;',
+      'constructor TObject.Create; begin end;',
+      'destructor TObject.Destroy; begin end;',
+      'class function TObject.ClassType: TClass; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.ClassName: String; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.ClassNameIs(const Name: string): boolean;',
+      'begin',
+      '  Result:=SameText(Name,ClassName);',
+      'end;',
+      'class function TObject.ClassParent: TClass; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.InheritsFrom(aClass: TClass): boolean; assembler;',
+      'asm',
+      'end;',
+      'class function TObject.UnitName: String; assembler;',
+      'asm',
+      'end;',
+      'procedure TObject.AfterConstruction; begin end;',
+      'procedure TObject.BeforeDestruction; begin end;',
+      'function TObject.Equals(Obj: TObject): boolean;',
+      'begin',
+      '  Result:=Obj=Self;',
+      'end;',
+      'function TObject.ToString: String;',
+      'begin',
+      '  Result:=ClassName;',
+      'end;'
+      ]);
+    end;
+
+  try
+    AddModuleWithIntfImplSrc('system.pp',Intf.Text,Impl.Text);
+  finally
+    Intf.Free;
+    Impl.Free;
+  end;
+end;
+
+procedure TCustomTestResolver.StartProgram(NeedSystemUnit: boolean;
+  SystemUnitParts: TSystemUnitParts);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit(SystemUnitParts)
+  else
+    Parser.ImplicitUses.Clear;
+  Add('program '+ExtractFileUnitName(MainFilename)+';');
+end;
+
+procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('unit '+ExtractFileUnitName(MainFilename)+';');
+end;
+
+function TCustomTestResolver.OnPasResolverFindUnit(SrcResolver: TPasResolver;
+  const aUnitName: String): TPasModule;
+
+  function FindUnit(const aUnitName: String): TPasModule;
+  var
+    i, ErrRow, ErrCol: Integer;
+    CurEngine: TTestEnginePasResolver;
+    CurUnitName, ErrFilename: String;
+  begin
+    {$IFDEF VerboseUnitSearch}
+    writeln('TTestResolver.OnPasResolverFindUnit START Unit="',aUnitName,'"');
+    {$ENDIF}
+    Result:=nil;
+    for i:=0 to ModuleCount-1 do
+      begin
+      CurEngine:=Modules[i];
+      CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
+      {$IFDEF VerboseUnitSearch}
+      writeln('TTestResolver.OnPasResolverFindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
+      {$ENDIF}
+      if CompareText(aUnitName,CurUnitName)=0 then
+        begin
+        Result:=CurEngine.Module;
+        {$IFDEF VerboseUnitSearch}
+        writeln('TTestResolver.OnPasResolverFindUnit Found unit "',CurEngine.Filename,'" Module=',GetObjName(Result));
+        {$ENDIF}
+        if Result<>nil then exit;
+        {$IFDEF VerboseUnitSearch}
+        writeln('TTestResolver.OnPasResolverFindUnit PARSING unit "',CurEngine.Filename,'"');
+        {$ENDIF}
+
+        CurEngine.Resolver:=Resolver;
+        //writeln('TTestResolver.OnPasResolverFindUnit SOURCE=',CurEngine.Source);
+        CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
+        CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
+        CurEngine.Parser:=TPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
+        if CompareText(CurUnitName,'System')=0 then
+          CurEngine.Parser.ImplicitUses.Clear;
+        CurEngine.Scanner.OpenFile(CurEngine.Filename);
+        try
+          CurEngine.Parser.NextToken;
+          CurEngine.Parser.ParseUnit(CurEngine.FModule);
+        except
+          on E: Exception do
+            begin
+            ErrFilename:=CurEngine.Scanner.CurFilename;
+            ErrRow:=CurEngine.Scanner.CurRow;
+            ErrCol:=CurEngine.Scanner.CurColumn;
+            writeln('ERROR: TTestResolver.OnPasResolverFindUnit during parsing: '+E.ClassName+':'+E.Message
+              +' File='+ErrFilename
+              +' LineNo='+IntToStr(ErrRow)
+              +' Col='+IntToStr(ErrCol)
+              +' Line="'+CurEngine.Scanner.CurLine+'"'
+              );
+            WriteSources(ErrFilename,ErrRow,ErrCol);
+            Fail(E.Message);
+            end;
+        end;
+        //writeln('TTestResolver.OnPasResolverFindUnit END ',CurUnitName);
+        Result:=CurEngine.Module;
+        exit;
+        end;
+      end;
+  end;
+begin
+  if SrcResolver=nil then ;
+  if (Pos('.',aUnitName)<1) and (ResolverEngine.DefaultNameSpace<>'') then
+    begin
+    // first search in default program namespace
+    {$IFDEF VerbosePasResolver}
+    writeln('TCustomTestResolver.OnPasResolverFindUnit searching "',aUnitName,'" in default program/library namespace "',ResolverEngine.DefaultNameSpace,'"');
+    {$ENDIF}
+    Result:=FindUnit(ResolverEngine.DefaultNameSpace+'.'+aUnitName);
+    if Result<>nil then exit;
+    end;
+  Result:=FindUnit(aUnitName);
+  if Result<>nil then exit;
+  writeln('TTestResolver.OnPasResolverFindUnit missing unit "',aUnitName,'"');
+  Fail('can''t find unit "'+aUnitName+'"');
+end;
+
+procedure TCustomTestResolver.OnFindReference(El: TPasElement; FindData: pointer);
+var
+  Data: PTestResolverReferenceData absolute FindData;
+  Line, Col: integer;
+begin
+  ResolverEngine.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
+  //writeln('TTestResolver.OnFindReference ',El.SourceFilename,' Line=',Line,',Col=',Col,' ',GetObjName(El),' SearchFile=',Data^.Filename,',Line=',Data^.Row,',Col=',Data^.StartCol,'-',Data^.EndCol);
+  if (Data^.Filename=El.SourceFilename)
+  and (Data^.Row=Line)
+  and (Data^.StartCol<=Col)
+  and (Data^.EndCol>=Col)
+  then
+    Data^.Found.Add(El);
+end;
+
+procedure TCustomTestResolver.OnCheckElementParent(El: TPasElement; arg: pointer);
+var
+  SubEl: TPasElement;
+  i: Integer;
+
+  procedure E(Msg: string);
+  var
+    s: String;
+  begin
+    s:='TTestResolver.OnCheckElementParent El='+GetTreeDbg(El)+' '+
+      ResolverEngine.GetElementSourcePosStr(El)+' '+Msg;
+    writeln('ERROR: ',s);
+    Fail(s);
+  end;
+
+begin
+  if arg=nil then ;
+  //writeln('TTestResolver.OnCheckElementParent ',GetObjName(El));
+  if El=nil then exit;
+  if El.Parent=El then
+    E('El.Parent=El='+GetObjName(El));
+  if El is TBinaryExpr then
+    begin
+    if (TBinaryExpr(El).left<>nil) and (TBinaryExpr(El).left.Parent<>El) then
+      E('TBinaryExpr(El).left.Parent='+GetObjName(TBinaryExpr(El).left.Parent)+'<>El');
+    if (TBinaryExpr(El).right<>nil) and (TBinaryExpr(El).right.Parent<>El) then
+      E('TBinaryExpr(El).right.Parent='+GetObjName(TBinaryExpr(El).right.Parent)+'<>El');
+    end
+  else if El is TParamsExpr then
+    begin
+    if (TParamsExpr(El).Value<>nil) and (TParamsExpr(El).Value.Parent<>El) then
+      E('TParamsExpr(El).Value.Parent='+GetObjName(TParamsExpr(El).Value.Parent)+'<>El');
+    for i:=0 to length(TParamsExpr(El).Params)-1 do
+      if TParamsExpr(El).Params[i].Parent<>El then
+        E('TParamsExpr(El).Params[i].Parent='+GetObjName(TParamsExpr(El).Params[i].Parent)+'<>El');
+    end
+  else if El is TPasDeclarations then
+    begin
+    for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
+      begin
+      SubEl:=TPasElement(TPasDeclarations(El).Declarations[i]);
+      if SubEl.Parent<>El then
+        E('SubEl=TPasElement(TPasDeclarations(El).Declarations[i])='+GetObjName(SubEl)+' SubEl.Parent='+GetObjName(SubEl.Parent)+'<>El');
+      end;
+    end
+  else if El is TPasImplBlock then
+    begin
+    for i:=0 to TPasImplBlock(El).Elements.Count-1 do
+      begin
+      SubEl:=TPasElement(TPasImplBlock(El).Elements[i]);
+      if SubEl.Parent<>El then
+        E('TPasElement(TPasImplBlock(El).Elements[i]).Parent='+GetObjName(SubEl.Parent)+'<>El');
+      end;
+    end
+  else if El is TPasImplWithDo then
+    begin
+    for i:=0 to TPasImplWithDo(El).Expressions.Count-1 do
+      begin
+      SubEl:=TPasExpr(TPasImplWithDo(El).Expressions[i]);
+      if SubEl.Parent<>El then
+        E('TPasExpr(TPasImplWithDo(El).Expressions[i]).Parent='+GetObjName(SubEl.Parent)+'<>El');
+      end;
+    end
+  else if El is TPasProcedure then
+    begin
+    if TPasProcedure(El).ProcType.Parent<>El then
+      E('TPasProcedure(El).ProcType.Parent='+GetObjName(TPasProcedure(El).ProcType.Parent)+'<>El');
+    end
+  else if El is TPasProcedureType then
+    begin
+    for i:=0 to TPasProcedureType(El).Args.Count-1 do
+      if TPasArgument(TPasProcedureType(El).Args[i]).Parent<>El then
+        E('TPasArgument(TPasProcedureType(El).Args[i]).Parent='+GetObjName(TPasArgument(TPasProcedureType(El).Args[i]).Parent)+'<>El');
+    end;
+end;
+
+procedure TCustomTestResolver.FreeSrcMarkers;
+var
+  aMarker, Last: PSrcMarker;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    Last:=aMarker;
+    aMarker:=aMarker^.Next;
+    Dispose(Last);
+    end;
+end;
+
+procedure TCustomTestResolver.OnPasResolverLog(Sender: TObject;
+  const Msg: String);
+var
+  aResolver: TTestEnginePasResolver;
+  Item: TTestResolverMessage;
+begin
+  aResolver:=Sender as TTestEnginePasResolver;
+  Item:=TTestResolverMessage.Create;
+  Item.Id:=aResolver.LastMsgId;
+  Item.MsgType:=aResolver.LastMsgType;
+  Item.MsgNumber:=aResolver.LastMsgNumber;
+  Item.Msg:=Msg;
+  {$IFDEF VerbosePasResolver}
+  writeln('TCustomTestResolver.OnPasResolverLog ',GetObjName(Sender),' ',Item.MsgType,' (',Item.MsgNumber,') {',Msg,'}');
+  {$ENDIF}
+  FResolverMsgs.Add(Item);
+end;
+
+function TCustomTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
+begin
+  Result:=TTestEnginePasResolver(FModules[Index]);
+end;
+
+function TCustomTestResolver.GetMsgCount: integer;
+begin
+  Result:=FResolverMsgs.Count;
+end;
+
+function TCustomTestResolver.GetMsgs(Index: integer): TTestResolverMessage;
+begin
+  Result:=TTestResolverMessage(FResolverMsgs[Index]);
+end;
+
+function TCustomTestResolver.GetModuleCount: integer;
+begin
+  Result:=FModules.Count;
+end;
+
+{ TTestResolver }
+
+procedure TTestResolver.TestEmpty;
+begin
+  StartProgram(false);
+  Add('begin');
+  ParseProgram;
+  AssertEquals('No statements',0,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestResolver.TestAliasType;
+var
+  El: TPasElement;
+  T: TPasAliasType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  tint=longint;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('Type',TPasAliasType,El.ClassType);
+  T:=TPasAliasType(El);
+  AssertEquals('Type tint','tint',T.Name);
+  AssertEquals('Type built-in',TPasUnresolvedSymbolRef,T.DestType.ClassType);
+  AssertEquals('longint type','longint',lowercase(T.DestType.Name));
+end;
+
+procedure TTestResolver.TestAlias2Type;
+var
+  El: TPasElement;
+  T1, T2: TPasAliasType;
+  DestT1, DestT2: TPasType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  tint1=longint;');
+  Add('  tint2=tint1;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('2 declaration',2,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('Type',TPasAliasType,El.ClassType);
+  T1:=TPasAliasType(El);
+  AssertEquals('Type tint1','tint1',T1.Name);
+  DestT1:=T1.DestType;
+  AssertEquals('built-in',TPasUnresolvedSymbolRef,DestT1.ClassType);
+  AssertEquals('built-in longint','longint',lowercase(DestT1.Name));
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[1]);
+  AssertEquals('Type',TPasAliasType,El.ClassType);
+  T2:=TPasAliasType(El);
+  AssertEquals('Type tint2','tint2',T2.Name);
+  DestT2:=T2.DestType;
+  AssertEquals('points to alias type',TPasAliasType,DestT2.ClassType);
+  AssertEquals('points to tint1','tint1',DestT2.Name);
+end;
+
+procedure TTestResolver.TestAliasTypeRefs;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#a}a=longint;');
+  Add('  {#b}{=a}b=a;');
+  Add('var');
+  Add('  {=a}c: a;');
+  Add('  {=b}d: b;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAliasOfVarFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: char;');
+  Add('type');
+  Add('  t=a;');
+  Add('begin');
+  CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
+end;
+
+procedure TTestResolver.TestAliasType_UnitPrefix;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('type');
+  Add('  {#a}a=longint;');
+  Add('  {#b}{=a}b=afile.a;');
+  Add('var');
+  Add('  {=a}c: a;');
+  Add('  {=b}d: b;');
+  Add('implementation');
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestAliasType_UnitPrefix_CycleFail;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('type');
+  Add('  {#a}a=afile.a;');
+  Add('implementation');
+  CheckResolverException('identifier not found "a"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestAliasTypeNotFoundPosition;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TColor = NotThere;');
+  CheckResolverException('identifier not found "NotThere"',nIdentifierNotFound);
+  // TColor element was not created yet, so LastElement must nil
+  AssertNull('ResolverEngine.LastElement',ResolverEngine.LastElement);
+  with ResolverEngine.LastSourcePos do
+    begin
+    //writeln('TTestResolver.TestAliasTypeNotFoundPosition ',FileName,' ',Row,' ',Col);
+    //WriteSources(FileName,Row,Column);
+    AssertEquals('ResolverEngine.LastSourcePos.Filename','afile.pp',FileName);
+    AssertEquals('ResolverEngine.LastSourcePos.Row',4,Row);
+    AssertEquals('ResolverEngine.LastSourcePos.Column',19,Column);
+    end;
+end;
+
+procedure TTestResolver.TestTypeAliasType;
+begin
+  // ToDo
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer}integer = longint;');
+  Add('  {#tcolor}TColor = type integer;');
+  Add('var');
+  Add('  {=integer}i: integer;');
+  Add('  {=tcolor}c: TColor;');
+  Add('begin');
+  Add('  c:=i;');
+  Add('  i:=c;');
+  Add('  i:=integer(c);');
+  Add('  c:=TColor(i);');
+  // ParseProgram;
+end;
+
+procedure TTestResolver.TestVarLongint;
+var
+  El: TPasElement;
+  V1: TPasVariable;
+  DestT1: TPasType;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1:longint;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('var',TPasVariable,El.ClassType);
+  V1:=TPasVariable(El);
+  AssertEquals('var v1','v1',V1.Name);
+  DestT1:=V1.VarType;
+  AssertEquals('built-in',TPasUnresolvedSymbolRef,DestT1.ClassType);
+  AssertEquals('built-in longint','longint',lowercase(DestT1.Name));
+end;
+
+procedure TTestResolver.TestVarInteger;
+var
+  El: TPasElement;
+  V1: TPasVariable;
+  DestT1: TPasType;
+begin
+  StartProgram(true);
+  Add('var');
+  Add('  v1:integer;'); // defined in system.pp
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('var',TPasVariable,El.ClassType);
+  V1:=TPasVariable(El);
+  AssertEquals('var v1','v1',V1.Name);
+  DestT1:=V1.VarType;
+  AssertNotNull('v1 type',DestT1);
+  AssertEquals('built-in',TPasAliasType,DestT1.ClassType);
+  AssertEquals('built-in integer','integer',DestT1.Name);
+  AssertNull('v1 no expr',V1.Expr);
+end;
+
+procedure TTestResolver.TestConstInteger;
+var
+  El: TPasElement;
+  C1: TPasConst;
+  DestT1: TPasType;
+  ExprC1: TPrimitiveExpr;
+begin
+  StartProgram(true);
+  Add('const');
+  Add('  c1: integer=3;'); // defined in system.pp
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('const',TPasConst,El.ClassType);
+  C1:=TPasConst(El);
+  AssertEquals('const c1','c1',C1.Name);
+  DestT1:=C1.VarType;
+  AssertNotNull('c1 type',DestT1);
+  AssertEquals('built-in',TPasAliasType,DestT1.ClassType);
+  AssertEquals('built-in integer','integer',DestT1.Name);
+  ExprC1:=TPrimitiveExpr(C1.Expr);
+  AssertNotNull('c1 expr',ExprC1);
+  AssertEquals('c1 expr primitive',TPrimitiveExpr,ExprC1.ClassType);
+  AssertEquals('c1 expr value','3',ExprC1.Value);
+end;
+
+procedure TTestResolver.TestConstInteger2;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  c1 = 3');
+  Add('  c2: longint=c1;'); // defined in system.pp
+  Add('begin');
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestDuplicateVar;
+begin
+  StartProgram(false);
+  Add('var a: longint;');
+  Add('var a: string;');
+  Add('begin');
+  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestVarInitConst;
+begin
+  StartProgram(false);
+  Add('const {#c}c=1;');
+  Add('var a: longint = {@c}c;');
+  Add('begin');
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestVarOfVarFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: char;');
+  Add('  b: a;');
+  Add('begin');
+  CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
+end;
+
+procedure TTestResolver.TestConstOfVarFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: longint;');
+  Add('const');
+  Add('  b: a = 1;');
+  Add('begin');
+  CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
+end;
+
+procedure TTestResolver.TestTypedConstWrongExprFail;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  a: string = 1;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestVarWrongExprFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: string = 1;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArgWrongExprFail;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(a: string = 1);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestVarExternal;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  NaN: double; external name ''Global.Nan'';');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestVarNoSemicolonBeginFail;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; begin end;');
+  Add('var');
+  Add('  i: longint');
+  Add('begin');
+  Add('  doit;');
+  CheckParserException('Expected ";"',
+    nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestIntegerRange;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  MinInt = -1;');
+  Add('  MaxInt = +1;');
+  Add('type');
+  Add('  {#TMyInt}TMyInt = MinInt..MaxInt;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestIntegerRangeHighLowerLowFail;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  MinInt = -1;');
+  Add('  MaxInt = +1;');
+  Add('type');
+  Add('  {#TMyInt}TMyInt = MaxInt..MinInt;');
+  Add('begin');
+  {$IFDEF EnablePasResRangeCheck}
+  CheckResolverException(sHighRangeLimitLTLowRangeLimit,
+    nHighRangeLimitLTLowRangeLimit);
+  {$ENDIF}
+end;
+
+procedure TTestResolver.TestIntegerRangeLowHigh;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  MinInt = -1;',
+  '  MaxInt = +10;',
+  'type',
+  '  {#TMyInt}TMyInt = MinInt..MaxInt;',
+  'const a = low(TMyInt)+High(TMyInt);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestAssignIntRangeFail;
+begin
+  StartProgram(false);
+  Add([
+  'type TMyInt = 1..2;',
+  'var i: TMyInt;',
+  'begin',
+  '  i:=3;']);
+  ParseProgram;
+  {$IFDEF EnablePasResRangeCheck}
+  CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    'range check error while evaluating constants (3 must be between 1 and 2)');
+  CheckResolverUnexpectedHints;
+  {$ENDIF}
+end;
+
+procedure TTestResolver.TestByteRangeFail;
+begin
+  StartProgram(false);
+  Add([
+  'var b:byte=300;',
+  'begin']);
+  ParseProgram;
+  {$IFDEF EnablePasResRangeCheck}
+  CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    'range check error while evaluating constants (300 must be between 0 and 255)');
+  CheckResolverUnexpectedHints;
+  {$ENDIF}
+end;
+
+procedure TTestResolver.TestCustomIntRangeFail;
+begin
+  StartProgram(false);
+  Add([
+  'const i:1..2 = 3;',
+  'begin']);
+  ParseProgram;
+  {$IFDEF EnablePasResRangeCheck}
+  CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    'range check error while evaluating constants (3 must be between 1 and 2)');
+  CheckResolverUnexpectedHints;
+  {$ENDIF}
+end;
+
+procedure TTestResolver.TestConstIntOperators;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  'const',
+  '  a:byte=1+2;',
+  '  b:shortint=1-2;',
+  '  c:word=2*3;',
+  '  d:smallint=5 div 2;',
+  '  e:longword=5 mod 2;',
+  '  f:longint=5 shl 2;',
+  '  g:qword=5 shr 2;',
+  '  h:boolean=5=2;',
+  '  i:boolean=5<>2;',
+  '  j:boolean=5<2;',
+  '  k:boolean=5>2;',
+  '  l:boolean=5<=2;',
+  '  m:boolean=5>=2;',
+  '  n:longword=5 and 2;',
+  '  o:longword=5 or 2;',
+  '  p:longword=5 xor 2;',
+  '  q:longword=not (5 or not 2);',
+  '  r=low(word)+high(int64);',
+  '  s=low(longint)+high(integer);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestConstBoolOperators;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=true and false;',
+  '  b=true or false;',
+  '  c=true xor false;',
+  '  d=not b;',
+  '  e=a=b;',
+  '  f=a<>b;',
+  '  g=low(boolean) or high(boolean);',
+  '  h=succ(false) or pred(true);',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestChar_Ord;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=ord(c);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestChar_Chr;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  c:=chr(i);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestString_SetLength;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('begin');
+  Add('  SetLength({#a_var}s,3);');
+  Add('  SetLength({#b_var}s,length({#c_read}s));');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestString_Element;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  if s[1]=s then ;');
+  Add('  if s=s[2] then ;');
+  Add('  if s[3+4]=c then ;');
+  Add('  if c=s[5] then ;');
+  Add('  c:=s[6];');
+  Add('  s[7]:=c;');
+  Add('  s[8]:=''a'';');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStringElement_MissingArgFail;
+begin
+  StartProgram(false);
+  Add('var s: string;');
+  Add('begin');
+  Add('  if s[]=s then ;');
+  CheckResolverException('Missing parameter character index',nMissingParameterX);
+end;
+
+procedure TTestResolver.TestStringElement_IndexNonIntFail;
+begin
+  StartProgram(false);
+  Add('var s: string;');
+  Add('begin');
+  Add('  if s[true]=s then ;');
+  CheckResolverException('Incompatible types: got "Boolean" expected "integer"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestStringElement_AsVarArgFail;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(var c: char);');
+  Add('begin');
+  Add('end;');
+  Add('var s: string;');
+  Add('begin');
+  Add('  DoIt(s[1]);');
+  CheckResolverException('Variable identifier expected',
+    nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestString_DoubleQuotesFail;
+begin
+  StartProgram(false);
+  Add('var s: string;');
+  Add('begin');
+  Add('  s:="abc" + "def";');
+  CheckParserException('Invalid character ''"''',PScanner.nErrInvalidCharacter);
+end;
+
+procedure TTestResolver.TestString_ShortstringType;
+begin
+  StartProgram(false);
+  Add([
+  'type t = string[12];',
+  'var',
+  '  s: t;',
+  'begin',
+  '  s:=''abc'';',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestConstStringOperators;
+begin
+  StartProgram(false);
+  Add([
+  'const',
+  '  a=''o''+''x'';',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestEnums;
+begin
+  StartProgram(false);
+  Add('type {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue);');
+  Add('var');
+  Add('  {#f}{=TFlag}f: TFlag;');
+  Add('  {#v}{=TFlag}v: TFlag = Green;');
+  Add('begin');
+  Add('  {@f}f:={@Red}Red;');
+  Add('  {@f}f:={@v}v;');
+  Add('  if {@f}f={@Red}Red then ;');
+  Add('  if {@f}f={@v}v then ;');
+  Add('  if {@f}f>{@v}v then ;');
+  Add('  if {@f}f<{@v}v then ;');
+  Add('  if {@f}f>={@v}v then ;');
+  Add('  if {@f}f<={@v}v then ;');
+  Add('  if {@f}f<>{@v}v then ;');
+  Add('  if ord({@f}f)<>ord({@Red}Red) then ;');
+  Add('  {@f}f:={@TFlag}TFlag.{@Red}Red;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnumRangeFail;
+begin
+  exit; // ToDo
+
+  StartProgram(false);
+  Add([
+  'type TFlag = (a,b,c);',
+  'const all = a..c;',
+  'begin']);
+  CheckParserException('aaa',123);
+end;
+
+procedure TTestResolver.TestSets;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue, {#Gray}Gray, {#Black}Black, {#White}White);');
+  Add('  {#TFlags}TFlags = set of TFlag;');
+  Add('  {#TChars}TChars = set of Char;');
+  Add('  {#TMyInt}TMyInt = 0..17;');
+  Add('  {#TMyInts}TMyInts = set of TMyInt;');
+  Add('  {#TMyBools}TMyBools = set of boolean;');
+  Add('const');
+  Add('  {#Colors}Colors = [{@Red}Red..{@Blue}Blue];');
+  Add('  {#ExtColors}ExtColors = {@Colors}Colors+[{@White}White,{@Black}Black];');
+  Add('var');
+  Add('  {#f}{=TFlag}f: TFlag;');
+  Add('  {#s}{=TFlags}s: TFlags;');
+  Add('  {#t}{=TFlags}t: TFlags = [Green,Gray];');
+  Add('  {#Chars}{=TChars}Chars: TChars;');
+  Add('  {#MyInts}{=TMyInts}MyInts: TMyInts;');
+  Add('  {#MyBools}{=TMyBools}MyBools: TMyBools;');
+  Add('begin');
+  Add('  {@s}s:=[];');
+  Add('  {@s}s:={@t}t;');
+  Add('  {@s}s:=[{@Red}Red];');
+  Add('  {@s}s:=[{@Red}Red,{@Blue}Blue];');
+  Add('  {@s}s:=[{@Gray}Gray..{@White}White];');
+  Add('  {@MyInts}MyInts:=[1];');
+  Add('  {@MyInts}MyInts:=[1,2];');
+  Add('  {@MyInts}MyInts:=[1..2];');
+  Add('  {@MyInts}MyInts:=[1..2,3];');
+  Add('  {@MyInts}MyInts:=[1..2,3..4];');
+  Add('  {@MyInts}MyInts:=[1,2..3];');
+  Add('  {@MyBools}MyBools:=[false];');
+  Add('  {@MyBools}MyBools:=[false,true];');
+  Add('  {@MyBools}MyBools:=[true..false];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSetOperators;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TFlag}TFlag = ({#Red}Red, {#Green}Green, {#Blue}Blue, {#Gray}Gray, {#Black}Black, {#White}White);');
+  Add('  {#TFlags}TFlags = set of TFlag;');
+  Add('  {#TChars}TChars = set of Char;');
+  Add('  {#TMyInt}TMyInt = 0..17;');
+  Add('  {#TMyInts}TMyInts = set of TMyInt;');
+  Add('  {#TMyBools}TMyBools = set of boolean;');
+  Add('const');
+  Add('  {#Colors}Colors = [{@Red}Red..{@Blue}Blue];');
+  Add('  {#ExtColors}ExtColors = {@Colors}Colors+[{@White}White,{@Black}Black];');
+  Add('var');
+  Add('  {#f}{=TFlag}f: TFlag;');
+  Add('  {#s}{=TFlags}s: TFlags;');
+  Add('  {#t}{=TFlags}t: TFlags = [Green,Gray];');
+  Add('  {#Chars}{=TChars}Chars: TChars;');
+  Add('  {#MyInts}{=TMyInts}MyInts: TMyInts;');
+  Add('  {#MyBools}{=TMyBools}MyBools: TMyBools;');
+  Add('begin');
+  Add('  {@s}s:=[];');
+  Add('  {@s}s:=[{@Red}Red]+[{@Blue}Blue,{@Gray}Gray];');
+  Add('  {@s}s:=[{@Blue}Blue,{@Gray}Gray]-[{@Blue}Blue];');
+  Add('  {@s}s:={@t}t+[];');
+  Add('  {@s}s:=[{@Red}Red]+{@s}s;');
+  Add('  {@s}s:={@s}s+[{@Red}Red];');
+  Add('  {@s}s:=[{@Red}Red]-{@s}s;');
+  Add('  {@s}s:={@s}s-[{@Red}Red];');
+  Add('  Include({@s}s,{@Blue}Blue);');
+  Add('  Include({@s}s,{@f}f);');
+  Add('  Exclude({@s}s,{@Blue}Blue);');
+  Add('  Exclude({@s}s,{@f}f);');
+  Add('  {@s}s:={@s}s+[{@f}f];');
+  Add('  if {@Green}Green in {@s}s then ;');
+  Add('  if {@Blue}Blue in {@Colors}Colors then ;');
+  Add('  if {@f}f in {@ExtColors}ExtColors then ;');
+  Add('  {@s}s:={@s}s * {@Colors}Colors;');
+  Add('  {@s}s:={@Colors}Colors * {@s}s;');
+  Add('  {@s}s:={@ExtColors}ExtColors * {@Colors}Colors;');
+  Add('  {@s}s:=Colors >< {@ExtColors}ExtColors;');
+  Add('  {@s}s:={@s}s >< {@ExtColors}ExtColors;');
+  Add('  {@s}s:={@ExtColors}ExtColors >< s;');
+  Add('  {@s}s:={@s}s >< {@s}s;');
+  Add('  if ''p'' in [''a''..''z''] then ; ');
+  Add('  if ''p'' in [''a''..''z'',''A''..''Z'',''0''..''9'',''_''] then ; ');
+  Add('  if ''p'' in {@Chars}Chars then ; ');
+  Add('  if 7 in {@MyInts}MyInts then ; ');
+  Add('  if 7 in [1+2,(3*4)+5,(-2+6)..(8-3)] then ; ');
+  Add('  if [red,blue]*s=[red,blue] then ;');
+  Add('  if {@s}s = t then;');
+  Add('  if {@s}s = {@Colors}Colors then;');
+  Add('  if {@Colors}Colors = s then;');
+  Add('  if {@s}s <> t then;');
+  Add('  if {@s}s <> {@Colors}Colors then;');
+  Add('  if {@Colors}Colors <> s then;');
+  Add('  if {@s}s <= t then;');
+  Add('  if {@s}s <= {@Colors}Colors then;');
+  Add('  if {@Colors}Colors <= s then;');
+  Add('  if {@s}s >= t then;');
+  Add('  if {@s}s >= {@Colors}Colors then;');
+  Add('  if {@Colors}Colors >= {@s}s then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnumParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('function {#A1}FuncA: TFlag;');
+  Add('begin');
+  Add('  Result:=red;');
+  Add('end;');
+  Add('function {#A2}FuncA(f: TFlag): TFlag;');
+  Add('begin');
+  Add('  Result:=f;');
+  Add('end;');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('begin');
+  Add('  f:={@A1}FuncA;');
+  Add('  f:={@A1}FuncA();');
+  Add('  f:={@A2}FuncA(f);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSetParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('  TFlags = set of TFlag;');
+  Add('function {#A1}FuncA: TFlags;');
+  Add('begin');
+  Add('  Result:=[red];');
+  Add('end;');
+  Add('function {#A2}FuncA(f: TFlags): TFlags;');
+  Add('begin');
+  Add('  Result:=f;');
+  Add('end;');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('begin');
+  Add('  f:={@A1}FuncA;');
+  Add('  f:={@A1}FuncA();');
+  Add('  f:={@A2}FuncA(f);');
+  Add('  f:={@A2}FuncA([green]);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSetFunctions;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('  TFlags = set of TFlag;');
+  Add('var');
+  Add('  e: TFlag;');
+  Add('  s: TFlags;');
+  Add('begin');
+  Add('  e:=Low(TFlags);');
+  Add('  e:=Low(s);');
+  Add('  e:=High(TFlags);');
+  Add('  e:=High(s);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnumHighLow;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var f: TFlag;');
+  Add('begin');
+  Add('  for f:=low(TFlag) to high(TFlag) do ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnumOrd;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=ord(f);');
+  Add('  i:=ord(green);');
+  Add('  if i=ord(f) then ;');
+  Add('  if ord(f)=i then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnumPredSucc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('begin');
+  Add('  f:=Pred(f);');
+  Add('  if Pred(green)=Pred(TFlag.Blue) then;');
+  Add('  f:=Succ(f);');
+  Add('  if Succ(green)=Succ(TFlag.Blue) then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestEnum_EqualNilFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('begin');
+  Add('  if f=nil then ;');
+  CheckResolverException('Incompatible types: got "TFlag" expected "Pointer"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestEnum_CastIntegerToEnum;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  f:=TFlag(1);');
+  Add('  f:=TFlag({#a_read}i);');
+  Add('  if TFlag({#b_read}i)=TFlag(1) then;');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestEnum_Str;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red, green, blue);');
+  Add('var');
+  Add('  f: TFlag;');
+  Add('  i: longint;');
+  Add('  aString: string;');
+  Add('begin');
+  Add('  aString:=str(f);');
+  Add('  aString:=str(f:3);');
+  Add('  str(f,aString);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSetConstRange;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (red,blue,green);',
+  '  TEnums = set of TEnum;',
+  'const',
+  '  teAny = [low(TEnum)..high(TEnum)];',
+  '  teRedBlue = [low(TEnum)..pred(high(TEnum))];',
+  'var',
+  '  e: TEnum;',
+  '  s: TEnums;',
+  'begin',
+  '  if blue in teAny then;',
+  '  if blue in teAny+[e] then;',
+  '  if blue in teAny+teRedBlue then;',
+  '  s:=teAny;',
+  '  s:=teAny+[e];',
+  '  s:=[e]+teAny;',
+  '  s:=teAny+teRedBlue;',
+  '  s:=teAny+teRedBlue+[e];',
+  '']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestSet_AnonymousEnumtype;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlags = set of (red, green);');
+  Add('const');
+  Add('  favorite = red;');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Include(f,red);');
+  Add('  Include(f,favorite);');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(favorite);');
+  Add('  i:=ord(low(TFlags));');
+  Add('  i:=ord(low(f));');
+  Add('  i:=ord(low(favorite));');
+  Add('  i:=ord(high(TFlags));');
+  Add('  i:=ord(high(f));');
+  Add('  i:=ord(high(favorite));');
+  Add('  f:=[green,favorite];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSet_AnonymousEnumtypeName;
+begin
+  ResolverEngine.AnonymousElTypePostfix:='$enum';
+  StartProgram(false);
+  Add('type');
+  Add('  TFlags = set of (red, green);');
+  Add('const');
+  Add('  favorite = red;');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Include(f,red);');
+  Add('  Include(f,favorite);');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(favorite);');
+  Add('  i:=ord(low(TFlags));');
+  Add('  i:=ord(low(f));');
+  Add('  i:=ord(low(favorite));');
+  Add('  i:=ord(high(TFlags));');
+  Add('  i:=ord(high(f));');
+  Add('  i:=ord(high(favorite));');
+  Add('  f:=[green,favorite];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestSet_Const;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TFlag = (a,b,c,d,e,f);',
+  'const',
+  '  ab = [a..b];',
+  //'  notc = [a..b,d..e,f];',
+  //'  all = [low(TFlag)..high(TFlag)];',
+  //'  notaf = [succ(low(TFlag))..pred(high(TFlag))];',
+  'begin']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestPrgAssignment;
+var
+  El: TPasElement;
+  V1: TPasVariable;
+  ImplAssign: TPasImplAssign;
+  Ref1: TPrimitiveExpr;
+  Resolver1: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1:longint;');
+  Add('begin');
+  Add('  v1:=3;');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('var',TPasVariable,El.ClassType);
+  V1:=TPasVariable(El);
+  AssertEquals('var v1','v1',V1.Name);
+
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Assignment statement',TPasImplAssign,FFirstStatement.ClassType);
+  ImplAssign:=FFirstStatement as TPasImplAssign;
+  AssertEquals('Normal assignment',akDefault,ImplAssign.Kind);
+  AssertExpression('Right side is constant',ImplAssign.Right,pekNumber,'3');
+  AssertExpression('Left side is variable',ImplAssign.Left,pekIdent,'v1');
+  AssertEquals('Left side is variable, primitive',TPrimitiveExpr,ImplAssign.Left.ClassType);
+  Ref1:=TPrimitiveExpr(ImplAssign.Left);
+  AssertNotNull('variable has customdata',Ref1.CustomData);
+  AssertEquals('variable has resolver',TResolvedReference,Ref1.CustomData.ClassType);
+  Resolver1:=TResolvedReference(Ref1.CustomData);
+  AssertSame('variable resolver element',Resolver1.Element,Ref1);
+  AssertSame('variable resolver declaration v1',Resolver1.Declaration,V1);
+end;
+
+procedure TTestResolver.TestPrgProcVar;
+begin
+  StartProgram(false);
+  Add('procedure Proc1;');
+  Add('type');
+  Add('  t1=longint;');
+  Add('var');
+  Add('  v1:t1;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+  AssertEquals('1 declaration',1,PasProgram.ProgramSection.Declarations.Count);
+end;
+
+procedure TTestResolver.TestUnitProcVar;
+var
+  El: TPasElement;
+  IntfProc1, ImplProc1: TPasProcedure;
+  IntfType1, ProcSubType1: TPasAliasType;
+  ImplVar1, ProcSubVar1: TPasVariable;
+  ImplVar1Type, ProcSubVar1Type: TPasType;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('');
+  Add('type t1=string; // unit scope');
+  Add('procedure Proc1;');
+  Add('');
+  Add('implementation');
+  Add('');
+  Add('procedure Proc1;');
+  Add('type t1=longint; // local proc scope');
+  Add('var  v1:t1; // using local t1');
+  Add('begin');
+  Add('end;');
+  Add('var  v2:t1; // using interface t1');
+  ParseUnit;
+
+  // interface
+  AssertEquals('2 intf declarations',2,Module.InterfaceSection.Declarations.Count);
+  El:=TPasElement(Module.InterfaceSection.Declarations[0]);
+  AssertEquals('intf type',TPasAliasType,El.ClassType);
+  IntfType1:=TPasAliasType(El);
+  AssertEquals('intf type t1','t1',IntfType1.Name);
+
+  El:=TPasElement(Module.InterfaceSection.Declarations[1]);
+  AssertEquals('intf proc',TPasProcedure,El.ClassType);
+  IntfProc1:=TPasProcedure(El);
+  AssertEquals('intf proc Proc1','Proc1',IntfProc1.Name);
+
+  // implementation
+  AssertEquals('2 impl declarations',2,Module.ImplementationSection.Declarations.Count);
+  El:=TPasElement(Module.ImplementationSection.Declarations[0]);
+  AssertEquals('impl proc',TPasProcedure,El.ClassType);
+  ImplProc1:=TPasProcedure(El);
+  AssertEquals('impl proc Proc1','Proc1',ImplProc1.Name);
+
+  El:=TPasElement(Module.ImplementationSection.Declarations[1]);
+  AssertEquals('impl var',TPasVariable,El.ClassType);
+  ImplVar1:=TPasVariable(El);
+  AssertEquals('impl var v2','v2',ImplVar1.Name);
+  ImplVar1Type:=TPasType(ImplVar1.VarType);
+  AssertSame('impl var type is intf t1',IntfType1,ImplVar1Type);
+
+  // proc
+  AssertEquals('2 proc sub declarations',2,ImplProc1.Body.Declarations.Count);
+
+  // proc sub type t1
+  El:=TPasElement(ImplProc1.Body.Declarations[0]);
+  AssertEquals('proc sub type',TPasAliasType,El.ClassType);
+  ProcSubType1:=TPasAliasType(El);
+  AssertEquals('proc sub type t1','t1',ProcSubType1.Name);
+
+  // proc sub var v1
+  El:=TPasElement(ImplProc1.Body.Declarations[1]);
+  AssertEquals('proc sub var',TPasVariable,El.ClassType);
+  ProcSubVar1:=TPasVariable(El);
+  AssertEquals('proc sub var v1','v1',ProcSubVar1.Name);
+  ProcSubVar1Type:=TPasType(ProcSubVar1.VarType);
+  AssertSame('proc sub var type is proc sub t1',ProcSubType1,ProcSubVar1Type);
+end;
+
+procedure TTestResolver.TestAssignIntegers;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#vbyte}vbyte:byte;');
+  Add('  {#vshortint}vshortint:shortint;');
+  Add('  {#vword}vword:word;');
+  Add('  {#vsmallint}vsmallint:smallint;');
+  Add('  {#vlongword}vlongword:longword;');
+  Add('  {#vlongint}vlongint:longint;');
+  Add('  {#vqword}vqword:qword;');
+  Add('  {#vint64}vint64:int64;');
+  Add('  {#vcomp}vcomp:comp;');
+  Add('begin');
+  Add('  {@vbyte}vbyte:=0;');
+  Add('  {@vbyte}vbyte:=255;');
+  Add('  {@vshortint}vshortint:=0;');
+  Add('  {@vshortint}vshortint:=-128;');
+  Add('  {@vshortint}vshortint:= 127;');
+  Add('  {@vword}vword:=0;');
+  Add('  {@vword}vword:=+$ffff;');
+  Add('  {@vsmallint}vsmallint:=0;');
+  Add('  {@vsmallint}vsmallint:=-$8000;');
+  Add('  {@vsmallint}vsmallint:= $7fff;');
+  Add('  {@vlongword}vlongword:=0;');
+  Add('  {@vlongword}vlongword:=$ffffffff;');
+  Add('  {@vlongint}vlongint:=0;');
+  Add('  {@vlongint}vlongint:=-$80000000;');
+  Add('  {@vlongint}vlongint:= $7fffffff;');
+  Add('  {@vlongint}vlongint:={@vbyte}vbyte;');
+  Add('  {@vlongint}vlongint:={@vshortint}vshortint;');
+  Add('  {@vlongint}vlongint:={@vword}vword;');
+  Add('  {@vlongint}vlongint:={@vsmallint}vsmallint;');
+  Add('  {@vlongint}vlongint:={@vlongint}vlongint;');
+  Add('  {@vint64}vint64:=0;');
+  Add('  {@vint64}vint64:=-$8000000000000000;');
+  Add('  {@vint64}vint64:= $7fffffffffffffff;');
+  Add('  {@vqword}vqword:=0;');
+  Add('  {@vqword}vqword:=$ffffffffffffffff;');
+  Add('  {@vcomp}vcomp:=0;');
+  Add('  {@vcomp}vcomp:=-$8000000000000000;');
+  Add('  {@vcomp}vcomp:= $7fffffffffffffff;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAssignString;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vstring:string;');
+  Add('  vchar:char;');
+  Add('begin');
+  Add('  vstring:='''';');
+  Add('  vstring:=''abc'';');
+  Add('  vstring:=''a'';');
+  Add('  vchar:=''c'';');
+  Add('  vchar:=vstring[1];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAssignIntToStringFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vstring:string;');
+  Add('begin');
+  Add('  vstring:=2;');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestAssignStringToIntFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v:longint;');
+  Add('begin');
+  Add('  v:=''A'';');
+  CheckResolverException('Incompatible types: got "Char" expected "Longint"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestIntegerOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i,j,k:longint;');
+  Add('begin');
+  Add('  i:=1;');
+  Add('  i:=1+2;');
+  Add('  i:=1+2+3;');
+  Add('  i:=1-2;');
+  Add('  i:=j;');
+  Add('  i:=j+1;');
+  Add('  i:=-j+1;');
+  Add('  i:=j+k;');
+  Add('  i:=-j+k;');
+  Add('  i:=j*k;');
+  Add('  i:=j**k;');
+  Add('  i:=10**3;');
+  Add('  i:=j div k;');
+  Add('  i:=10 div 3;');
+  Add('  i:=j mod k;');
+  Add('  i:=10 mod 3;');
+  Add('  i:=j shl k;');
+  Add('  i:=j shr k;');
+  Add('  i:=j and k;');
+  Add('  i:=j or k;');
+  Add('  i:=j and not k;');
+  Add('  i:=(j+k) div 3;');
+  Add('  if i=j then;');
+  Add('  if i<>j then;');
+  Add('  if i>j then;');
+  Add('  if i>=j then;');
+  Add('  if i<j then;');
+  Add('  if i<=j then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestBooleanOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i,j,k:boolean;');
+  Add('begin');
+  Add('  i:=false;');
+  Add('  i:=true;');
+  Add('  i:=j and k;');
+  Add('  i:=j or k;');
+  Add('  i:=j or not k;');
+  Add('  i:=(not j) or k;');
+  Add('  i:=j or false;');
+  Add('  i:=j and true;');
+  Add('  i:=j xor k;');
+  Add('  i:=j=k;');
+  Add('  i:=j<>k;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStringOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i,j:string;');
+  Add('  k:char;');
+  Add('begin');
+  Add('  i:='''';');
+  Add('  i:=''''+'''';');
+  Add('  i:=k+'''';');
+  Add('  i:=''''+k;');
+  Add('  i:=''a''+j;');
+  Add('  i:=''abc''+j;');
+  Add('  k:=j;');
+  Add('  k:=''a'';');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestFloatOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i,j,k:double;');
+  Add('  o,p:longint;');
+  Add('begin');
+  Add('  i:=1;');
+  Add('  i:=1+2;');
+  Add('  i:=1+2+3;');
+  Add('  i:=1-2;');
+  Add('  i:=j;');
+  Add('  i:=j+1;');
+  Add('  i:=-j+1;');
+  Add('  i:=j+k;');
+  Add('  i:=-j+k;');
+  Add('  i:=j*k;');
+  Add('  i:=10/3;');
+  Add('  i:=10.0/3;');
+  Add('  i:=10/3.0;');
+  Add('  i:=10.0/3.0;');
+  Add('  i:=j/k;');
+  Add('  i:=o/p;');
+  Add('  i:=10**3;');
+  Add('  i:=10.0**3;');
+  Add('  i:=10.0**3.0;');
+  Add('  i:=10**3.0;');
+  Add('  i:=j**k;');
+  Add('  i:=o**p;');
+  Add('  i:=(j+k)/3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestCAssignments;
+begin
+  StartProgram(false);
+  Parser.Options:=Parser.Options+[po_cassignments];
+  Scanner.Options:=Scanner.Options+[po_cassignments];
+  Add('Type');
+  Add('  TFlag = (Flag1,Flag2);');
+  Add('  TFlags = set of TFlag;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  c: char;');
+  Add('  s: string;');
+  Add('  d: double;');
+  Add('  f: TFlag;');
+  Add('  fs: TFlags;');
+  Add('begin');
+  Add('  i+=1;');
+  Add('  i-=2;');
+  Add('  i*=3;');
+  Add('  s+=''A'';');
+  Add('  s:=c;');
+  Add('  d+=4;');
+  Add('  d-=5;');
+  Add('  d*=6;');
+  Add('  d/=7;');
+  Add('  d+=8.5;');
+  Add('  d-=9.5;');
+  Add('  d*=10.5;');
+  Add('  d/=11.5;');
+  Add('  fs+=[f];');
+  Add('  fs-=[f];');
+  Add('  fs*=[f];');
+  Add('  fs+=[Flag1];');
+  Add('  fs-=[Flag1];');
+  Add('  fs*=[Flag1];');
+  Add('  fs+=[Flag1,Flag2];');
+  Add('  fs-=[Flag1,Flag2];');
+  Add('  fs*=[Flag1,Flag2];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTypeCastBaseTypes;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  si: smallint;');
+  Add('  i: longint;');
+  Add('  fs: single;');
+  Add('  d: double;');
+  Add('  b: boolean;');
+  Add('  c: char;');
+  Add('  s: char;');
+  Add('begin');
+  Add('  d:=double({#a_read}i);');
+  Add('  i:=shortint({#b_read}i);');
+  Add('  i:=longint({#c_read}si);');
+  Add('  d:=double({#d_read}d);');
+  Add('  fs:=single({#e_read}d);');
+  Add('  d:=single({#f_read}d);');
+  Add('  b:=longbool({#g_read}b);');
+  Add('  b:=bytebool({#i_read}longbool({#h_read}b));');
+  Add('  d:=double({#j_read}i)/2.5;');
+  Add('  b:=boolean({#k_read}i);');
+  Add('  i:=longint({#l_read}b);');
+  Add('  d:=double({#m_read}i);');
+  Add('  c:=char({#n_read}c);');
+  Add('  s:=string({#o_read}s);');
+  Add('  s:=string({#p_read}c);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestTypeCastAliasBaseTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TCaption = string;');
+  Add('  TYesNo = boolean;');
+  Add('  TFloat = double;');
+  Add('  TChar = char;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  i:=integer({#a_read}i);');
+  Add('  i:=integer({#h_read}b);');
+  Add('  s:=TCaption({#b_read}s);');
+  Add('  s:=TCaption({#g_read}c);');
+  Add('  b:=TYesNo({#c_read}b);');
+  Add('  b:=TYesNo({#d_read}i);');
+  Add('  d:=TFloat({#e_read}d);');
+  Add('  c:=TChar({#f_read}c);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestTypeCastStrToIntFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=longint(s);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastStrToCharFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  c:=char(s);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastIntToStrFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  s:=string(i);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastDoubleToStrFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  d: double;');
+  Add('begin');
+  Add('  s:=string(d);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastDoubleToIntFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('  d: double;');
+  Add('begin');
+  Add('  i:=longint(d);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastDoubleToBoolFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('begin');
+  Add('  b:=longint(d);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestTypeCastBooleanToDoubleFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('begin');
+  Add('  d:=double(b);');
+  CheckResolverException(sIllegalTypeConversionTo,nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestAssign_Access;
+begin
+  StartProgram(false);
+  Parser.Options:=Parser.Options+[po_cassignments];
+  Scanner.Options:=Scanner.Options+[po_cassignments];
+  Add('var i: longint;');
+  Add('begin');
+  Add('  {#a1_assign}i:={#a2_read}i;');
+  Add('  {#b1_readandassign}i+={#b2_read}i;');
+  Add('  {#c1_readandassign}i-={#c2_read}i;');
+  Add('  {#d1_readandassign}i*={#d2_read}i;');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestAssignedIntFail;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  if Assigned(i) then ;');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "class or array"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestHighLow;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  bo: boolean;');
+  Add('  by: byte;');
+  Add('  ch: char;');
+  Add('begin');
+  Add('  for bo:=low(boolean) to high(boolean) do;');
+  Add('  for by:=low(byte) to high(byte) do;');
+  Add('  for ch:=low(char) to high(char) do;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStr_BaseTypes;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  b: boolean;');
+  Add('  i: longint;');
+  Add('  i64: int64;');
+  Add('  s: single;');
+  Add('  d: double;');
+  Add('  aString: string;');
+  Add('  r: record end;');
+  Add('begin');
+  Add('  Str(b,{#a_var}aString);');
+  Add('  Str(b:1,aString);');
+  Add('  Str(b:i,aString);');
+  Add('  Str(i,aString);');
+  Add('  Str(i:2,aString);');
+  Add('  Str(i:i64,aString);');
+  Add('  Str(i64,aString);');
+  Add('  Str(i64:3,aString);');
+  Add('  Str(i64:i,aString);');
+  Add('  Str(s,aString);');
+  Add('  Str(d,aString);');
+  Add('  Str(d:4,aString);');
+  Add('  Str(d:4:5,aString);');
+  Add('  Str(d:4:i,aString);');
+  Add('  aString:=Str(b);');
+  Add('  aString:=Str(i:3);');
+  Add('  aString:=Str(d:3:4);');
+  Add('  aString:=Str(b,i,d);');
+  Add('  aString:=Str(s,''foo'');');
+  Add('  aString:=Str(i,{#assign_read}aString);');
+  Add('  while true do Str(i,{#whiledo_var}aString);');
+  Add('  repeat Str(i,{#repeat_var}aString); until true;');
+  Add('  if true then Str(i,{#ifthen_var}aString) else Str(i,{#ifelse_var}aString);');
+  Add('  for i:=0 to 0 do Str(i,{#fordo_var}aString);');
+  Add('  with r do Str(i,{#withdo_var}aString);');
+  Add('  case Str(s,''caseexpr'') of');
+  Add('  ''bar'': Str(i,{#casest_var}aString);');
+  Add('  else Str(i,{#caseelse_var}aString);');
+  Add('  end;');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestStr_StringFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  aString: string;');
+  Add('begin');
+  Add('  Str(aString,aString);');
+  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "boolean, integer, enum value"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestStr_CharFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  aString: string;');
+  Add('begin');
+  Add('  Str(c,aString);');
+  CheckResolverException('Incompatible type arg no. 1: Got "Char", expected "boolean, integer, enum value"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestIncDec;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  inc({#a_var}i);');
+  Add('  inc({#b_var}i,2);');
+  Add('  dec({#c_var}i);');
+  Add('  dec({#d_var}i,3);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestIncStringFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: string;');
+  Add('begin');
+  Add('  inc(i);');
+  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "integer"',nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestTypeInfo;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TRec = record',
+  '    v: integer;',
+  '  end;',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '    class function ClassType: TClass; virtual; abstract;',
+  '  end;',
+  'var',
+  '  i: integer;',
+  '  s: string;',
+  '  p: pointer;',
+  '  r: TRec;',
+  '  o: TObject;',
+  '  c: TClass;',
+  'begin',
+  '  p:=typeinfo(integer);',
+  '  p:=typeinfo(longint);',
+  '  p:=typeinfo(i);',
+  '  p:=typeinfo(s);',
+  '  p:=typeinfo(p);',
+  '  p:=typeinfo(r.v);',
+  '  p:=typeinfo(TObject.ClassType);',
+  '  p:=typeinfo(o.ClassType);',
+  '  p:=typeinfo(o);',
+  '  p:=typeinfo(c);',
+  '  p:=typeinfo(c.ClassType);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestForLoop;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#v1}v1,{#v2}v2,{#v3}v3:longint;');
+  Add('begin');
+  Add('  for {@v1}v1:=');
+  Add('    {@v2}v2');
+  Add('    to {@v3}v3 do ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStatements;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v1,v2,v3:longint;');
+  Add('begin');
+  Add('  v1:=1;');
+  Add('  v2:=v1+v1*v1+v1 div v1;');
+  Add('  v3:=-v1;');
+  Add('  repeat');
+  Add('    v1:=v1+1;');
+  Add('  until v1>=5;');
+  Add('  while v1>=0 do');
+  Add('    v1:=v1-v2;');
+  Add('  for v1:=v2 to v3 do v2:=v1;');
+  Add('  if v1<v2 then v3:=v1 else v3:=v2;');
+  ParseProgram;
+  AssertEquals('3 declarations',3,PasProgram.ProgramSection.Declarations.Count);
+end;
+
+procedure TTestResolver.TestCaseStatement;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  {#c1}c1=1;');
+  Add('  {#c2}c2=1;');
+  Add('var');
+  Add('  {#v1}v1,{#v2}v2,{#v3}v3:longint;');
+  Add('begin');
+  Add('  Case {@v1}v1+{@v2}v2 of');
+  Add('  {@c1}c1:');
+  Add('    {@v2}v2:={@v3}v3;');
+  Add('  {@c1}c1,{@c2}c2: ;');
+  Add('  {@c1}c1..{@c2}c2: ;');
+  Add('  {@c1}c1+{@c2}c2: ;');
+  Add('  else');
+  Add('    {@v1}v1:=3;');
+  Add('  end;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTryStatement;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  {#Exec}Exception = class end;');
+  Add('var');
+  Add('  {#v1}v1,{#e1}e:longint;');
+  Add('begin');
+  Add('  try');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  finally');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  end');
+  Add('  try');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  except');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('    raise;');
+  Add('  end');
+  Add('  try');
+  Add('    {@v1}v1:={@e1}e;');
+  Add('  except');
+  Add('    on {#e2}{=Exec}E: Exception do');
+  Add('      if {@e2}e=nil then raise;');
+  Add('    on {#e3}{=Exec}E: Exception do');
+  Add('      raise {@e3}e;');
+  Add('    else');
+  Add('      {@v1}v1:={@e1}e;');
+  Add('  end');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTryExceptOnNonTypeFail;
+begin
+  StartProgram(false);
+  Add('type TObject = class end;');
+  Add('var E: TObject;');
+  Add('begin');
+  Add('  try');
+  Add('  except');
+  Add('    on E do ;');
+  Add('  end;');
+  CheckParserException('Expected type, but got variable',PParser.nParserExpectedTypeButGot);
+end;
+
+procedure TTestResolver.TestTryExceptOnNonClassFail;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  try');
+  Add('  except');
+  Add('    on longint do ;');
+  Add('  end;');
+  CheckResolverException('class expected, but Longint found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestRaiseNonVarFail;
+begin
+  StartProgram(false);
+  Add('type TObject = class end;');
+  Add('begin');
+  Add('  raise TObject;');
+  CheckResolverException('variable expected, but class found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestRaiseNonClassFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  E: longint;');
+  Add('begin');
+  Add('  raise E;');
+  CheckResolverException('class expected, but Longint found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestRaiseDescendant;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualNewInstance: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create(Msg: string); external name ''ext'';');
+  Add('  end;');
+  Add('  Exception = class end;');
+  Add('  EConvertError = class(Exception) end;');
+  Add('begin');
+  Add('  raise Exception.{#a}Create(''foo'');');
+  Add('  raise EConvertError.{#b}Create(''bar'');');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestRaiseDescendant ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualNewInstance:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestRaiseDescendant ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestRaiseDescendant ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if (Ref.Declaration is TPasConstructor) then
+          ActualNewInstance:=rrfNewInstance in Ref.Flags;
+        break;
+        end;
+      if not ActualNewInstance then
+        RaiseErrorAtSrcMarker('expected newinstance at "#'+aMarker^.Identifier+', but got normal call"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestStatementsRefs;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#v1}v1,{#v2}v2,{#v3}v3:longint;');
+  Add('begin');
+  Add('  {@v1}v1:=1;');
+  Add('  {@v2}v2:=');
+  Add('    {@v1}v1+');
+  Add('    {@v1}v1*{@v1}v1');
+  Add('    +{@v1}v1 div {@v1}v1;');
+  Add('  {@v3}v3:=');
+  Add('    -{@v1}v1;');
+  Add('  repeat');
+  Add('    {@v1}v1:=');
+  Add('      {@v1}v1+1;');
+  Add('  until {@v1}v1>=5;');
+  Add('  while {@v1}v1>=0 do');
+  Add('    {@v1}v1');
+  Add('    :={@v1}v1-{@v2}v2;');
+  Add('  if {@v1}v1<{@v2}v2 then');
+  Add('    {@v3}v3:={@v1}v1');
+  Add('  else {@v3}v3:=');
+  Add('    {@v2}v2;');
+  ParseProgram;
+  AssertEquals('3 declarations',3,PasProgram.ProgramSection.Declarations.Count);
+end;
+
+procedure TTestResolver.TestRepeatUntilNonBoolFail;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  repeat');
+  Add('  until 3;');
+  CheckResolverException('Boolean expected, but Longint found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestWhileDoNonBoolFail;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  while 3 do ;');
+  CheckResolverException('Boolean expected, but Longint found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestIfThenNonBoolFail;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  if 3 then ;');
+  CheckResolverException('Boolean expected, but Longint found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestForLoopVarNonVarFail;
+begin
+  StartProgram(false);
+  Add('const i = 3;');
+  Add('begin');
+  Add('  for i:=1 to 2 do ;');
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestForLoopStartIncompFail;
+begin
+  StartProgram(false);
+  Add('var i: char;');
+  Add('begin');
+  Add('  for i:=1 to 2 do ;');
+  CheckResolverException('Incompatible types: got "Longint" expected "Char"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestForLoopEndIncompFail;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  for i:=1 to ''2'' do ;');
+  CheckResolverException('Incompatible types: got "Char" expected "Longint"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestCaseOf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (red,green,blue);');
+  Add('var');
+  Add('  i: longint;');
+  Add('  f: TFlag;');
+  Add('  b: boolean;');
+  Add('  c: char;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  case i of');
+  Add('  1: ;');
+  Add('  2..3: ;');
+  Add('  4,5..6,7: ;');
+  Add('  else');
+  Add('  end;');
+  Add('  case f of');
+  Add('  red: ;');
+  Add('  red..green: ;');
+  Add('  end;');
+  Add('  case b of');
+  Add('  true: ;');
+  Add('  false: ;');
+  Add('  end;');
+  Add('  case c of');
+  Add('  #0: ;');
+  Add('  #10,#13: ;');
+  Add('  ''0''..''9'',''a''..''z'': ;');
+  Add('  end;');
+  Add('  case s of');
+  Add('  #10: ;');
+  Add('  ''abc'': ;');
+  Add('  end;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestCaseExprNonOrdFail;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  case longint of');
+  Add('  1: ;');
+  Add('  end;');
+  CheckResolverException('ordinal expression expected, but Longint found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestCaseIncompatibleValueFail;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  case i of');
+  Add('  ''1'': ;');
+  Add('  end;');
+  CheckResolverException('Incompatible types: got "Char" expected "Longint"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestSimpleStatement_VarFail;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  i;');
+  CheckResolverException('Illegal expression',nIllegalExpression);
+end;
+
+procedure TTestResolver.TestUnitOverloads;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#ADecl}DoIt(vI: longint);');
+  Add('procedure {#BDecl}DoIt(vI, vJ: longint);');
+  Add('implementation');
+  Add('procedure {#EDecl}DoIt(vI, vJ, vK, vL, vM: longint); forward;');
+  Add('procedure {#C}DoIt(vI, vJ, vK: longint); begin end;');
+  Add('procedure {#AImpl}DoIt(vi: longint); begin end;');
+  Add('procedure {#D}DoIt(vI, vJ, vK, vL: longint); begin end;');
+  Add('procedure {#BImpl}DoIt(vi, vj: longint); begin end;');
+  Add('procedure {#EImpl}DoIt(vi, vj, vk, vl, vm: longint); begin end;');
+  Add('begin');
+  Add('  {@ADecl}DoIt(1);');
+  Add('  {@BDecl}DoIt(2,3);');
+  Add('  {@C}DoIt(4,5,6);');
+  Add('  {@D}DoIt(7,8,9,10);');
+  Add('  {@EDecl}DoIt(11,12,13,14,15);');
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestUnitIntfInitialization;
+var
+  El, DeclEl, OtherUnit: TPasElement;
+  LocalVar: TPasVariable;
+  Assign1, Assign2, Assign3: TPasImplAssign;
+  Prim1, Prim2: TPrimitiveExpr;
+  BinExp: TBinaryExpr;
+begin
+  StartUnit(true);
+  Add('interface');
+  Add('var exitCOde: string;');
+  Add('implementation');
+  Add('initialization');
+  Add('  ExitcodE:=''1'';');
+  Add('  afile.eXitCode:=''2'';');
+  Add('  System.exiTCode:=3;');
+  ParseUnit;
+
+  // interface
+  AssertEquals('1 intf declaration',1,Module.InterfaceSection.Declarations.Count);
+  El:=TPasElement(Module.InterfaceSection.Declarations[0]);
+  AssertEquals('local var',TPasVariable,El.ClassType);
+  LocalVar:=TPasVariable(El);
+  AssertEquals('local var exitcode','exitCOde',LocalVar.Name);
+
+  // initialization
+  AssertEquals('3 initialization statements',3,Module.InitializationSection.Elements.Count);
+
+  // check direct assignment to local var
+  El:=TPasElement(Module.InitializationSection.Elements[0]);
+  AssertEquals('direct assign',TPasImplAssign,El.ClassType);
+  Assign1:=TPasImplAssign(El);
+  AssertEquals('direct assign left',TPrimitiveExpr,Assign1.left.ClassType);
+  Prim1:=TPrimitiveExpr(Assign1.left);
+  AssertNotNull(Prim1.CustomData);
+  AssertEquals('direct assign left ref',TResolvedReference,Prim1.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
+  AssertSame('direct assign local var',LocalVar,DeclEl);
+
+  // check indirect assignment to local var: "afile.eXitCode"
+  El:=TPasElement(Module.InitializationSection.Elements[1]);
+  AssertEquals('indirect assign',TPasImplAssign,El.ClassType);
+  Assign2:=TPasImplAssign(El);
+  AssertEquals('indirect assign left',TBinaryExpr,Assign2.left.ClassType);
+  BinExp:=TBinaryExpr(Assign2.left);
+  AssertEquals('indirect assign first token',TPrimitiveExpr,BinExp.left.ClassType);
+  Prim1:=TPrimitiveExpr(BinExp.left);
+  AssertEquals('indirect assign first token','afile',Prim1.Value);
+  AssertNotNull(Prim1.CustomData);
+  AssertEquals('indirect assign unit ref resolved',TResolvedReference,Prim1.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
+  AssertSame('indirect assign unit ref',Module,DeclEl);
+
+  AssertEquals('indirect assign dot',eopSubIdent,BinExp.OpCode);
+
+  AssertEquals('indirect assign second token',TPrimitiveExpr,BinExp.right.ClassType);
+  Prim2:=TPrimitiveExpr(BinExp.right);
+  AssertEquals('indirect assign second token','eXitCode',Prim2.Value);
+  AssertNotNull(Prim2.CustomData);
+  AssertEquals('indirect assign var ref resolved',TResolvedReference,Prim2.CustomData.ClassType);
+  AssertEquals('indirect assign left ref',TResolvedReference,Prim2.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim2.CustomData).Declaration;
+  AssertSame('indirect assign local var',LocalVar,DeclEl);
+
+  // check assignment to "system.ExitCode"
+  El:=TPasElement(Module.InitializationSection.Elements[2]);
+  AssertEquals('other unit assign',TPasImplAssign,El.ClassType);
+  Assign3:=TPasImplAssign(El);
+  AssertEquals('other unit assign left',TBinaryExpr,Assign3.left.ClassType);
+  BinExp:=TBinaryExpr(Assign3.left);
+  AssertEquals('othe unit assign first token',TPrimitiveExpr,BinExp.left.ClassType);
+  Prim1:=TPrimitiveExpr(BinExp.left);
+  AssertEquals('other unit assign first token','System',Prim1.Value);
+  AssertNotNull(Prim1.CustomData);
+  AssertEquals('other unit assign unit ref resolved',TResolvedReference,Prim1.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim1.CustomData).Declaration;
+  OtherUnit:=DeclEl;
+  AssertEquals('other unit assign unit ref',TPasUsesUnit,DeclEl.ClassType);
+  AssertEquals('other unit assign unit ref system','system',lowercase(DeclEl.Name));
+
+  AssertEquals('other unit assign dot',eopSubIdent,BinExp.OpCode);
+
+  AssertEquals('other unit assign second token',TPrimitiveExpr,BinExp.right.ClassType);
+  Prim2:=TPrimitiveExpr(BinExp.right);
+  AssertEquals('other unit assign second token','exiTCode',Prim2.Value);
+  AssertNotNull(Prim2.CustomData);
+  AssertEquals('other unit assign var ref resolved',TResolvedReference,Prim2.CustomData.ClassType);
+  AssertEquals('other unit assign left ref',TResolvedReference,Prim2.CustomData.ClassType);
+  DeclEl:=TResolvedReference(Prim2.CustomData).Declaration;
+  AssertEquals('other unit assign var',TPasVariable,DeclEl.ClassType);
+  AssertEquals('other unit assign var exitcode','exitcode',lowercase(DeclEl.Name));
+  AssertSame('other unit assign var exitcode',(OtherUnit as TPasUsesUnit).Module,DeclEl.GetModule);
+end;
+
+procedure TTestResolver.TestUnitUseIntf;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type TListCallBack = procedure;',
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('type TListCB = unit2.tlistcallback;');
+  Add('begin');
+  Add('  if i=2 then');
+  Add('    DoIt;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnitUseImplFail;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  DoIt;');
+  CheckResolverException('identifier not found "DoIt"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestUnit_DuplicateUsesFail;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses unit2, unit2;');
+  Add('begin');
+  Add('  i:=3;');
+  CheckParserException('Duplicate identifier "unit2"',
+    nParserDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestUnit_NestedFail;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i2: longint;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unit1;',
+  'begin',
+  '  if j1=0 then ;',
+  '  if i2=0 then ;',
+  '']);
+  CheckResolverException('identifier not found "i2"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestUnitUseDotted;
+begin
+  AddModuleWithIntfImplSrc('ns1.unit2.pp',
+    LinesToStr([
+    'var i2: longint;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('ns2.ns2A.unit1.pp',
+    LinesToStr([
+    'uses ns1.unit2;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses ns2.ns2A.unit1;',
+  'begin',
+  '  if j1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_ProgramDefaultNamespace;
+begin
+  MainFilename:='ns1.main1.pas';
+
+  AddModuleWithIntfImplSrc('ns1.unit2.pp',
+    LinesToStr([
+    'var i2: longint;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('ns1.unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unit1;',
+  'begin',
+  '  if j1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_DottedIdentifier;
+begin
+  MainFilename:='unitdots.main1.pas';
+
+  AddModuleWithIntfImplSrc('unitdots.unit1.pp',
+    LinesToStr([
+    'type TColor = longint;',
+    'var i1: longint;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('unitdots.pp',
+    LinesToStr([
+    'type TBright = longint;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unitdots.unit1, unitdots;',
+  'type',
+  '  TPrgBright = unitdots.tbright;',
+  '  TPrgColor = unitdots.unit1.tcolor;',
+  '  TStrange = unitdots.main1.tprgcolor;',
+  'var k1: longint;',
+  'begin',
+  '  if unitdots.main1.k1=0 then ;',
+  '  if unitdots.j1=0 then ;',
+  '  if unitdots.unit1.i1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_DottedPrg;
+begin
+  MainFilename:='unitdots.main1.pas';
+
+  AddModuleWithIntfImplSrc('unitdots.unit1.pp',
+    LinesToStr([
+    'type TColor = longint;',
+    'var i1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses UnIt1;',
+  'type',
+  '  TPrgColor = UNIT1.tcolor;',
+  '  TStrange = UnitDots.Main1.tprgcolor;',
+  'var k1: longint;',
+  'begin',
+  '  if unitdots.main1.k1=0 then ;',
+  '  if unit1.i1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_DottedUnit;
+begin
+  MainFilename:='unitdots.unit1.pas';
+  StartUnit(false);
+  Add([
+  'interface',
+  'var k1: longint;',
+  'implementation',
+  'initialization',
+  '  if unitDots.Unit1.k1=0 then ;',
+  '']);
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestUnit_DottedExpr;
+begin
+  MainFilename:='unitdots1.sub1.main1.pas';
+
+  AddModuleWithIntfImplSrc('unitdots2.sub2.unit2.pp',
+    LinesToStr([
+    'procedure DoIt; external name ''$DoIt'';']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('unitdots3.sub3.unit3.pp',
+    LinesToStr([
+    'procedure DoSome;']),
+    LinesToStr([
+    'uses unitdots2.sub2.unit2;',
+    'procedure DoSome;',
+    'begin',
+    '  unitdots2.sub2.unit2.doit;',
+    'end;']));
+
+  StartProgram(true);
+  Add([
+  'uses unitdots3.sub3.unit3;',
+  'begin',
+  '  unitdots3.sub3.unit3.dosome;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestUnit_DuplicateDottedUsesFail;
+begin
+  AddModuleWithIntfImplSrc('ns.unit2.pp',
+    LinesToStr([
+    'var i: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses ns.unit2, ns.unit2;');
+  Add('begin');
+  Add('  i:=3;');
+  CheckParserException('Duplicate identifier "ns.unit2"',
+    nParserDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestUnit_DuplicateUsesDiffNameFail;
+begin
+  MainFilename:='unitdots.main1.pas';
+  AddModuleWithIntfImplSrc('unitdots.unit1.pp',
+    LinesToStr([
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unitdots.unit1, unit1;',
+  'var k1: longint;',
+  'begin',
+  '  if unitdots.main1.k1=0 then ;',
+  '  if unit1.j1=0 then ;',
+  '  if unitdots.unit1.j1=0 then ;',
+  '']);
+  CheckResolverException('Duplicate identifier "unitdots.unit1" at unitdots.main1.pas(2,13)',
+    nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestUnit_Unit1DotUnit2Fail;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'var i1: longint;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'uses unit1;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'begin',
+  '  if unit2.unit1.i1=0 then ;',
+  '']);
+  CheckResolverException('identifier not found "unit1"',
+    nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestUnit_InFilename;
+begin
+  exit;
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'uses unit1;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses foo in ''unit2.pas'';',
+  'begin',
+  '  if foo.i1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('procedure Proc1(a: integer);');
+  Add('begin');
+  Add('  a:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcParamAccess;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('procedure DoIt(vI: integer; const vJ: integer; var vK: integer);');
+  Add('var vL: integer;');
+  Add('begin');
+  Add('  vi:=vi+1;');
+  Add('  vl:=vj+1;');
+  Add('  vk:=vk+1;');
+  Add('  vl:=vl+1;');
+  Add('  DoIt(vi,vi,vi);');
+  Add('  DoIt(vj,vj,vl);');
+  Add('  DoIt(vk,vk,vk);');
+  Add('  DoIt(vl,vl,vl);');
+  Add('end;');
+  Add('var i: integer;');
+  Add('begin');
+  Add('  DoIt(i,i,i);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestFunctionResult;
+begin
+  StartProgram(false);
+  Add('function Func1: longint;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcedureResultFail;
+begin
+  StartProgram(false);
+  Add('procedure A: longint; begin end;');
+  Add('begin');
+  CheckParserException('Expected ";"',
+    nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestProcOverload;
+var
+  El: TPasElement;
+begin
+  StartProgram(false);
+  Add('function Func1(i: longint; j: longint = 0): longint; overload;');
+  Add('begin');
+  Add('  Result:=1;');
+  Add('end;');
+  Add('function Func1(s: string): longint; overload;');
+  Add('begin');
+  Add('  Result:=2;');
+  Add('end;');
+  Add('begin');
+  Add('  Func1(3);');
+  ParseProgram;
+  AssertEquals('2 declarations',2,PasProgram.ProgramSection.Declarations.Count);
+
+  El:=TPasElement(PasProgram.ProgramSection.Declarations[0]);
+  AssertEquals('is function',TPasFunction,El.ClassType);
+
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+end;
+
+procedure TTestResolver.TestProcOverloadWithBaseTypes;
+begin
+  StartProgram(false);
+  Add('function {#A}Func1(i: longint; j: longint = 0): longint; overload;');
+  Add('begin');
+  Add('  Result:=1;');
+  Add('end;');
+  Add('function {#B}Func1(s: string): longint; overload;');
+  Add('begin');
+  Add('  Result:=2;');
+  Add('end;');
+  Add('begin');
+  Add('  {@A}Func1(3);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadWithBaseTypes2;
+begin
+  StartProgram(false);
+  Add('procedure {#byte}DoIt(p: byte); external;  var by: byte;');
+  Add('procedure {#shortint}DoIt(p: shortint); external;  var shi: shortint;');
+  Add('procedure {#word}DoIt(p: word); external;  var w: word;');
+  Add('procedure {#smallint}DoIt(p: smallint); external;  var smi: smallint;');
+  Add('procedure {#longword}DoIt(p: longword); external;  var lw: longword;');
+  Add('procedure {#longint}DoIt(p: longint); external;  var li: longint;');
+  Add('procedure {#qword}DoIt(p: qword); external;  var qw: qword;');
+  Add('procedure {#int64}DoIt(p: int64); external;  var i6: int64;');
+  Add('procedure {#comp}DoIt(p: comp); external;  var co: comp;');
+  Add('procedure {#boolean}DoIt(p: boolean); external;  var bo: boolean;');
+  Add('procedure {#char}DoIt(p: char); external;  var ch: char;');
+  Add('procedure {#widechar}DoIt(p: widechar); external;  var wc: widechar;');
+  Add('procedure {#string}DoIt(p: string); external;  var st: string;');
+  Add('procedure {#widestring}DoIt(p: widestring); external;  var ws: widestring;');
+  Add('procedure {#shortstring}DoIt(p: shortstring); external;  var ss: shortstring;');
+  Add('procedure {#unicodestring}DoIt(p: unicodestring); external;  var us: unicodestring;');
+  Add('procedure {#rawbytestring}DoIt(p: rawbytestring); external;  var rs: rawbytestring;');
+  Add('begin');
+  Add('  {@byte}DoIt(by);');
+  Add('  {@shortint}DoIt(shi);');
+  Add('  {@word}DoIt(w);');
+  Add('  {@smallint}DoIt(smi);');
+  Add('  {@longword}DoIt(lw);');
+  Add('  {@longint}DoIt(li);');
+  Add('  {@qword}DoIt(qw);');
+  Add('  {@int64}DoIt(i6);');
+  Add('  {@comp}DoIt(co);');
+  Add('  {@boolean}DoIt(bo);');
+  Add('  {@char}DoIt(ch);');
+  Add('  {@widechar}DoIt(wc);');
+  Add('  {@string}DoIt(st);');
+  Add('  {@widestring}DoIt(ws);');
+  Add('  {@shortstring}DoIt(ss);');
+  Add('  {@unicodestring}DoIt(us);');
+  Add('  {@rawbytestring}DoIt(rs);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadNearestHigherPrecision;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#longint}DoIt(i: longint); external;',
+  'procedure DoIt(i: int64); external;',
+  'var w: word;',
+  'begin',
+  '  {@longint}DoIt(w);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcCallLowPrecision;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#longint}DoIt(i: longint); external;',
+  'var i: int64;',
+  'begin',
+  '  {@longint}DoIt(i);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadMultiLowPrecisionFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(i: longint); external;',
+  'procedure DoIt(w: longword); external;',
+  'var i: int64;',
+  'begin',
+  '  DoIt(i);',
+  '']);
+  CheckResolverException('Can''t determine which overloaded function to call, afile.pp(3,14), afile.pp(2,14)',
+    nCantDetermineWhichOverloadedFunctionToCall);
+end;
+
+procedure TTestResolver.TestProcOverloadWithClassTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class end;');
+  Add('  {#TA}TClassA = class end;');
+  Add('  {#TB}TClassB = class end;');
+  Add('procedure {#DoA}DoIt({=TA}p: TClassA); overload;');
+  Add('begin');
+  Add('end;');
+  Add('procedure {#DoB}DoIt({=TB}p: TClassB); overload;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#A}{=TA}A: TClassA;');
+  Add('  {#B}{=TB}B: TClassB;');
+  Add('begin');
+  Add('  {@DoA}DoIt({@A}A)');
+  Add('  {@DoB}DoIt({@B}B)');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadWithInhClassTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class end;');
+  Add('  {#TA}TClassA = class end;');
+  Add('  {#TB}TClassB = class(TClassA) end;');
+  Add('  {#TC}TClassC = class(TClassB) end;');
+  Add('procedure {#DoA}DoIt({=TA}p: TClassA); overload;');
+  Add('begin');
+  Add('end;');
+  Add('procedure {#DoB}DoIt({=TB}p: TClassB); overload;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#A}{=TA}A: TClassA;');
+  Add('  {#B}{=TB}B: TClassB;');
+  Add('  {#C}{=TC}C: TClassC;');
+  Add('begin');
+  Add('  {@DoA}DoIt({@A}A)');
+  Add('  {@DoB}DoIt({@B}B)');
+  Add('  {@DoB}DoIt({@C}C)');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadWithInhAliasClassTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class end;');
+  Add('  {#TA}TClassA = class end;');
+  Add('  {#TB}{=TA}TClassB = TClassA;');
+  Add('  {#TC}TClassC = class(TClassB) end;');
+  Add('procedure {#DoA}DoIt({=TA}p: TClassA); overload;');
+  Add('begin');
+  Add('end;');
+  Add('procedure {#DoC}DoIt({=TC}p: TClassC); overload;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#A}{=TA}A: TClassA;');
+  Add('  {#B}{=TB}B: TClassB;');
+  Add('  {#C}{=TC}C: TClassC;');
+  Add('begin');
+  Add('  {@DoA}DoIt({@A}A)');
+  Add('  {@DoA}DoIt({@B}B)');
+  Add('  {@DoC}DoIt({@C}C)');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcOverloadBaseTypeOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'procedure Val(var d: double);',
+    //'procedure Val(var i: integer);',
+    '']),
+    LinesToStr([
+    'procedure Val(var d: double); begin end;',
+    'procedure Val(var i: integer); begin end;',
+    '']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('var');
+  Add('  d: double;');
+  Add('  i: integer;');
+  Add('begin');
+  //Add('  Val(i);');
+  Add('  Val(d);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcDuplicate;
+begin
+  StartProgram(false);
+  Add('type integer = longint;');
+  Add('procedure ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcA(i: integer);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestNestedProc;
+begin
+  StartProgram(false);
+  Add('function DoIt({#a1}a,{#d1}d: longint): longint;');
+  Add('var');
+  Add('  {#b1}b: longint;');
+  Add('  {#c1}c: longint;');
+  Add('  function {#Nesty1}Nesty({#a2}a: longint): longint; ');
+  Add('  var {#b2}b: longint;');
+  Add('  begin');
+  Add('    Result:={@a2}a');
+  Add('      +{@b2}b');
+  Add('      +{@c1}c');
+  Add('      +{@d1}d;');
+  Add('  end;');
+  Add('begin');
+  Add('  Result:={@a1}a');
+  Add('      +{@b1}b');
+  Add('      +{@c1}c;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure {#A_forward}FuncA(i: longint); forward;');
+  Add('procedure {#B}FuncB(i: longint);');
+  Add('begin');
+  Add('  {@A_forward}FuncA(i);');
+  Add('end;');
+  Add('procedure {#A}FuncA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  {@A_forward}FuncA(3);');
+  Add('  {@B}FuncB(3);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestForwardProcUnresolved;
+begin
+  StartProgram(false);
+  Add('procedure FuncA(i: longint); forward;');
+  Add('begin');
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
+procedure TTestResolver.TestNestedForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure {#A}FuncA;');
+  Add('  procedure {#B_forward}ProcB(i: longint); forward;');
+  Add('  procedure {#C}ProcC(i: longint);');
+  Add('  begin');
+  Add('    {@B_forward}ProcB(i);');
+  Add('  end;');
+  Add('  procedure {#B}ProcB(i: longint);');
+  Add('  begin');
+  Add('  end;');
+  Add('begin');
+  Add('  {@B_forward}ProcB(3);');
+  Add('  {@C}ProcC(3);');
+  Add('end;');
+  Add('begin');
+  Add('  {@A}FuncA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestNestedForwardProcUnresolved;
+begin
+  StartProgram(false);
+  Add('procedure FuncA;');
+  Add('  procedure ProcB(i: longint); forward;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
+procedure TTestResolver.TestForwardProcFuncMismatch;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; forward;');
+  Add('function DoIt: longint;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('procedure expected, but function found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestForwardFuncResultMismatch;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint; forward;');
+  Add('function DoIt: string;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Result type mismatch, expected Longint, but found String',
+    nResultTypeMismatchExpectedButFound);
+end;
+
+procedure TTestResolver.TestUnitIntfProc;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#A_forward}FuncA({#Bar}Bar: longint);');
+  Add('implementation');
+  Add('procedure {#A}FuncA(bar: longint);');
+  Add('begin');
+  Add('  if {@Bar}bar=3 then ;');
+  Add('end;');
+  Add('initialization');
+  Add('  {@A_forward}FuncA(3);');
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestUnitIntfProcUnresolved;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#A_forward}FuncA(i: longint);');
+  Add('implementation');
+  Add('initialization');
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
+procedure TTestResolver.TestUnitIntfMismatchArgName;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure {#A_forward}ProcA(i: longint);');
+  Add('implementation');
+  Add('procedure {#A}ProcA(j: longint);');
+  Add('begin');
+  Add('end;');
+  CheckResolverException('function header "ProcA" doesn''t match forward : var name changes i => j',
+    nFunctionHeaderMismatchForwardVarName);
+end;
+
+procedure TTestResolver.TestProcOverloadIsNotFunc;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('var ProcA: longint;');
+  Add('procedure {#A_Decl}ProcA(i: longint);');
+  Add('implementation');
+  Add('procedure {#A_Impl}ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestProcCallMissingParams;
+begin
+  StartProgram(false);
+  Add('procedure Proc1(a: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  Proc1;');
+  CheckResolverException('Wrong number of parameters specified for call to "Proc1"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestProcArgDefaultValue;
+begin
+  StartProgram(false);
+  Add('const {#DefA}DefA = 3;');
+  Add('procedure Proc1(a: longint = {@DefA}DefA);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcArgDefaultValueTypeMismatch;
+begin
+  StartProgram(false);
+  Add('procedure Proc1(a: string = 3);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestProcPassConstToVar;
+begin
+  StartProgram(false);
+  Add('procedure DoSome(var i: longint); begin end;');
+  Add('procedure DoIt(const i: longint);');
+  Add('begin');
+  Add('  DoSome(i);');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Variable identifier expected',
+    nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestBuiltInProcCallMissingParams;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  length;');
+  CheckResolverException('Wrong number of parameters specified for call to "function Length(const String or Array): sizeint"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestAssignFunctionResult;
+begin
+  StartProgram(false);
+  Add('function {#F1}F1: longint;');
+  Add('begin');
+  Add('end;');
+  Add('function {#F2}F2: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var {#i}i: longint;');
+  Add('begin');
+  Add('  {@i}i:={@F1}F1();');
+  Add('  {@i}i:={@F1}F1()+{@F2}F2();');
+  Add('  {@i}i:={@F1}F1;');
+  Add('  {@i}i:={@F1}F1+{@F2}F2;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAssignProcResultFail;
+begin
+  StartProgram(false);
+  Add('procedure {#P}P;');
+  Add('begin');
+  Add('end;');
+  Add('var {#i}i: longint;');
+  Add('begin');
+  Add('  {@i}i:={@P}P();');
+  CheckResolverException('Incompatible types: got "Procedure/Function" expected "Longint"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestFunctionResultInCondition;
+begin
+  StartProgram(false);
+  Add('function {#F1}F1: longint;');
+  Add('begin');
+  Add('end;');
+  Add('function {#F2}F2: boolean;');
+  Add('begin');
+  Add('end;');
+  Add('var {#i}i: longint;');
+  Add('begin');
+  Add('  if {@F2}F2 then ;');
+  Add('  if {@i}i={@F1}F1() then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestExit;
+begin
+  StartProgram(false);
+  Add('procedure ProcA;');
+  Add('begin');
+  Add('  exit;');
+  Add('end;');
+  Add('function FuncB: longint;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(3);');
+  Add('end;');
+  Add('function FuncC: string;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(''a'');');
+  Add('  exit(''abc'');');
+  Add('end;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(4);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestBreak;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  repeat');
+  Add('    break;');
+  Add('  until false;');
+  Add('  while true do');
+  Add('    break;');
+  Add('  for i:=0 to 1 do');
+  Add('    break;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestContinue;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  repeat');
+  Add('    continue;');
+  Add('  until false;');
+  Add('  while true do');
+  Add('    continue;');
+  Add('  for i:=0 to 1 do');
+  Add('    continue;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcedureExternal;
+begin
+  StartProgram(false);
+  Add('procedure {#ProcA}ProcA; external ''ExtProcA'';');
+  Add('function {#FuncB}FuncB: longint; external ''ExtFuncB'';');
+  Add('function {#FuncC}FuncC(d: double): string; external ''ExtFuncC'';');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  {@ProcA}ProcA;');
+  Add('  i:={@FuncB}FuncB;');
+  Add('  i:={@FuncB}FuncB();');
+  Add('  s:={@FuncC}FuncC(1.2);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProc_UntypedParam_Forward;
+begin
+  StartProgram(false);
+  Add('procedure {#ProcA}ProcA(var {#A}A); forward;');
+  Add('procedure {#ProcB}ProcB(const {#B}B); forward;');
+  Add('procedure {#ProcC}ProcC(out {#C}C); forward;');
+  Add('procedure {#ProcD}ProcD(constref {#D}D); forward;');
+  Add('procedure ProcA(var A);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcB(const B);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcC(out C);');
+  Add('begin');
+  Add('end;');
+  Add('procedure ProcD(constref D);');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  {@ProcA}ProcA(i);');
+  Add('  {@ProcB}ProcB(i);');
+  Add('  {@ProcC}ProcC(i);');
+  Add('  {@ProcD}ProcD(i);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProc_Varargs;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(i:longint); varargs; external;');
+  Add('procedure ProcB; varargs; external;');
+  Add('procedure ProcC(i: longint = 17); varargs; external;');
+  Add('begin');
+  Add('  ProcA(1);');
+  Add('  ProcA(1,2);');
+  Add('  ProcA(1,2.0);');
+  Add('  ProcA(1,2,3);');
+  Add('  ProcA(1,''2'');');
+  Add('  ProcA(2,'''');');
+  Add('  ProcA(3,false);');
+  Add('  ProcB;');
+  Add('  ProcB();');
+  Add('  ProcB(4);');
+  Add('  ProcB(''foo'');');
+  Add('  ProcC;');
+  Add('  ProcC();');
+  Add('  ProcC(4);');
+  Add('  ProcC(5,''foo'');');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProc_ParameterExprAccess;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record');
+  Add('    a: longint;');
+  Add('  end;');
+  Add('procedure DoIt(i: longint; const j: longint; var k: longint; out l: longint);');
+  Add('begin');
+  Add('  DoIt({#loc1_read}i,{#loc2_read}i,{#loc3_var}i,{#loc4_out}i);');
+  Add('end;');
+  Add('var');
+  Add('  r: TRec;');
+  Add('begin');
+  Add('  DoIt({#r1_read}r.{#r_a1_read}a,');
+  Add('    {#r2_read}r.{#r_a2_read}a,');
+  Add('    {#r3_read}r.{#r_a3_var}a,');
+  Add('    {#r4_read}r.{#r_a4_out}a);');
+  Add('  with r do');
+  Add('    DoIt({#w_a1_read}a,');
+  Add('      {#w_a2_read}a,');
+  Add('      {#w_a3_var}a,');
+  Add('      {#w_a4_out}a);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestProc_FunctionResult_DeclProc;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  ResultEl: TPasResultElement;
+  Proc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function MethodA: longint;');
+  Add('  end;');
+  Add('function FuncA: longint; forward;');
+  Add('function TObject.MethodA: longint;');
+  Add('begin');
+  Add('  {#MethodA_Result}Result:=1;');
+  Add('end;');
+  Add('function FuncA: longint;');
+  Add('  function SubFuncA: longint; forward;');
+  Add('  function SubFuncB: longint;');
+  Add('  begin');
+  Add('    {#SubFuncB_Result}Result:=2;');
+  Add('  end;');
+  Add('  function SubFuncA: longint;');
+  Add('  begin');
+  Add('    {#SubFuncA_Result}Result:=3;');
+  Add('  end;');
+  Add('begin');
+  Add('  {#FuncA_Result}Result:=4;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        //writeln('TTestResolver.TestProc_FunctionResult_DeclProc ',GetObjName(Ref.Declaration));
+        if not (Ref.Declaration is TPasResultElement) then continue;
+        ResultEl:=TPasResultElement(Ref.Declaration);
+        Proc:=ResultEl.Parent as TPasProcedure;
+        ProcScope:=Proc.CustomData as TPasProcedureScope;
+        if ProcScope.DeclarationProc<>nil then
+          RaiseErrorAtSrcMarker('expected Result to resolve to declaration at "#'+aMarker^.Identifier+', but was implproc"',aMarker);
+        break;
+        end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestProc_TypeCastFunctionResult;
+begin
+  StartProgram(false);
+  Add('function GetIt: longint; begin end;');
+  Add('var s: smallint;');
+  Add('begin');
+  Add('   s:=smallint(GetIt);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecord;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordVariant;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('    case {#vari}vari: longint of');
+  Add('    0: ({#b}b: longint)');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@r}r.{@vari}vari:=4;');
+  Add('  {@r}r.{@b}b:=5;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecordVariantNested;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TRec}TRec = record');
+  Add('    {#Size}Size: longint;');
+  Add('    case {#vari}vari: longint of');
+  Add('    0: ({#b}b: longint)');
+  Add('    1: ({#c}c:');
+  Add('          record');
+  Add('            {#d}d: longint;');
+  Add('            case {#e}e: longint of');
+  Add('            0: ({#f}f: longint)');
+  Add('          end)');
+  Add('  end;');
+  Add('var');
+  Add('  {#r}{=TRec}r: TRec;');
+  Add('begin');
+  Add('  {@r}r.{@Size}Size:=3;');
+  Add('  {@r}r.{@vari}vari:=4;');
+  Add('  {@r}r.{@b}b:=5;');
+  Add('  {@r}r.{@c}c.{@d}d:=6;');
+  Add('  {@r}r.{@c}c.{@e}e:=7;');
+  Add('  {@r}r.{@c}c.{@f}f:=8;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestRecord_WriteConstParamFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TSmall = record');
+  Add('    Size: longint;');
+  Add('  end;');
+  Add('procedure DoIt(const S: TSmall);');
+  Add('begin');
+  Add('  S.Size:=3;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestRecord_WriteConstParam_WithFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TSmall = record');
+  Add('    Size: longint;');
+  Add('  end;');
+  Add('procedure DoIt(const S: TSmall);');
+  Add('begin');
+  Add('  with S do Size:=3;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestRecord_WriteNestedConstParamFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TSmall = record');
+  Add('    Size: longint;');
+  Add('  end;');
+  Add('  TBig = record');
+  Add('    Small: TSmall;');
+  Add('  end;');
+  Add('procedure DoIt(const B: TBig);');
+  Add('begin');
+  Add('  B.Small.Size:=3;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestRecord_WriteNestedConstParamWithFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TSmall = record');
+  Add('    Size: longint;');
+  Add('  end;');
+  Add('  TBig = record');
+  Add('    Small: TSmall;');
+  Add('  end;');
+  Add('procedure DoIt(const B: TBig);');
+  Add('begin');
+  Add('  with B do with Small do Size:=3;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestRecord_TypeCast;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TAnimal = record',
+  '    Size: longint;',
+  '  end;',
+  '  TBird = record',
+  '    Length: longint;',
+  '  end;',
+  'var',
+  '  a: TAnimal;',
+  '  b: TBird;',
+  'begin',
+  '  b:=TBird(a);',
+  '  TAnimal(b).Size:=TBird(a).Length;',
+  '  ']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#B}b: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#C}{=TOBJ}c: TObject;');
+  Add('begin');
+  Add('  {@C}c.{@b}b:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassDefaultInheritance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#OBJ_b}b: longint;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_c}c: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#V}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@V}v.{@A_c}c:=2;');
+  Add('  {@V}v.{@OBJ_b}b:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassTripleInheritance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#OBJ_a}a: longint;');
+  Add('    {#OBJ_b}b: longint;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_c}c: longint;');
+  Add('  end;');
+  Add('  {#B}TClassB = class(TClassA)');
+  Add('    {#B_d}d: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#V}{=B}v: TClassB;');
+  Add('begin');
+  Add('  {@V}v.{@B_d}d:=1;');
+  Add('  {@V}v.{@A_c}c:=2;');
+  Add('  {@V}v.{@OBJ_B}b:=3;');
+  Add('  {@V}v.{@Obj_a}a:=4;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassInheritanceCycleFail;
+begin
+  StartProgram(false);
+  Add([
+  'type A = class(A)',
+  'begin']);
+  CheckResolverException('Ancestor cycle detected',nAncestorCycleDetected);
+end;
+
+procedure TTestResolver.TestClassForward;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  {#B_forward}TClassB = class;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_b}{=B_forward}b: TClassB;');
+  Add('  end;');
+  Add('  {#B}TClassB = class(TClassA)');
+  Add('    {#B_a}a: longint;');
+  Add('    {#B_d}d: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#V}{=B}v: TClassB;');
+  Add('begin');
+  Add('  {@V}v.{@B_d}d:=1;');
+  Add('  {@V}v.{@B_a}a:=2;');
+  Add('  {@V}v.{@A_b}b:=nil;');
+  Add('  {@V}v.{@A_b}b.{@B_a}a:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassForwardAsAncestorFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class;');
+  Add('  TBird = class end;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  v: TBird;');
+  Add('begin');
+  CheckResolverException('Can''t use forward declaration "TObject" as ancestor',
+    nCantUseForwardDeclarationAsAncestor);
+end;
+
+procedure TTestResolver.TestClassForwardNotResolved;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassB = class;');
+  Add('var');
+  Add('  v: TClassB;');
+  Add('begin');
+  CheckResolverException(sForwardTypeNotResolved,
+    nForwardTypeNotResolved);
+end;
+
+procedure TTestResolver.TestClass_Method;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA_Decl}ProcA;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@V}v.{@A_ProcA_Decl}ProcA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_ConstructorMissingDotFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'constructor Create; begin end;',
+  'begin',
+  '']);
+  CheckResolverException('full method name expected, but short name found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestClass_MethodWithoutClassFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('identifier not found "TClassA"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestClass_MethodWithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#A}TObject = class');
+  Add('    procedure {#ProcA_Decl}ProcA({#Bar}Bar: longint);');
+  Add('  end;');
+  Add('procedure tobject.proca(bar: longint);');
+  Add('begin');
+  Add('  if {@Bar}bar=3 then ;');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=A}Obj: TObject;');
+  Add('begin');
+  Add('  {@V}Obj.{@ProcA_Decl}ProcA(4);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodUnresolvedPrg;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
+procedure TTestResolver.TestClass_MethodUnresolvedUnit;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('implementation');
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
+procedure TTestResolver.TestClass_MethodAbstract;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodAbstractWithoutVirtualFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; abstract;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Invalid procedure modifier abstract without virtual',nInvalidXModifierY);
+end;
+
+procedure TTestResolver.TestClass_MethodAbstractHasBodyFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('procedure TObject.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sAbstractMethodsMustNotHaveImplementation,
+    nAbstractMethodsMustNotHaveImplementation);
+end;
+
+procedure TTestResolver.TestClass_MethodUnresolvedWithAncestor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
+procedure TTestResolver.TestClass_ProcFuncMismatch;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('function TObject.DoIt: longint;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('procedure expected, but function found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestClass_MethodOverload;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt;');
+  Add('    procedure DoIt(i: longint);');
+  Add('    procedure DoIt(s: string);');
+  Add('  end;');
+  Add('procedure TObject.DoIt;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(s: string);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodInvalidOverload;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt(i: longint);');
+  Add('    procedure DoIt(k: longint);');
+  Add('  end;');
+  Add('procedure TObject.DoIt(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.DoIt(k: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestClass_MethodOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure {#TOBJ_ProcA}ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA}ProcA; override;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@V}v.{@A_ProcA}ProcA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodOverride2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure {#TOBJ_ProcA}ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA}ProcA; override;');
+  Add('  end;');
+  Add('  {#B}TClassB = class');
+  Add('    procedure {#B_ProcA}ProcA; override;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TClassB.ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=B}v: TClassB;');
+  Add('begin');
+  Add('  {@V}v.{@B_ProcA}ProcA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodOverrideFixCase;
+
+  procedure CheckOverrideName(aLabel: string);
+  var
+    Elements: TFPList;
+    i: Integer;
+    El: TPasElement;
+    Scope: TPasProcedureScope;
+  begin
+    Elements:=FindElementsAtSrcLabel(aLabel);
+    try
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        if not (El is TPasProcedure) then continue;
+        Scope:=El.CustomData as TPasProcedureScope;
+        if Scope.OverriddenProc=nil then
+          Fail('Scope.OverriddenProc=nil');
+        AssertEquals('Proc Name and Proc.Scope.OverriddenProc.Name',El.Name,Scope.OverriddenProc.Name);
+        end;
+    finally
+      Elements.Free;
+    end;
+  end;
+
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proFixCaseOfOverrides];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure {#TOBJ_ProcA}ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    procedure {#A_ProcA}proca; override;');
+  Add('  end;');
+  Add('  {#B}TClassB = class');
+  Add('    procedure {#B_ProcA}prOca; override;');
+  Add('  end;');
+  Add('procedure tclassa.proca;');
+  Add('begin');
+  Add('end;');
+  Add('procedure tclassb.proca;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#V}{=B}v: TClassB;');
+  Add('begin');
+  Add('  {@V}v.{@B_ProcA}ProcA;');
+  ParseProgram;
+  CheckOverrideName('A_ProcA');
+  CheckOverrideName('B_ProcA');
+end;
+
+procedure TTestResolver.TestClass_MethodOverrideSameResultType;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    function ProcA(const s: string): string; virtual; abstract;',
+    '  end;',
+    '']),
+    LinesToStr([
+    ''])
+    );
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('type');
+  Add('  TCar = class');
+  Add('  public');
+  Add('    function ProcA(const s: string): string; override;');
+  Add('  end;');
+  Add('function TCar.ProcA(const s: string): string; begin end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodOverrideDiffResultTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    function ProcA(const s: string): string; virtual; abstract;');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('  public');
+  Add('    function ProcA(const s: string): longint; override;');
+  Add('  end;');
+  Add('function TCar.ProcA(const s: string): longint; begin end;');
+  Add('begin');
+  CheckResolverException('Result type mismatch, expected String, but found Longint',
+    nResultTypeMismatchExpectedButFound);
+end;
+
+procedure TTestResolver.TestClass_MethodOverloadAncestor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure {#A1}DoIt;');
+  Add('    procedure {#B1}DoIt(i: longint);');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('    procedure {#A2}DoIt;');
+  Add('    procedure {#B2}DoIt(i: longint);');
+  Add('  end;');
+  Add('procedure TObject.DoIt; begin end;');
+  Add('procedure TObject.DoIt(i: longint); begin end;');
+  Add('procedure TCar.DoIt;');
+  Add('begin');
+  Add('  {@A2}DoIt;');
+  Add('  {@B2}DoIt(1);');
+  Add('  inherited {@A1}DoIt;');
+  Add('  inherited {@B1}DoIt(2);');
+  Add('end;');
+  Add('procedure TCar.DoIt(i: longint); begin end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodOverloadArrayOfTClass;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '    constructor {#A}Builder(AClass: TClass; AName: string); reintroduce; overload; virtual;',
+  '    constructor {#B}Builder(AClass: TClass); reintroduce; overload; virtual;',
+  '    constructor {#C}Builder(AClassArray: Array of TClass); reintroduce; overload; virtual;',
+  '    constructor {#D}Builder(AName: string); reintroduce; overload; virtual;',
+  '    constructor {#E}Builder; reintroduce; overload; virtual;',
+  '    class var ClassName: string;',
+  '  end;',
+  '  TTestCase = class end;',
+  'constructor TObject.Builder(AClass: TClass; AName: string);',
+  'begin',
+  '  Builder(AClass);',
+  'end;',
+  'constructor TObject.Builder(AClass: TClass);',
+  'begin',
+  '  Builder(AClass.ClassName);',
+  'end;',
+  'constructor TObject.Builder(AClassArray: Array of TClass);',
+  'var',
+  '  i: longint;',
+  'begin',
+  '  Builder;',
+  '  for i := Low(AClassArray) to High(AClassArray) do',
+  '    if Assigned(AClassArray[i]) then ;',
+  'end;',
+  'constructor TObject.Builder(AName: string);',
+  'begin',
+  '  Builder();',
+  'end;',
+  'constructor TObject.Builder;',
+  'begin',
+  'end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  o.{@A}Builder(TTestCase,''first'');',
+  '  o.{@B}Builder(TTestCase);',
+  '  o.{@C}Builder([]);',
+  '  o.{@C}Builder([TTestCase]);',
+  '  o.{@C}Builder([TObject,TTestCase]);',
+  '  o.{@D}Builder(''fourth'');',
+  '  o.{@E}Builder();',
+  '  o.{@E}Builder;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_MethodScope;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#A_A}A: longint;');
+  Add('    procedure {#A_ProcB}ProcB;');
+  Add('  end;');
+  Add('procedure TClassA.ProcB;');
+  Add('begin');
+  Add('  {@A_A}A:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_IdentifierSelf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    {#C}C: longint;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#B}B: longint;');
+  Add('    procedure {#A_ProcB}ProcB;');
+  Add('  end;');
+  Add('procedure TClassA.ProcB;');
+  Add('begin');
+  Add('  {@B}B:=1;');
+  Add('  {@C}C:=2;');
+  Add('  Self.{@B}B:=3;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+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');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassCallInheritedNoParamsAbstractFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; virtual; abstract;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA; override;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('  inherited;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Abstract methods cannot be called directly',
+    nAbstractMethodsCannotBeCalledDirectly);
+end;
+
+procedure TTestResolver.TestClassCallInheritedWithParamsAbstractFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA(c: char); virtual; abstract;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure ProcA(c: char); override;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA(c: char);');
+  Add('begin');
+  Add('  inherited ProcA(c);');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Abstract methods cannot be called directly',
+    nAbstractMethodsCannotBeCalledDirectly);
+end;
+
+procedure TTestResolver.TestClassCallInheritedConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor {#TOBJ_CreateA}Create(vI: longint); virtual;');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    constructor {#A_CreateA}Create({#i1}vI: longint); override;');
+  Add('  end;');
+  Add('constructor TObject.Create(vI: longint);');
+  Add('begin');
+  Add('  inherited; // ignore and do not raise error');
+  Add('end;');
+  Add('constructor TClassA.Create(vI: longint);');
+  Add('begin');
+  Add('  {@A_CreateA}Create({@i1}vI);');
+  Add('  {@TOBJ_CreateA}inherited;');
+  Add('  inherited {@TOBJ_CreateA}Create({@i1}vI);');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassCallInheritedNested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function DoIt: longint; virtual;',
+  '  end;',
+  '  TBird = class',
+  '    function DoIt: longint; override;',
+  '  end;',
+  'function tobject.doit: longint;',
+  'begin',
+  'end;',
+  'function tbird.doit: longint;',
+  '  procedure Sub;',
+  '  begin',
+  '    inherited;',
+  '    inherited DoIt;',
+  '    if inherited DoIt=4 then ;',
+  '  end;',
+  'begin',
+  '  Sub;',
+  '  inherited;',
+  '  inherited DoIt;',
+  '  if inherited DoIt=14 then ;',
+  'end;',
+  'begin',
+   '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassAssignNil;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#FSub}FSub: TClassA;');
+  Add('    property {#Sub}Sub: TClassA read {@FSub}FSub write {@FSub}FSub;');
+  Add('  end;');
+  Add('var');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@v}v:=nil;');
+  Add('  if {@v}v=nil then ;');
+  Add('  if nil={@v}v then ;');
+  Add('  if {@v}v<>nil then ;');
+  Add('  if nil<>{@v}v then ;');
+  Add('  {@v}v.{@FSub}FSub:=nil;');
+  Add('  if {@v}v.{@FSub}FSub=nil then ;');
+  Add('  if {@v}v.{@FSub}FSub<>nil then ;');
+  Add('  {@v}v.{@Sub}Sub:=nil;');
+  Add('  if {@v}v.{@Sub}Sub=nil then ;');
+  Add('  if {@v}v.{@Sub}Sub<>nil then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassAssign;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#FSub}FSub: TClassA;');
+  Add('    property {#Sub}Sub: TClassA read {@FSub}FSub write {@FSub}FSub;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('  {#p}{=A}p: TClassA;');
+  Add('begin');
+  Add('  {@o}o:={@v}v;');
+  Add('  {@v}v:={@p}p;');
+  Add('  if {@v}v={@p}p then ;');
+  Add('  if {@v}v={@o}o then ;');
+  Add('  if {@o}o={@o}o then ;');
+  Add('  if {@o}o={@v}v then ;');
+  Add('  if {@v}v<>{@p}p then ;');
+  Add('  if {@v}v<>{@o}o then ;');
+  Add('  if {@o}o<>{@o}o then ;');
+  Add('  if {@o}o<>{@v}v then ;');
+  Add('  {@v}v.{@FSub}FSub:={@p}p;');
+  Add('  {@p}p:={@v}v.{@FSub}FSub;');
+  Add('  {@o}o:={@v}v.{@FSub}FSub;');
+  Add('  {@v}v.{@Sub}Sub:={@p}p;');
+  Add('  {@p}p:={@v}v.{@Sub}Sub;');
+  Add('  {@o}o:={@v}v.{@Sub}Sub;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassNilAsParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('procedure ProcP(o: TObject);');
+  Add('begin end;');
+  Add('begin');
+  Add('  ProcP(nil);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_Operators_Is_As;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#Sub}Sub: TClassA;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  if {@o}o is {@A}TClassA then;');
+  Add('  if {@v}v is {@A}TClassA then;');
+  Add('  if {@v}v is {@TOBJ}TObject then;');
+  Add('  if {@v}v.{@Sub}Sub is {@A}TClassA then;');
+  Add('  {@v}v:={@o}o as {@A}TClassA;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_OperatorIsOnNonTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  if {@o}o is {@v}v then;');
+  CheckResolverException('class type expected, but class found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestClass_OperatorAsOnNonDescendantFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@o}o:={@v}v as {@TObj}TObject;');
+  CheckResolverException(sTypesAreNotRelated,nTypesAreNotRelated);
+end;
+
+procedure TTestResolver.TestClass_OperatorAsOnNonTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@o}o:={@v}v as {@o}o;');
+  CheckResolverException('class expected, but o found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestClassAsFuncResult;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('     {#A_i}i: longint;');
+  Add('     constructor {#A_CreateA}Create;');
+  Add('     constructor {#A_CreateB}Create(i: longint);');
+  Add('  end;');
+  Add('function {#F}F: TClassA;');
+  Add('begin');
+  Add('  Result:=nil;');
+  Add('end;');
+  Add('constructor TClassA.Create;');
+  Add('begin');
+  Add('end;');
+  Add('constructor TClassA.Create(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@o}o:={@F}F;');
+  Add('  {@o}o:={@F}F();');
+  Add('  {@v}v:={@F}F;');
+  Add('  {@v}v:={@F}F();');
+  Add('  if {@o}o={@F}F then ;');
+  Add('  if {@o}o={@F}F() then ;');
+  Add('  if {@v}v={@F}F then ;');
+  Add('  if {@v}v={@F}F() then ;');
+  Add('  {@v}v:={@A}TClassA.{@A_CreateA}Create;');
+  Add('  {@v}v:={@A}TClassA.{@A_CreateA}Create();');
+  Add('  {@v}v:={@A}TClassA.{@A_CreateB}Create(3);');
+  Add('  {@A}TClassA.{@A_CreateA}Create.{@A_i}i:=3;');
+  Add('  {@A}TClassA.{@A_CreateA}Create().{@A_i}i:=3;');
+  Add('  {@A}TClassA.{@A_CreateB}Create(3).{@A_i}i:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassTypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    id: longint;');
+  Add('  end;');
+  Add('procedure ProcA(var a: TClassA);');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@o}o:={@v}v;');
+  Add('  {@o}o:=TObject({@o}o);');
+  Add('  {@v}v:=TClassA({@o}o);');
+  Add('  {@v}v:=TClassA(TObject({@o}o));');
+  Add('  {@v}v:=TClassA({@v}v);');
+  Add('  {@v}v:=v as TClassA;');
+  Add('  {@v}v:=o as TClassA;');
+  Add('  ProcA({@v}v);');
+  Add('  ProcA(TClassA({@o}o));');
+  Add('  if TClassA({@o}o).id=3 then ;');
+  Add('  if (o as TClassA).id=3 then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassTypeCastUnrelatedFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    id: longint;');
+  Add('  end;');
+  Add('  {#B}TClassB = class');
+  Add('    Name: string;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#va}{=A}va: TClassA;');
+  Add('  {#vb}{=B}vb: TClassB;');
+  Add('begin');
+  Add('  {@vb}vb:=TClassB({@va}va);');
+  CheckResolverException('Illegal type conversion: "TClassA" to "class TClassB"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestClass_TypeCastSelf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    id: longint;');
+  Add('  end;');
+  Add('constructor TObject.Create;');
+  Add('begin');
+  Add('  TClassA(Self).id:=3;');
+  Add('  if TClassA(Self).id=4 then;');
+  Add('  if 5=TClassA(Self).id then;');
+  Add('end;');
+  Add('procedure TObject.ProcA;');
+  Add('begin');
+  Add('  TClassA(Self).id:=3;');
+  Add('  if TClassA(Self).id=4 then;');
+  Add('  if 5=TClassA(Self).id then;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_TypeCaseMultipleParamsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    i: longint;');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.i:=TObject(o,o).i;');
+  CheckResolverException('wrong number of parameters for type cast to TObject',
+    nWrongNumberOfParametersForTypeCast);
+end;
+
+procedure TTestResolver.TestClass_TypeCastAssign;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('  end;');
+  Add('procedure DoIt(a: TCar; const b: TCar; var c: TCar; out d: TCar); begin end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  c: TCar;');
+  Add('begin');
+  Add('  TCar({#a_assign}o):=nil;');
+  Add('  TCar({#b_assign}o):=c;');
+  Add('  DoIt(TCar({#c1_read}o),TCar({#c2_read}o),TCar({#c3_var}o),TCar({#c4_out}o));');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestClass_AccessMemberViaClassFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    i: longint;');
+  Add('  end;');
+  Add('begin');
+  Add('  if TObject.i=7 then ;');
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    nCannotAccessThisMemberFromAX);
+end;
+
+procedure TTestResolver.TestClass_FuncReturningObjectMember;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    i: longint;');
+  Add('  end;');
+  Add('function FuncO: TObject;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  FuncO.i:=3;');
+  Add('  if FuncO.i=4 then ;');
+  Add('  if 5=FuncO.i then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_StaticWithoutClassFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA; static;');
+  Add('  end;');
+  Add('procedure TObject.ProcA; begin end;');
+  Add('begin');
+  CheckResolverException('Invalid procedure modifier static',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.TestClass_SelfInStaticFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure ProcA; static;');
+  Add('  end;');
+  Add('class procedure TObject.ProcA;');
+  Add('begin');
+  Add('  if Self=nil then ;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('identifier not found "Self"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestClass_PrivateProtectedInSameUnit;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict private {#vstrictprivate}vstrictprivate: longint;');
+  Add('  strict protected {#vstrictprotected}vstrictprotected: longint;');
+  Add('  private {#vprivate}vprivate: longint;');
+  Add('  protected {#vprotected}vprotected: longint;');
+  Add('  public {#vpublic}vpublic: longint;');
+  Add('    procedure ProcA;');
+  Add('  automated {#vautomated}vautomated: longint;');
+  Add('  published {#vpublished}vpublished: longint;');
+  Add('  end;');
+  Add('procedure TObject.ProcA;');
+  Add('begin');
+  Add('  if {@vstrictprivate}vstrictprivate=1 then ;');
+  Add('  if {@vstrictprotected}vstrictprotected=2 then ;');
+  Add('  if {@vprivate}vprivate=3 then ;');
+  Add('  if {@vprotected}vprotected=4 then ;');
+  Add('  if {@vpublic}vpublic=5 then ;');
+  Add('  if {@vautomated}vautomated=6 then ;');
+  Add('  if {@vpublished}vpublished=7 then ;');
+  Add('end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  if o.vprivate=10 then ;');
+  Add('  if o.vprotected=11 then ;');
+  Add('  if o.vpublic=12 then ;');
+  Add('  if o.vautomated=13 then ;');
+  Add('  if o.vpublished=14 then ;');
+end;
+
+procedure TTestResolver.TestClass_PrivateInMainBeginFail;
+begin
+  AddModuleWithSrc('unit1.pas',
+    LinesToStr([
+      'unit unit1;',
+      'interface',
+      'type',
+      '  TObject = class',
+      '  private v: longint;',
+      '  end;',
+      'implementation',
+      'end.'
+      ]));
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  if o.v=3 then ;');
+  CheckResolverException('Can''t access private member v',
+    nCantAccessPrivateMember);
+end;
+
+procedure TTestResolver.TestClass_PrivateInDescendantFail;
+begin
+  AddModuleWithSrc('unit1.pas',
+    LinesToStr([
+      'unit unit1;',
+      'interface',
+      'type',
+      '  TObject = class',
+      '  private v: longint;',
+      '  end;',
+      'implementation',
+      'end.'
+      ]));
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('type');
+  Add('  TClassA = class(TObject)');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('  if v=3 then ;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Can''t access private member v',
+    nCantAccessPrivateMember);
+end;
+
+procedure TTestResolver.TestClass_ProtectedInDescendant;
+begin
+  AddModuleWithSrc('unit1.pas',
+    LinesToStr([
+      'unit unit1;',
+      'interface',
+      'type',
+      '  TObject = class',
+      '  protected vprotected: longint;',
+      '  strict protected vstrictprotected: longint;',
+      '  end;',
+      'implementation',
+      'end.'
+      ]));
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('type');
+  Add('  TClassA = class(TObject)');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('procedure TClassA.ProcA;');
+  Add('begin');
+  Add('  if vprotected=3 then ;');
+  Add('  if vstrictprotected=4 then ;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_StrictPrivateInMainBeginFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict private v: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  if o.v=3 then ;');
+  CheckResolverException('Can''t access strict private member v',
+    nCantAccessPrivateMember);
+end;
+
+procedure TTestResolver.TestClass_StrictProtectedInMainBeginFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict protected v: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  if o.v=3 then ;');
+  CheckResolverException('Can''t access strict protected member v',
+    nCantAccessPrivateMember);
+end;
+
+procedure TTestResolver.TestClass_Constructor_NewInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  ActualNewInstance, ActualImplicitCallWithoutParams: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    class function DoSome: TObject;');
+  Add('  end;');
+  Add('constructor TObject.Create;');
+  Add('begin');
+  Add('  {#a}Create; // normal call');
+  Add('  TObject.{#b}Create; // new instance');
+  Add('end;');
+  Add('class function TObject.DoSome: TObject;');
+  Add('begin');
+  Add('  Result:={#c}Create; // new instance');
+  Add('end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  TObject.{#p}Create; // new object');
+  Add('  o:=TObject.{#q}Create; // new object');
+  Add('  o.{#r}Create; // normal call');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestClass_Constructor_NewInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualNewInstance:=false;
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestClass_Constructor_NewInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestClass_Constructor_NewInstance ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if (Ref.Declaration is TPasConstructor) then
+          ActualNewInstance:=rrfNewInstance in Ref.Flags;
+        ActualImplicitCallWithoutParams:=rrfImplicitCallWithoutParams in Ref.Flags;
+        break;
+        end;
+      if not ActualImplicitCallWithoutParams then
+        RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
+      case aMarker^.Identifier of
+      'a','r':// should be normal call
+        if ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
+      else // should be newinstance
+        if not ActualNewInstance then
+          RaiseErrorAtSrcMarker('expected newinstance at "#'+aMarker^.Identifier+', but got normal call"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestClass_Constructor_InstanceCallResultFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TObject.Create;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  o:=o.Create; // normal call has no result -> fail');
+  CheckResolverException('Incompatible types: got "Procedure/Function" expected "TObject"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestClass_Destructor_FreeInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  ActualFreeInstance, ActualImplicitCallWithoutParams: Boolean;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    destructor Destroy; virtual;');
+  Add('  end;');
+  Add('  TChild = class(TObject)');
+  Add('    destructor DestroyOther;');
+  Add('  end;');
+  Add('destructor TObject.Destroy;');
+  Add('begin');
+  Add('end;');
+  Add('destructor TChild.DestroyOther;');
+  Add('begin');
+  Add('  {#a}Destroy; // free instance');
+  Add('  inherited {#b}Destroy; // normal call');
+  Add('end;');
+  Add('var');
+  Add('  c: TChild;');
+  Add('begin');
+  Add('  c.{#c}Destroy; // free instance');
+  Add('  c.{#d}DestroyOther; // free instance');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestClass_Destructor_FreeInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualFreeInstance:=false;
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestClass_Destructor_FreeInstance ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestClass_Destructor_FreeInstance ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if (Ref.Declaration is TPasDestructor) then
+          ActualFreeInstance:=rrfFreeInstance in Ref.Flags;
+        ActualImplicitCallWithoutParams:=rrfImplicitCallWithoutParams in Ref.Flags;
+        break;
+        end;
+      if not ActualImplicitCallWithoutParams then
+        RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
+      case aMarker^.Identifier of
+      'b':// should be normal call
+        if ActualFreeInstance then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got freeinstance"',aMarker);
+      else // should be freeinstance
+        if not ActualFreeInstance then
+          RaiseErrorAtSrcMarker('expected freeinstance at "#'+aMarker^.Identifier+', but got normal call"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestClass_ConDestructor_CallInherited;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    destructor Destroy; virtual;');
+  Add('  end;');
+  Add('  TChild = class(TObject)');
+  Add('    constructor Create;');
+  Add('    destructor Destroy; override;');
+  Add('  end;');
+  Add('constructor TObject.Create;');
+  Add('begin');
+  Add('end;');
+  Add('destructor TObject.Destroy;');
+  Add('begin');
+  Add('end;');
+  Add('constructor TChild.Create;');
+  Add('begin');
+  Add('  {#c}inherited; // normal call');
+  Add('end;');
+  Add('destructor TChild.Destroy;');
+  Add('begin');
+  Add('  {#d}inherited; // normal call');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestClass_ConDestructor_Inherited ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if not (Ref.Declaration is TPasProcedure) then continue;
+        //writeln('TTestResolver.TestClass_ConDestructor_Inherited ',GetObjName(Ref.Declaration),' rrfNewInstance=',rrfNewInstance in Ref.Flags);
+        if rrfNewInstance in Ref.Flags then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
+        if rrfFreeInstance in Ref.Flags then
+          RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got freeinstance"',aMarker);
+        break;
+        end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestClass_Constructor_Inherited;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    constructor Create;');
+  Add('    destructor Destroy;');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('  {#TClassA}TClassA = class');
+  Add('    Sub: TObject;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('destructor TObject.Destroy; begin end;');
+  Add('procedure TObject.DoIt; begin end;');
+  Add('var a: TClassA;');
+  Add('begin');
+  Add('  a:=TClassA.Create;');
+  Add('  a.DoIt;');
+  Add('  a.Destroy;');
+  Add('  if TClassA.Create.Sub=nil then ;');
+  Add('  with TClassA.Create do Sub:=nil;');
+  Add('  with TClassA do a:=Create;');
+  Add('  with TClassA do Create.Sub:=nil;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_SubObject;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#Sub}Sub: TObject;');
+  Add('    procedure DoIt(p: longint);');
+  Add('    function GetIt(p: longint): TObject;');
+  Add('  end;');
+  Add('procedure TObject.DoIt(p: longint); begin end;');
+  Add('function TObject.GetIt(p: longint): TObject; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.Sub:=nil;');
+  Add('  o.Sub.Sub:=nil;');
+  Add('  if o.Sub=nil then ;');
+  Add('  if o.Sub=o.Sub.Sub then ;');
+  Add('  o.Sub.DoIt(3);');
+  Add('  o.Sub.GetIt(4);');
+  Add('  o.Sub.GetIt(5).DoIt(6);');
+  Add('  o.Sub.GetIt(7).Sub.DoIt(8);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_WithClassInstance;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualRefWith: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FInt: longint;');
+  Add('    FObj: TObject;');
+  Add('    FArr: array of longint;');
+  Add('    constructor Create;');
+  Add('    function GetSize: longint;');
+  Add('    procedure SetSize(Value: longint);');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index, Value: longint);');
+  Add('    property Size: longint read GetSize write SetSize;');
+  Add('    property Items[Index: longint]: longint read GetItems write SetItems;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetSize: longint; begin end;');
+  Add('procedure TObject.SetSize(Value: longint); begin end;');
+  Add('function TObject.GetItems(Index: longint): longint; begin end;');
+  Add('procedure TObject.SetItems(Index, Value: longint); begin end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    {#A}FInt:=3;');
+  Add('    i:={#B}FInt;');
+  Add('    i:={#C}GetSize;');
+  Add('    i:={#D}GetSize();');
+  Add('    {#E}SetSize(i);');
+  Add('    i:={#F}Size;');
+  Add('    {#G}Size:=i;');
+  Add('    i:={#H}Items[i];');
+  Add('    {#I}Items[i]:=i;');
+  Add('    i:={#J}FArr[i];');
+  Add('    {#K}FArr[i]:=i;');
+  Add('  end;');
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestClass_WithClassInstance ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualRefWith:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestClass_WithClassInstance ',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.WithExprScope=nil then continue;
+        ActualRefWith:=true;
+        break;
+        end;
+      if not ActualRefWith then
+        RaiseErrorAtSrcMarker('expected Ref.WithExprScope<>nil at "#'+aMarker^.Identifier+', but got nil"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestClass_ProcedureExternal;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt; external ''somewhere'';');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_ReintroducePublicVarFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    Some: longint;');
+  Add('  end;');
+  Add('  TCar = class(tobject)');
+  Add('  public');
+  Add('    Some: longint;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Duplicate identifier "Some" at afile.pp(5,8)',nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestClass_ReintroducePrivateVar;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict private');
+  Add('    Some: longint;');
+  Add('  end;');
+  Add('  TCar = class(tobject)');
+  Add('  public');
+  Add('    Some: longint;');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_ReintroduceProc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict private');
+  Add('    Some: longint;');
+  Add('  end;');
+  Add('  TMobile = class');
+  Add('  strict private');
+  Add('    Some: string;');
+  Add('  end;');
+  Add('  TCar = class(tmobile)');
+  Add('    procedure {#A}Some;');
+  Add('    procedure {#B}Some(vA: longint);');
+  Add('  end;');
+  Add('procedure tcar.some;');
+  Add('begin');
+  Add('  {@A}Some;');
+  Add('  {@B}Some(1);');
+  Add('end;');
+  Add('procedure tcar.some(va: longint); begin end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_UntypedParam_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('procedure {#ProcA}ProcA(var {#A}A);');
+  Add('begin');
+  Add('  TObject({@A}A):=TObject({@A}A);');
+  Add('  if TObject({@A}A)=nil then ;');
+  Add('  if nil=TObject({@A}A) then ;');
+  Add('end;');
+  Add('procedure {#ProcB}ProcB(const {#B}B);');
+  Add('begin');
+  Add('  if TObject({@B}B)=nil then ;');
+  Add('  if nil=TObject({@B}B) then ;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  {@ProcA}ProcA(o);');
+  Add('  {@ProcB}ProcB(o);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_Sealed;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class sealed');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_SealedDescendFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class sealed');
+  Add('  end;');
+  Add('  TNop = class(TObject)');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException(sCannotCreateADescendantOfTheSealedClass,
+    nCannotCreateADescendantOfTheSealedClass);
+end;
+
+procedure TTestResolver.TestClass_VarExternal;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    Id: longint external name ''$Id'';');
+  Add('    Data: longint external name ''$Data'';');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_WarnOverrideLowerVisibility;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict protected');
+  Add('    procedure DoStrictProtected; virtual; abstract;');
+  Add('  protected');
+  Add('    procedure DoProtected; virtual; abstract;');
+  Add('  public');
+  Add('    procedure DoPublic; virtual; abstract;');
+  Add('  published');
+  Add('    procedure DoPublished; virtual; abstract;');
+  Add('  end;');
+  Add('  TBird = class(TObject)');
+  Add('  private');
+  Add('    procedure DoStrictProtected; override;');
+  Add('    procedure DoProtected; override;');
+  Add('  protected');
+  Add('    procedure DoPublic; override;');
+  Add('    procedure DoPublished; override;');
+  Add('  end;');
+  Add('procedure TBird.DoStrictProtected; begin end;');
+  Add('procedure TBird.DoProtected; begin end;');
+  Add('procedure TBird.DoPublic; begin end;');
+  Add('procedure TBird.DoPublished; begin end;');
+  Add('begin');
+  ParseProgram;
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoStrictProtected" has a lower visibility (private) than parent class TObject (strict protected)');
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoProtected" has a lower visibility (private) than parent class TObject (protected)');
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoPublic" has a lower visibility (protected) than parent class TObject (public)');
+  CheckResolverHint(mtNote,nVirtualMethodXHasLowerVisibility,
+    'Virtual method "DoPublished" has a lower visibility (protected) than parent class TObject (published)');
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestClass_Const;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    const cI: integer = 3;');
+  Add('    procedure DoIt;');
+  Add('    class procedure DoMore;');
+  Add('  end;');
+  Add('implementation');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  if cI=4 then;');
+  Add('  if 5=cI then;');
+  Add('  if Self.cI=6 then;');
+  Add('  if 7=Self.cI then;');
+  Add('  with Self do begin');
+  Add('    if cI=11 then;');
+  Add('    if 12=cI then;');
+  Add('  end;');
+  Add('end;');
+  Add('class procedure tobject.domore;');
+  Add('begin');
+  Add('  if cI=8 then;');
+  Add('  if Self.cI=9 then;');
+  Add('  if 10=cI then;');
+  Add('  if 11=Self.cI then;');
+  Add('  with Self do begin');
+  Add('    if cI=13 then;');
+  Add('    if 14=cI then;');
+  Add('  end;');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  Cla: TClass;');
+  Add('begin');
+  Add('  if TObject.cI=21 then ;');
+  Add('  if Obj.cI=22 then ;');
+  Add('  if Cla.cI=23 then ;');
+  Add('  with obj do if ci=24 then;');
+  Add('  with TObject do if ci=25 then;');
+  Add('  with Cla do if ci=26 then;');
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestClass_PublishedClassVarFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    class var Id: longint;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
+end;
+
+procedure TTestResolver.TestClass_PublishedClassPropertyFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var FA: longint;');
+  Add('  published');
+  Add('    class property A: longint read FA;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Invalid published property modifier "class"',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.TestClass_PublishedClassFunctionFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    class procedure DoIt;');
+  Add('  end;');
+  Add('class procedure TObject.DoIt; begin end;');
+  Add('begin');
+  CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
+end;
+
+procedure TTestResolver.TestClass_PublishedOverloadFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    procedure DoIt;');
+  Add('    procedure DoIt(i: longint);');
+  Add('  end;');
+  Add('procedure TObject.DoIt; begin end;');
+  Add('procedure TObject.DoIt(i: longint); begin end;');
+  Add('begin');
+  CheckResolverException(sDuplicateIdentifier,nDuplicateIdentifier);
+end;
+
+procedure TTestResolver.TestExternalClass;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('{$modeswitch externalclass}');
+  Add('  TExtA = class external ''namespace'' name ''symbol''');
+  Add('    Id: longint;');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestExternalClass_Descendant;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('{$modeswitch externalclass}');
+  Add('  TExtA = class external ''namespace'' name ''symbol''');
+  Add('    Id: longint;');
+  Add('  end;');
+  Add('  TExtB = class external ''namespace'' name ''symbol''(TExtA)');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TClass}{=TObj}TClass = class of TObject;');
+  Add('  {#TOBJ}TObject = class');
+  Add('    ClassType: TClass; ');
+  Add('  end;');
+  Add('type');
+  Add('  {#TMobile}TMobile = class');
+  Add('  end;');
+  Add('  {#TMobiles}{=TMobile}TMobiles = class of TMobile;');
+  Add('type');
+  Add('  {#TCars}{=TCar}TCars = class of TCar;');
+  Add('  {#TShips}{=TShip}TShips = class of TShip;');
+  Add('  {#TCar}TCar = class(TMobile)');
+  Add('  end;');
+  Add('  {#TShip}TShip = class(TMobile)');
+  Add('  end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  c: TClass;');
+  Add('  mobile: TMobile;');
+  Add('  mobiletype: TMobiles;');
+  Add('  car: TCar;');
+  Add('  cartype: TCars;');
+  Add('  ship: TShip;');
+  Add('  shiptype: TShips;');
+  Add('begin');
+  Add('  c:=nil;');
+  Add('  c:=o.ClassType;');
+  Add('  if c=nil then;');
+  Add('  if nil=c then;');
+  Add('  if c=o.ClassType then ;');
+  Add('  if c<>o.ClassType then ;');
+  Add('  if Assigned(o) then ;');
+  Add('  if Assigned(o.ClassType) then ;');
+  Add('  if Assigned(c) then ;');
+  Add('  mobiletype:=TMobile;');
+  Add('  mobiletype:=TCar;');
+  Add('  mobiletype:=TShip;');
+  Add('  mobiletype:=cartype;');
+  Add('  if mobiletype=nil then ;');
+  Add('  if nil=mobiletype then ;');
+  Add('  if mobiletype=TShip then ;');
+  Add('  if TShip=mobiletype then ;');
+  Add('  if mobiletype<>TShip then ;');
+  Add('  if mobile is mobiletype then ;');
+  Add('  if car is mobiletype then ;');
+  Add('  if mobile is cartype then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOfNonClassFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TCars = class of longint;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "class"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestClassOfIsOperatorFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TCar = class end;');
+  Add('  TCars = class of TCar;');
+  Add('var cars: TCars;');
+  Add('begin');
+  Add('  if cars is TCars then ;');
+  CheckResolverException('left side of is-operator expects a class, but got "class of" type',
+    nLeftSideOfIsOperatorExpectsAClassButGot);
+end;
+
+procedure TTestResolver.TestClassOfAsOperatorFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TCar = class end;');
+  Add('  TCars = class of TCar;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  cars: TCars;');
+  Add('begin');
+  Add('  cars:=cars as TCars;');
+  CheckResolverException('illegal qualifier "as"',nIllegalQualifier);
+end;
+
+procedure TTestResolver.TestClassOfIsOperator;
+begin
+  StartProgram(false);
+  ResolverEngine.Options:=ResolverEngine.Options+[proClassOfIs];
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TClass = class of TObject;');
+  Add('  TCar = class end;');
+  Add('  TCars = class of TCar;');
+  Add('var C: TClass;');
+  Add('  D: TCars;');
+  Add('begin');
+  Add('  if C is TCar then;');
+  Add('  if C is TCars then;');
+  Add('  if C is D then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_ClassVar;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var GlobalId: longint;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  o.GlobalId:=3;');
+  Add('  if o.GlobalId=4 then ;');
+  Add('  if 5=o.GlobalId then ;');
+  Add('  TObject.GlobalId:=6;');
+  Add('  if TObject.GlobalId=7 then ;');
+  Add('  if 8=TObject.GlobalId then ;');
+  Add('  oc.GlobalId:=9;');
+  Add('  if oc.GlobalId=10 then ;');
+  Add('  if 11=oc.GlobalId then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOfDotClassVar;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var Id: longint;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('var');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  oc.Id:=3;');
+  Add('  if oc.Id=4 then ;');
+  Add('  if 5=oc.Id then ;');
+  Add('  TObject.Id:=3;');
+  Add('  if TObject.Id=4 then ;');
+  Add('  if 5=TObject.Id then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOfDotVarFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    Id: longint;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('var');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  oc.Id:=3;');
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    nCannotAccessThisMemberFromAX);
+end;
+
+procedure TTestResolver.TestClassOfDotClassProc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure ProcA;');
+  Add('    class function FuncB: longint;');
+  Add('    class procedure ProcC(i: longint);');
+  Add('    class function FuncD(i: longint): longint;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('class procedure TObject.ProcA; begin end;');
+  Add('class function TObject.FuncB: longint; begin end;');
+  Add('class procedure TObject.ProcC(i: longint); begin end;');
+  Add('class function TObject.FuncD(i: longint): longint; begin end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  o.ProcA;');
+  Add('  oc.ProcA;');
+  Add('  TObject.ProcA;');
+  Add('  o.FuncB;');
+  Add('  o.FuncB();');
+  Add('  oc.FuncB;');
+  Add('  oc.FuncB();');
+  Add('  TObject.FuncB;');
+  Add('  TObject.FuncB();');
+  Add('  if oc.FuncB=3 then ;');
+  Add('  if oc.FuncB()=4 then ;');
+  Add('  if 5=oc.FuncB then ;');
+  Add('  if 6=oc.FuncB() then ;');
+  Add('  oc.ProcC(7);');
+  Add('  TObject.ProcC(8);');
+  Add('  oc.FuncD(7);');
+  Add('  TObject.FuncD(8);');
+  Add('  if oc.FuncD(9)=10 then ;');
+  Add('  if 11=oc.FuncD(12) then ;');
+  Add('  if TObject.FuncD(13)=14 then ;');
+  Add('  if 15=TObject.FuncD(16) then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOfDotProcFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('procedure TObject.ProcA; begin end;');
+  Add('var');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  oc.ProcA;');
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    nCannotAccessThisMemberFromAX);
+end;
+
+procedure TTestResolver.TestClassOfDotClassProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var FA: longint;');
+  Add('    class function GetA: longint; static;');
+  Add('    class procedure SetA(Value: longint); static;');
+  Add('    class property A1: longint read FA write SetA;');
+  Add('    class property A2: longint read GetA write FA;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('class function TObject.GetA: longint; begin end;');
+  Add('class procedure TObject.SetA(Value: longint); begin end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  o.A1:=3;');
+  Add('  if o.A1=4 then ;');
+  Add('  if 5=o.A1 then ;');
+  Add('  oc.A1:=6;');
+  Add('  if oc.A1=7 then ;');
+  Add('  if 8=oc.A1 then ;');
+  Add('  TObject.A1:=9;');
+  Add('  if TObject.A1=10 then ;');
+  Add('  if 11=TObject.A1 then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOfDotPropertyFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FA: longint;');
+  Add('    property A: longint read FA;');
+  Add('  end;');
+  Add('  TObjectClass = class of TObject;');
+  Add('var');
+  Add('  oc: TObjectClass;');
+  Add('begin');
+  Add('  if oc.A=3 then ;');
+  CheckResolverException(sCannotAccessThisMemberFromAX,
+    nCannotAccessThisMemberFromAX);
+end;
+
+procedure TTestResolver.TestClass_ClassProcSelf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var GlobalId: longint;');
+  Add('    class procedure ProcA;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('class procedure TObject.ProcA;');
+  Add('var c: TClass;');
+  Add('begin');
+  Add('  if Self=nil then ;');
+  Add('  if Self.GlobalId=3 then ;');
+  Add('  if 4=Self.GlobalId then ;');
+  Add('  Self.GlobalId:=5;');
+  Add('  c:=Self;');
+  Add('  c:=TClass(Self);');
+  Add('  if Self=c then ;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClass_ClassProcSelfTypeCastFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure ProcA;');
+  Add('  end;');
+  Add('class procedure TObject.ProcA;');
+  Add('begin');
+  Add('  if TObject(Self)=nil then ;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Illegal type conversion: "Self" to "class TObject"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestClass_ClassMembers;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TMobile = class');
+  Add('  public');
+  Add('    MobileId: longint;');
+  Add('    class var LastVal: longint;');
+  Add('    constructor Create; virtual;');
+  Add('    class procedure ClProcA;');
+  Add('    class function ClFuncB: longint;');
+  Add('    class function StFuncC: longint; static;');
+  Add('    class property ClMobileId: longint read StFuncC write LastVal;');
+  Add('  end;');
+  Add('  TMobiles = class of TMobile;');
+  Add('  TCars = class of TCar;');
+  Add('  TCar = class(TMobile)');
+  Add('  public');
+  Add('    CarId: longint;');
+  Add('    class var LastCarVal: longint;');
+  Add('    constructor Create; override;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('  Self.MobileId:=7;');
+  Add('  LastVal:=LastVal+ClMobileId+1;');
+  Add('  ClMobileId:=MobileId+3;');
+  Add('  TCar(Self).CarId:=4;');
+  Add('end;');
+  Add('class procedure TMobile.ClProcA;');
+  Add('var');
+  Add('  m: TMobiles;');
+  Add('begin');
+  Add('  LastVal:=9;');
+  Add('  Self.LastVal:=ClFuncB+ClMobileId;');
+  Add('  m:=Self;');
+  Add('  if m=Self then ;');
+  Add('end;');
+  Add('class function TMobile.ClFuncB: longint;');
+  Add('begin');
+  Add('  if LastVal=3 then ;');
+  Add('  Result:=Self.LastVal-ClMobileId;');
+  Add('end;');
+  Add('class function TMobile.StFuncC: longint;');
+  Add('begin');
+  Add('  Result:=LastVal;');
+  Add('  // Forbidden: no Self in static methods');
+  Add('end;');
+  Add('');
+  Add('constructor TCar.Create;');
+  Add('begin');
+  Add('  inherited Create;');
+  Add('  Self.CarId:=8;');
+  Add('  TMobile(Self).LastVal:=5;');
+  Add('  if TMobile(Self).LastVal=25 then ;');
+  Add('end;');
+  Add('');
+  Add('var');
+  Add('  car: TCar;');
+  Add('  cartype: TCars;');
+  Add('begin');
+  Add('  car:=TCar.Create;');
+  Add('  car.MobileId:=10;');
+  Add('  car.ClProcA;');
+  Add('  exit;');
+  Add('  car.ClMobileId:=11;');
+  Add('  if car.ClFuncB=16 then ;');
+  Add('  if 17=car.ClFuncB then ;');
+  Add('  cartype:=TCar;');
+  Add('  cartype.LastVal:=18;');
+  Add('  if cartype.LastVal=19 then ;');
+  Add('  if 20=cartype.LastVal then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOf_AsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  c: tclass;');
+  Add('begin');
+  Add('  c:=c as TClass;');
+  CheckResolverException('illegal qualifier "as"',nIllegalQualifier);
+end;
+
+procedure TTestResolver.TestClassOf_MemberAsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('    c: tclass;');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.c:=o.c as TClass;');
+  CheckResolverException('illegal qualifier "as"',nIllegalQualifier);
+end;
+
+procedure TTestResolver.TestClassOf_IsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  c: tclass;');
+  Add('begin');
+  Add('  if c is TObject then;');
+  CheckResolverException('left side of is-operator expects a class, but got "class of" type',
+    nLeftSideOfIsOperatorExpectsAClassButGot);
+end;
+
+procedure TTestResolver.TestClass_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure {#TObject_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('  TMobile = class');
+  Add('    class procedure {#TMobile_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TMobileClass = class of TMobile;');
+  Add('  TCar = class(TMobile)');
+  Add('    class procedure {#TCar_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TCarClass = class of TCar;');
+  Add('class procedure TObject.DoIt;');
+  Add('begin');
+  Add('  TClass(Self).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
+  Add('end;');
+  Add('class procedure TMobile.DoIt;');
+  Add('begin');
+  Add('  TClass(Self).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(Self).{@TCar_DoIt}DoIt;');
+  Add('end;');
+  Add('class procedure TCar.DoIt; begin end;');
+  Add('var');
+  Add('  ObjC: TClass;');
+  Add('  MobileC: TMobileClass;');
+  Add('  CarC: TCarClass;');
+  Add('begin');
+  Add('  ObjC.{@TObject_DoIt}DoIt;');
+  Add('  MobileC.{@TMobile_DoIt}DoIt;');
+  Add('  CarC.{@TCar_DoIt}DoIt;');
+  Add('  TClass(ObjC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(ObjC).{@TCar_DoIt}DoIt;');
+  Add('  TClass(MobileC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(MobileC).{@TCar_DoIt}DoIt;');
+  Add('  TClass(CarC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(CarC).{@TCar_DoIt}DoIt;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOf_AlwaysForward;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  end;',
+    '  TCar = class',
+    '  end;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('type');
+  Add('  {#C}{=A}TCars = class of TCar;');
+  Add('  {#A}TCar = class');
+  Add('    class var {#B}B: longint;');
+  Add('  end;');
+  Add('begin');
+  Add('  {@C}TCars.{@B}B:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassOf_ClassOfBeforeClass_FuncResult;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('function GetClass: TClass;');
+  Add('begin');
+  Add('  Result:=TObject;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProperty1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  {#TOBJ}TObject = class');
+  Add('  end;');
+  Add('  {#A}TClassA = class');
+  Add('    {#FB}FB: integer;');
+  Add('    property {#B}B: longint read {@FB}FB write {@FB}FB;');
+  Add('  end;');
+  Add('var');
+  Add('  {#v}{=A}v: TClassA;');
+  Add('begin');
+  Add('  {@v}v.{@b}b:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyAccessorNotInFront;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    property B: longint read FB;');
+  Add('    FB: longint;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('identifier not found "FB"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorVarWrongType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: string;');
+  Add('    property B: longint read FB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorProcNotFunc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure GetB;');
+  Add('    property B: longint read GetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('function expected, but procedure found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorFuncWrongResult;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB: string;');
+  Add('    property B: longint read GetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('function result Longint expected, but String found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorFuncWrongArgCount;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(i: longint): longint;');
+  Add('    property B: longint read GetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Wrong number of parameters specified for call to "GetB"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestPropertyReadAccessorFunc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    function {#GetB}GetB: longint;');
+  Add('    property {#B}B: longint read {@GetB}GetB;');
+  Add('  end;');
+  Add('function TObject.GetB: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('begin');
+  Add('  if {@o}o.{@B}B=3 then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorVarWrongType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: string;');
+  Add('    property B: longint write FB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorFuncNotProc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function SetB: longint;');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('procedure expected, but function found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProcWrongArgCount;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure SetB;');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Wrong number of parameters specified for call to "SetB"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProcWrongArg;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure SetB(var Value: longint);');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Incompatible type arg no. 1: Got "var", expected "const"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProcWrongArgType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure SetB(Value: string);');
+  Add('    property B: longint write SetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Incompatible type arg no. 1: Got "String", expected "Longint"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestPropertyWriteAccessorProc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    procedure {#SetB}SetB(Value: longint);');
+  Add('    property {#B}B: longint write {@SetB}SetB;');
+  Add('  end;');
+  Add('procedure TObject.SetB(Value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('begin');
+  Add('  {@o}o.{@B}B:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyTypeless;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#FB}FB: longint;');
+  Add('    property {#TOBJ_B}B: longint write {@FB}FB;');
+  Add('  end;');
+  Add('  {#TA}TClassA = class');
+  Add('    {#FC}FC: longint;');
+  Add('    property {#TA_B}{@TOBJ_B}B write {@FC}FC;');
+  Add('  end;');
+  Add('var');
+  Add('  {#v}{=TA}v: TClassA;');
+  Add('begin');
+  Add('  {@v}v.{@TA_B}B:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyTypelessNoAncestorFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    property B;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException(sNoPropertyFoundToOverride,
+    nNoPropertyFoundToOverride);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FBird: longint;');
+  Add('    VStored: boolean;');
+  Add('    function IsBirdStored: boolean; virtual; abstract;');
+  Add('    property Bird: longint read FBird stored VStored;');
+  Add('    property B: longint read FBird stored IsBirdStored;');
+  Add('  end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorVarWrongType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    BStored: longint;');
+  Add('    property B: longint read FB stored BStored;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "Boolean"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorProcNotFunc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    procedure GetB;');
+  Add('    property B: longint read FB stored GetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('function expected, but procedure found',nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorFuncWrongResult;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    function GetB: string;');
+  Add('    property B: longint read FB stored GetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('function: boolean expected, but function:String found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.TestPropertyStoredAccessorFuncWrongArgCount;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    function GetB(i: longint): boolean;');
+  Add('    property B: longint read FB stored GetB;');
+  Add('  end;');
+  Add('begin');
+  CheckResolverException('Wrong number of parameters specified for call to "GetB"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestPropertyArgs1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(Index: longint): boolean;');
+  Add('    procedure SetB(Index: longint; Value: boolean);');
+  Add('    property B[Index: longint]: boolean read GetB write SetB;');
+  Add('  end;');
+  Add('function TObject.GetB(Index: longint): boolean;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.SetB(Index: longint; Value: boolean);');
+  Add('begin');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.B[3]:=true;');
+  Add('  if o.B[4] then;');
+  Add('  if o.B[5]=true then;');
+  Add('  if false=o.B[6] then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyArgs2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(Index: longint; const ID: string): longint;');
+  Add('    procedure SetB(Index: longint; const ID: string; Value: longint);');
+  Add('    property B[Index: longint; const ID: string]: longint read GetB write SetB;');
+  Add('  end;');
+  Add('function TObject.GetB(Index: longint; const ID: string): longint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.SetB(Index: longint; const ID: string; Value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.B[3,''abc'']:=7;');
+  Add('  if o.B[4,'''']=8 then;');
+  Add('  if 9=o.B[6,''d''] then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyArgsWithDefaultsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(Index: longint): boolean;');
+  Add('    procedure SetB(Index: longint; Value: boolean);');
+  Add('    property B[Index: longint = 0]: boolean read GetB write SetB;');
+  Add('  end;');
+  Add('function TObject.GetB(Index: longint): boolean;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.SetB(Index: longint; Value: boolean);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckParserException('Property arguments can not have default values',
+    PParser.nParserPropertyArgumentsCanNotHaveDefaultValues);
+end;
+
+procedure TTestResolver.TestProperty_Index;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    {#FItems}FItems: array of string;');
+  Add('    function {#GetItems}GetItems(Index: longint): string;');
+  Add('    procedure {#SetItems}SetItems(Index: longint; Value: string);');
+  Add('    procedure DoIt;');
+  Add('    property {#Items}Items[Index: longint]: string read {@GetItems}getitems write {@SetItems}setitems;');
+  Add('  end;');
+  Add('function tobject.getitems(index: longint): string;');
+  Add('begin');
+  Add('  Result:={@FItems}fitems[index];');
+  Add('end;');
+  Add('procedure tobject.setitems(index: longint; value: string);');
+  Add('begin');
+  Add('  {@FItems}fitems[index]:=value;');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  {@Items}items[1]:={@Items}items[2];');
+  Add('  self.{@Items}items[3]:=self.{@Items}items[4];');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.{@Items}Items[11]:=obj.{@Items}Items[12];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProperty_WrongTypeAsIndexFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetItems(Index: string): string;');
+  Add('    property Items[Index: string]: string read getitems;');
+  Add('  end;');
+  Add('function tobject.getitems(index: string): string;');
+  Add('begin');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.Items[3]:=4;');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestProperty_Option_ClassPropertyNonStatic;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proClassPropertyNonStatic];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class function GetB: longint;');
+  Add('    class procedure SetB(Value: longint);');
+  Add('    class property B: longint read GetB write SetB;');
+  Add('  end;');
+  Add('class function TObject.GetB: longint;');
+  Add('begin');
+  Add('end;');
+  Add('class procedure TObject.SetB(Value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TObject.B:=4;');
+  Add('  if TObject.B=6 then;');
+  Add('  if 7=TObject.B then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestDefaultProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function GetB(Index: longint): longint;');
+  Add('    procedure SetB(Index: longint; Value: longint);');
+  Add('    property B[Index: longint]: longint read GetB write SetB; default;');
+  Add('  end;');
+  Add('function TObject.GetB(Index: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure TObject.SetB(Index: longint; Value: longint);');
+  Add('begin');
+  Add('  if Value=Self[Index] then ;');
+  Add('  Self[Index]:=Value;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o[3]:=4;');
+  Add('  if o[5]=6 then;');
+  Add('  if 7=o[8] then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestMissingDefaultProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  if o[5]=6 then;');
+  CheckResolverException('illegal qualifier "["',
+    nIllegalQualifier);
+end;
+
+procedure TTestResolver.TestPropertyAssign;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    property B: longint read FB write FB;');
+  Add('  end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  {#a1_read}o.{#a2_assign}B:=i;');
+  Add('  i:={#b1_read}o.{#b2_read}B;');
+  Add('  if i={#c1_read}o.{#c2_read}B then ;');
+  Add('  if {#d1_read}o.{#d2_read}B=3 then ;');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestPropertyAssignReadOnlyFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    property B: longint read FB;');
+  Add('  end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  o.B:=3;');
+  CheckResolverException('No member is provided to access property',nPropertyNotWritable);
+end;
+
+procedure TTestResolver.TestProperty_PassAsParam;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proPropertyAsVarParam];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FA: longint;');
+  Add('    property A: longint read FA write FA;');
+  Add('  end;');
+  Add('procedure DoIt(i: longint; const j: longint; var k: longint; out l: longint);');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  DoIt({#o1_read}o.{#o_a1_read}a,');
+  Add('    {#o2_read}o.{#o_a2_read}a,');
+  Add('    {#o3_read}o.{#o_a3_var}a,');
+  Add('    {#o4_read}o.{#o_a4_out}a);');
+  Add('  with o do');
+  Add('    DoIt({#w_a1_read}a,');
+  Add('      {#w_a2_read}a,');
+  Add('      {#w_a3_var}a,');
+  Add('      {#w_a4_out}a);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestPropertyReadNonReadableFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FB: longint;');
+  Add('    property B: longint write FB;');
+  Add('  end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  if o.B=3 then;');
+  CheckResolverException('not readable',nNotReadable);
+end;
+
+procedure TTestResolver.TestWithBlock1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#TOBJ_A}A: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#a}a: longint;');
+  Add('begin');
+  Add('  {@a}a:=1;');
+  Add('  with {@o}o do');
+  Add('    {@TOBJ_A}a:=2;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestWithBlock2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#TOBJ_i}i: longint;');
+  Add('  end;');
+  Add('  {#TA}TClassA = class');
+  Add('    {#TA_j}j: longint;');
+  Add('    {#TA_b}{=TA}b: TClassA;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#a}{=TA}a: TClassA;');
+  Add('  {#i}i: longint;');
+  Add('begin');
+  Add('  {@i}i:=1;');
+  Add('  with {@o}o do');
+  Add('    {@TOBJ_i}i:=2;');
+  Add('  {@i}i:=1;');
+  Add('  with {@o}o,{@a}a do begin');
+  Add('    {@TOBJ_i}i:=3;');
+  Add('    {@TA_j}j:=4;');
+  Add('    {@TA_b}b:={@a}a;');
+  Add('  end;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestWithBlockFuncResult;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#TOBJ_i}i: longint;');
+  Add('  end;');
+  Add('  {#TA}TClassA = class');
+  Add('    {#TA_j}j: longint;');
+  Add('    {#TA_b}{=TA}b: TClassA;');
+  Add('  end;');
+  Add('function {#GiveA}Give: TClassA;');
+  Add('begin');
+  Add('end;');
+  Add('function {#GiveB}Give(i: longint): TClassA;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#a}{=TA}a: TClassA;');
+  Add('  {#i}i: longint;');
+  Add('begin');
+  Add('  with {@GiveA}Give do {@TOBJ_i}i:=3;');
+  Add('  with {@GiveA}Give() do {@TOBJ_i}i:=3;');
+  Add('  with {@GiveB}Give(2) do {@TOBJ_i}i:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestWithBlockConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TOBJ}TObject = class');
+  Add('    {#TOBJ_i}i: longint;');
+  Add('  end;');
+  Add('  {#TA}TClassA = class');
+  Add('    {#TA_j}j: longint;');
+  Add('    {#TA_b}{=TA}b: TClassA;');
+  Add('    constructor {#A_CreateA}Create;');
+  Add('    constructor {#A_CreateB}Create(i: longint);');
+  Add('  end;');
+  Add('constructor TClassA.Create;');
+  Add('begin');
+  Add('end;');
+  Add('constructor TClassA.Create(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  {#o}{=TOBJ}o: TObject;');
+  Add('  {#a}{=TA}a: TClassA;');
+  Add('  {#i}i: longint;');
+  Add('begin');
+  Add('  with TClassA.{@A_CreateA}Create do {@TOBJ_i}i:=3;');
+  Add('  with TClassA.{@A_CreateA}Create() do {@TOBJ_i}i:=3;');
+  Add('  with TClassA.{@A_CreateB}Create(2) do {@TOBJ_i}i:=3;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestDynArrayOfLongint;
+begin
+  StartProgram(false);
+  Add('type TIntArray = array of longint;');
+  Add('var a: TIntArray;');
+  Add('begin');
+  Add('  a:=nil;');
+  Add('  if a=nil then ;');
+  Add('  if nil=a then ;');
+  Add('  SetLength(a,3);');
+  Add('  a[0]:=1;');
+  Add('  a[1]:=length(a);');
+  Add('  a[2]:=a[0];');
+  Add('  if a[3]=a[4] then ;');
+  Add('  a[a[5]]:=a[a[6]];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestStaticArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array[1..2] of longint;');
+  Add('  TArrB = array[char] of boolean;');
+  Add('  TArrC = array[byte,''a''..''z''] of longint;');
+  Add('var');
+  Add('  a: TArrA;');
+  Add('  b: TArrB;');
+  Add('  c: TArrC;');
+  Add('begin');
+  Add('  a[1]:=1;');
+  Add('  if a[2]=length(a) then ;');
+  Add('  b[''x'']:=true;');
+  Add('  if b[''y''] then ;');
+  Add('  c[3,''f'']:=1;');
+  Add('  if c[4,''g'']=a[1] then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayOfArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array[byte] of longint;');
+  Add('  TArrB = array[smallint] of TArrA;');
+  Add('  TArrC = array of array of longint;');
+  Add('var');
+  Add('  b: TArrB;');
+  Add('  c: TArrC;');
+  Add('begin');
+  Add('  b[1][2]:=5;');
+  Add('  b[1,2]:=5;');
+  Add('  if b[2,1]=b[0,1] then ;');
+  Add('  c[3][4]:=c[5,6];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayOfArray_NameAnonymous;
+begin
+  ResolverEngine.AnonymousElTypePostfix:='$array';
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array of array of longint;');
+  Add('var');
+  Add('  a: TArrA;');
+  Add('begin');
+  Add('  a[1][2]:=5;');
+  Add('  a[1,2]:=5;');
+  Add('  if a[2,1]=a[0,1] then ;');
+  Add('  a[3][4]:=a[5,6];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestFunctionReturningArray;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TArrA = array[1..20] of longint;',
+  '  TArrB = array of TArrA;',
+  'function FuncC: TArrB;',
+  'begin',
+  '  SetLength(Result,3);',
+  'end;',
+  'begin',
+  '  FuncC[2,4]:=6;',
+  '  FuncC()[1,3]:=5;']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_LowHigh;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array[char] of longint;');
+  Add('  TArrB = array of TArrA;');
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  for c:=low(TArrA) to High(TArrA) do ;');
+  Add('  for i:=low(TArrB) to High(TArrB) do ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_AssignSameSignatureFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrA = array of longint;');
+  Add('  TArrB = array of longint;');
+  Add('var');
+  Add('  a: TArrA;');
+  Add('  b: TArrB;');
+  Add('begin');
+  Add('  a:=b;');
+  CheckResolverException('Incompatible types: got "TArrB" expected "TArrA"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_Assigned;
+begin
+  StartProgram(false);
+  Add('var a: array of longint;');
+  Add('begin');
+  Add('  if Assigned(a) then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPropertyOfTypeArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArray = array of longint;');
+  Add('  TObject = class');
+  Add('    FItems: TArray;');
+  Add('    function GetItems: TArray;');
+  Add('    procedure SetItems(Value: TArray);');
+  Add('    property Items: TArray read FItems write FItems;');
+  Add('    property Numbers: TArray read GetItems write SetItems;');
+  Add('  end;');
+  Add('function TObject.GetItems: TArray;');
+  Add('begin');
+  Add('  Result:=FItems;');
+  Add('end;');
+  Add('procedure TObject.SetItems(Value: TArray);');
+  Add('begin');
+  Add('  FItems:=Value;');
+  Add('end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Obj.Items[3]:=4;');
+  Add('  if Obj.Items[5]=6 then;');
+  Add('  Obj.Numbers[7]:=8;');
+  Add('  if Obj.Numbers[9]=10 then;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayElementFromFuncResult_AsParams;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCall: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type Integer = longint;');
+  Add('type TArrayInt = array of integer;');
+  Add('function GetArr(vB: integer = 0): tarrayint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure DoIt(vG: integer);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  doit({#a}getarr[1+1]);');
+  Add('  doit({#b}getarr()[2+1]);');
+  Add('  doit({#b}getarr(7)[3+1]);');
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestArrayElementFromFuncResult_AsParams ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCall:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestArrayElementFromFuncResult_AsParams ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          ActualImplicitCall:=true;
+        break;
+        end;
+      case aMarker^.Identifier of
+      'a':
+        if not ActualImplicitCall then
+          RaiseErrorAtSrcMarker('expected rrfImplicitCallWithoutParams at "#'+aMarker^.Identifier+'"',aMarker);
+      else
+        if ActualImplicitCall then
+          RaiseErrorAtSrcMarker('expected no rrfImplicitCallWithoutParams at "#'+aMarker^.Identifier+'"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestArrayEnumTypeRange;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('  TEnumArray = array[TEnum] of longint;');
+  Add('var');
+  Add('  e: TEnum;');
+  Add('  i: longint;');
+  Add('  a: TEnumArray;');
+  Add('  names: array[TEnum] of string = (''red'',''blue'');');
+  Add('begin');
+  Add('  e:=low(a);');
+  Add('  e:=high(a);');
+  Add('  i:=length(a);');
+  Add('  i:=a[red];');
+  Add('  a[e]:=a[e];');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayEnumTypeConstNotEnoughValuesFail1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('var');
+  Add('  a: array[TEnum] of string = (''red'');');
+  Add('begin');
+  CheckResolverException('Expect 2 array elements, but found 1',nExpectXArrayElementsButFoundY);
+end;
+
+procedure TTestResolver.TestArrayEnumTypeConstNotEnoughValuesFail2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue,green);');
+  Add('var');
+  Add('  a: array[TEnum] of string = (''red'',''blue'');');
+  Add('begin');
+  CheckResolverException('Expect 3 array elements, but found 2',nExpectXArrayElementsButFoundY);
+end;
+
+procedure TTestResolver.TestArrayEnumTypeConstWrongTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('var');
+  Add('  a: array[TEnum] of string = (1,2);');
+  Add('begin');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArrayEnumTypeConstNonConstFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('var');
+  Add('  s: string;');
+  Add('  a: array[TEnum] of string = (''red'',s);');
+  Add('begin');
+  CheckResolverException('Constant expression expected',
+    nConstantExpressionExpected);
+end;
+
+procedure TTestResolver.TestArrayEnumTypeSetLengthFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('var');
+  Add('  a: array[TEnum] of longint;');
+  Add('begin');
+  Add('  SetLength(a,1);');
+  CheckResolverException('Incompatible type arg no. 1: Got "static array[] of Longint", expected "string or dynamic array variable"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestArray_DynArrayConst;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TArrInt = array of integer;',
+  '  TArrStr = array of string;',
+  'const',
+  '  Ints: TArrInt = (1,2,3);',
+  '  Names: array of string = (''a'',''foo'');',
+  '  Aliases: TarrStr = (''foo'',''b'');',
+  '  OneInt: TArrInt = (7);',
+  '  OneStr: array of integer = (7);',
+  '  Chars: array of char = ''aoc'';',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestArray_AssignNilToStaticArrayFail1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('var');
+  Add('  a: array[TEnum] of longint;');
+  Add('begin');
+  Add('  a:=nil;');
+  CheckResolverException('Incompatible types: got "Nil" expected "array type"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_SetLengthProperty;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proPropertyAsVarParam];
+  StartProgram(false);
+  Add('type');
+  Add('  TArrInt = array of longint;');
+  Add('  TObject = class');
+  Add('    function GetColors: TArrInt; external name ''GetColors'';');
+  Add('    procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
+  Add('    property Colors: TArrInt read GetColors write SetColors;');
+  Add('  end;');
+  Add('procedure DoIt(var i: longint; out j: longint; const k: longint); begin end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  SetLength(Obj.Colors,2);');
+  Add('  DoIt(Obj.Colors[1],Obj.Colors[2],Obj.Colors[3]);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_PassArrayElementToVarParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrInt = array of longint;');
+  Add('procedure DoIt(var i: longint; out j: longint; const k: longint); begin end;');
+  Add('var a: TArrInt;');
+  Add('begin');
+  Add('  DoIt(a[1],a[2],a[3]);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_OpenArrayOfString;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(const a: array of String);');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
+  Add('end;');
+  Add('var s: string;');
+  Add('begin');
+  Add('  DoIt([]);');
+  Add('  DoIt([s,''foo'','''',s+s]);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_OpenArrayOfString_IntFail;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(const a: array of String);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt([1]);');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_OpenArrayOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  Exception = class');
+  Add('    constructor CreateFmt(const Msg: string; const Args: array of string); virtual;');
+  Add('  end;');
+  Add('  ESome = class(Exception)');
+  Add('    constructor CreateFmt(const Msg: string; const Args: array of string); override;');
+  Add('  end;');
+  Add('constructor Exception.CreateFmt(const Msg: string; const Args: array of string);');
+  Add('begin end;');
+  Add('constructor ESome.CreateFmt(const Msg: string; const Args: array of string);');
+  Add('begin');
+  Add('  inherited CreateFmt(Msg,Args);');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_CopyConcat;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArrayInt = array of integer;');
+  Add('function Get(A: TArrayInt): TArrayInt; begin end;');
+  Add('var');
+  Add('  i: integer;');
+  Add('  A: TArrayInt;');
+  Add('begin');
+  Add('  A:=Copy(A);');
+  Add('  A:=Copy(A,1);');
+  Add('  A:=Copy(A,2,3);');
+  Add('  A:=Copy(Get(A),2,3);');
+  Add('  Get(Copy(A));');
+  Add('  A:=Concat(A);');
+  Add('  A:=Concat(A,Get(A));');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_CopyMismatchFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArrayInt = array of integer;');
+  Add('  TArrayStr = array of string;');
+  Add('var');
+  Add('  i: integer;');
+  Add('  A: TArrayInt;');
+  Add('  B: TArrayStr;');
+  Add('begin');
+  Add('  A:=Copy(B);');
+  CheckResolverException('Incompatible types: got "TArrayStr" expected "TArrayInt"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_InsertDelete;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArrayInt = array of integer;');
+  Add('var');
+  Add('  i: integer;');
+  Add('  A: TArrayInt;');
+  Add('begin');
+  Add('  Insert({#a1_read}i+1,{#a2_var}A,{#a3_read}i+2);');
+  Add('  Delete({#b1_var}A,{#b2_read}i+3,{#b3_read}i+4);');
+  ParseProgram;
+  CheckAccessMarkers;
+end;
+
+procedure TTestResolver.TestArray_InsertItemMismatchFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TCaption = string;');
+  Add('  TArrayCap = array of TCaption;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  A: TArrayCap;');
+  Add('begin');
+  Add('  Insert(i,{#a2_var}A,2);');
+  CheckResolverException('Incompatible types: got "Longint" expected "String"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArray_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArrIntA = array of integer;');
+  Add('  TArrIntB = array of longint;');
+  Add('  TArrIntC = array of integer;');
+  Add('var');
+  Add('  a: TArrIntA;');
+  Add('  b: TArrIntB;');
+  Add('  c: TArrIntC;');
+  Add('begin');
+  Add('  a:=TArrIntA(a);');
+  Add('  a:=TArrIntA(b);');
+  Add('  a:=TArrIntA(c);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArray_TypeCastWrongElTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArrInt = array of integer;');
+  Add('  TArrStr = array of string;');
+  Add('var');
+  Add('  a: TArrInt;');
+  Add('  s: TArrStr;');
+  Add('begin');
+  Add('  a:=TArrInt(s);');
+  CheckResolverException('Illegal type conversion: "TArrStr" to "TArrInt"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestArray_ConstDynArrayWrite;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrInt = array of longint;');
+  Add('Procedure DoIt(const a: tarrint);');
+  Add('begin');
+  Add('  a[2]:=3;'); // FPC allows this for dynamic arrays
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestArray_ConstOpenArrayWriteFail;
+begin
+  StartProgram(false);
+  Add('Procedure DoIt(const a: array of longint);');
+  Add('begin');
+  Add('  a[2]:=3;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('Variable identifier expected',nVariableIdentifierExpected);
+end;
+
+procedure TTestResolver.TestArrayIntRange_OutOfRange;
+begin
+  StartProgram(false);
+  Add([
+  'type TArr = array[1..2] of longint;',
+  'var a: TArr;',
+  'begin',
+  '  a[0]:=3;',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    'range check error while evaluating constants (0 must be between 1 and 2)');
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestArrayEnumRange_OutOfRange;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (red,blue);',
+  '  TArr = array[TEnum] of longint;',
+  'var a: TArr;',
+  'begin',
+  '  a[red]:=3;',
+  '']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestArrayCharRange_OutOfRange;
+begin
+  StartProgram(false);
+  Add([
+  'type TArr = array[''a''..''b''] of longint;',
+  'var a: TArr;',
+  'begin',
+  '  a[''0'']:=3;',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nRangeCheckEvaluatingConstantsVMinMax,
+    'range check error while evaluating constants (''0'' must be between ''a'' and ''b'')');
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestProcTypesAssignObjFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TProcedure = procedure;');
+  Add('  TFunctionInt = function:longint;');
+  Add('  TFunctionIntFunc = function:TFunctionInt;');
+  Add('  TFunctionIntFuncFunc = function:TFunctionIntFunc;');
+  Add('function GetNumber: longint;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('function GetNumberFunc: TFunctionInt;');
+  Add('begin');
+  Add('  Result:=@GetNumber;');
+  Add('end;');
+  Add('function GetNumberFuncFunc: TFunctionIntFunc;');
+  Add('begin');
+  Add('  Result:=@GetNumberFunc;');
+  Add('end;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  f: TFunctionInt;');
+  Add('  ff: TFunctionIntFunc;');
+  Add('begin');
+  Add('  i:=GetNumber; // omit ()');
+  Add('  i:=GetNumber();');
+  Add('  i:=GetNumberFunc()();');
+  Add('  i:=GetNumberFuncFunc()()();');
+  Add('  if i=GetNumberFunc()() then ;');
+  Add('  if GetNumberFunc()()=i then ;');
+  Add('  if i=GetNumberFuncFunc()()() then ;');
+  Add('  if GetNumberFuncFunc()()()=i then ;');
+  Add('  f:=nil;');
+  Add('  if f=nil then ;');
+  Add('  if nil=f then ;');
+  Add('  if Assigned(f) then ;');
+  Add('  f:=f;');
+  Add('  f:=@GetNumber;');
+  Add('  f:=GetNumberFunc; // not in Delphi');
+  Add('  f:=GetNumberFunc(); // not in Delphi');
+  Add('  f:=GetNumberFuncFunc()();');
+  Add('  if f=f then ;');
+  Add('  if i=f then ;');
+  Add('  if i=f() then ;');
+  Add('  if f()=i then ;');
+  Add('  if f()=f() then ;');
+  Add('  if f=@GetNumber then ;');
+  Add('  if @GetNumber=f then ;');
+  Add('  if f=GetNumberFunc then ;');
+  Add('  if f=GetNumberFunc() then ;');
+  Add('  if f=GetNumberFuncFunc()() then ;');
+  Add('  ff:=nil;');
+  Add('  if ff=nil then ;');
+  Add('  if nil=ff then ;');
+  Add('  ff:=ff;');
+  Add('  if ff=ff then ;');
+  Add('  ff:=@GetNumberFunc;');
+  Add('  ff:=GetNumberFuncFunc; // not in Delphi');
+  Add('  ff:=GetNumberFuncFunc();');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestMethodTypesAssignObjFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class;');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TObject = class');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('    procedure SetOnClick(const Value: TNotifyEvent);');
+  Add('    procedure Notify(Sender: TObject);');
+  Add('    property OnClick: TNotifyEvent read FOnClick write SetOnClick;');
+  Add('  end;');
+  Add('procedure TObject.SetOnClick(const Value: TNotifyEvent);');
+  Add('begin');
+  Add('  if FOnClick=Value then exit;');
+  Add('  FOnClick:=Value;');
+  Add('end;');
+  Add('procedure TObject.Notify(Sender: TObject);');
+  Add('begin');
+  Add('  if Assigned(OnClick) and (OnClick<>@Notify) then begin');
+  Add('    OnClick(Sender);');
+  Add('    OnClick(Self);');
+  Add('    Self.OnClick(nil);');
+  Add('  end;');
+  Add('  if OnClick=@Self.Notify then ;');
+  Add('  if Self.OnClick=@Self.Notify then ;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.OnClick:=@o.Notify');
+  Add('  o.OnClick(nil);');
+  Add('  o.OnClick(o);');
+  Add('  o.SetOnClick(@o.Notify);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcTypeCall;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCallWithoutParams: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vI: longint = 1):longint;');
+  Add('  TFuncFuncInt = function(vI: longint = 1): TFuncInt;');
+  Add('procedure DoI(vI: longint); begin end;');
+  Add('procedure DoFConst(const vI: tfuncint); begin end;');
+  Add('procedure DoFVar(var vI: tfuncint); begin end;');
+  Add('procedure DoFDefault(vI: tfuncint); begin end;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  f: tfuncint;');
+  Add('begin');
+  Add('  {#a}f;');
+  Add('  {#b}f();');
+  Add('  {#c}f(2);');
+  Add('  i:={#d}f;');
+  Add('  i:={#e}f();');
+  Add('  i:={#f}f(2);');
+  Add('  doi({#g}f);');
+  Add('  doi({#h}f());');
+  Add('  doi({#i}f(2));');
+  Add('  dofconst({#j}f);');
+  Add('  if Assigned({#k}f) then;');
+  Add('  if {#l}f=nil then;');
+  Add('  if nil={#m}f then;');
+  ParseProgram;
+
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestProcTypeCall ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestProcTypeCall ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        //writeln('TTestResolver.TestProcTypeCall ',GetObjName(Ref.Declaration),' rrfImplicitCallWithoutParams=',rrfImplicitCallWithoutParams in Ref.Flags);
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          ActualImplicitCallWithoutParams:=true;
+        break;
+        end;
+      case aMarker^.Identifier of
+      'a','d','g':
+        if not ActualImplicitCallWithoutParams then
+          RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+'"',aMarker);
+      else
+        if ActualImplicitCallWithoutParams then
+          RaiseErrorAtSrcMarker('expected no implicit call at "#'+aMarker^.Identifier+'"',aMarker);
+      end;
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestProcType_FunctionFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('function DoIt(vI: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tfuncint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;'); // ok in fpc and delphi
+  //Add('  vp:=doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
+  Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
+  Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
+  Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
+  Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
+  Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
+  Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=Assigned(vp);');
+  //Add('  doit(vp);'); // illegal in fpc, ok in delphi
+  Add('  doit(vp());'); // ok in fpc and delphi
+  Add('  doit(vp(2));'); // ok in fpc and delphi
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_FunctionDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode Delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('function DoIt(vI: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tfuncint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;'); // ok in fpc and delphi
+  Add('  vp:=doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  //Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
+  //Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
+  //Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
+  Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
+  //Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
+  //Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
+  //Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
+  Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=Assigned(vp);');
+  Add('  doit(vp);'); // illegal in fpc, ok in delphi
+  Add('  doit(vp());'); // ok in fpc and delphi
+  Add('  doit(vp(2));'); // ok in fpc and delphi  *)
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_MethodFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('  end;');
+  Add('function tobject.doit(vA: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  vp:=@obj.doit;'); // ok in fpc and delphi
+  //Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:=vp=@obj.doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@obj.doit=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@obj.doit<>vp;'); // ok in fpc, illegal in delphi
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_MethodDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('  end;');
+  Add('function tobject.doit(vA: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  vp:=@obj.doit;'); // ok in fpc and delphi
+  Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  //Add('  b:=vp=@obj.doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@obj.doit=vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@obj.doit<>vp;'); // ok in fpc, illegal in delphi
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAssignProcToMethodFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('procedure ProcA(Sender: TObject);');
+  Add('begin end;');
+  Add('var n: TNotifyEvent;');
+  Add('begin');
+  Add('  n:=@ProcA;');
+  CheckResolverException('procedure type modifier "of Object" mismatch',
+    nXModifierMismatchY);
+end;
+
+procedure TTestResolver.TestAssignMethodToProcFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA(Sender: TObject);');
+  Add('  end;');
+  Add('  TNotifyProc = procedure(Sender: TObject);');
+  Add('procedure TObject.ProcA(Sender: TObject);');
+  Add('begin end;');
+  Add('var');
+  Add('  n: TNotifyProc;');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  n:=@o.ProcA;');
+  CheckResolverException('procedure type modifier "of Object" mismatch',
+    nXModifierMismatchY);
+end;
+
+procedure TTestResolver.TestAssignProcToFunctionFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(i: longint): longint;');
+  Add('procedure ProcA(i: longint);');
+  Add('begin end;');
+  Add('var p: TFuncInt;');
+  Add('begin');
+  Add('  p:=@ProcA;');
+  CheckResolverException(
+    'Incompatible types: got "procedure type" expected "function type"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestAssignProcWrongArgsFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TProcInt = procedure(i: longint);');
+  Add('procedure ProcA(i: string);');
+  Add('begin end;');
+  Add('var p: TProcInt;');
+  Add('begin');
+  Add('  p:=@ProcA;');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestAssignProcWrongArgAccessFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TProcInt = procedure(i: longint);');
+  Add('procedure ProcA(const i: longint);');
+  Add('begin end;');
+  Add('var p: TProcInt;');
+  Add('begin');
+  Add('  p:=@ProcA;');
+  CheckResolverException('Incompatible type arg no. 1: Got "access modifier const", expected "default"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestProcType_AssignNestedProcFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TProcInt = procedure(i: longint);');
+  Add('procedure ProcA;');
+  Add('var p: TProcInt;');
+  Add('  procedure SubProc(i: longint);');
+  Add('  begin');
+  Add('  end;');
+  Add('begin');
+  Add('  p:=@SubProc;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('procedure type modifier "is nested" mismatch',
+    nXModifierMismatchY);
+end;
+
+procedure TTestResolver.TestArrayOfProc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TNotifyProc = function(Sender: TObject = nil): longint;');
+  Add('  TProcArray = array of TNotifyProc;');
+  Add('function ProcA(Sender: TObject): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  a: TProcArray;');
+  Add('  p: TNotifyProc;');
+  Add('begin');
+  Add('  a[0]:=@ProcA;');
+  Add('  if a[1]=@ProcA then ;');
+  Add('  if @ProcA=a[2] then ;');
+  // Add('  a[3];'); ToDo
+  Add('  a[3](nil);');
+  Add('  if a[4](nil)=5 then ;');
+  Add('  if 6=a[7](nil) then ;');
+  Add('  a[8]:=a[9];');
+  Add('  p:=a[10];');
+  Add('  a[11]:=p;');
+  Add('  if a[12]=p then ;');
+  Add('  if p=a[13] then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_Assigned;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(i: longint): longint;');
+  Add('function ProcA(i: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  a: array of TFuncInt;');
+  Add('  p: TFuncInt;');
+  Add('begin');
+  Add('  if Assigned(p) then ;');
+  Add('  if Assigned(a[1]) then ;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_TNotifyEvent;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TButton = class(TObject)');
+  Add('  private');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('  published');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('  end;');
+  Add('  TApplication = class(TObject)');
+  Add('    procedure BtnClickHandler(Sender: TObject); external name ''BtnClickHandler'';');
+  Add('  end;');
+  Add('var ');
+  Add('  App: TApplication;');
+  Add('  Button1: TButton;');
+  Add('begin');
+  Add('  Button1.OnClick := @App.BtnClickHandler;');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_TNotifyEvent_NoAtFPC_Fail1;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TButton = class(TObject)');
+  Add('  private');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('  published');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('  end;');
+  Add('  TApplication = class(TObject)');
+  Add('    procedure BtnClickHandler(Sender: TObject); external name ''BtnClickHandler'';');
+  Add('  end;');
+  Add('var ');
+  Add('  App: TApplication;');
+  Add('  Button1: TButton;');
+  Add('begin');
+  Add('  Button1.OnClick := App.BtnClickHandler;');
+  CheckResolverException(
+    'Wrong number of parameters specified for call to "BtnClickHandler"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestProcType_TNotifyEvent_NoAtFPC_Fail2;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TButton = class(TObject)');
+  Add('  private');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('  published');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('  end;');
+  Add('  TApplication = class(TObject)');
+  Add('    procedure BtnClickHandler(Sender: TObject); external name ''BtnClickHandler'';');
+  Add('  end;');
+  Add('var ');
+  Add('  App: TApplication;');
+  Add('  Button1: TButton;');
+  Add('begin');
+  Add('  Button1.OnClick := App.BtnClickHandler();');
+  CheckResolverException(
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of Object"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestProcType_TNotifyEvent_NoAtFPC_Fail3;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TButton = class(TObject)');
+  Add('  private');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('  published');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('  end;');
+  Add('  TApplication = class(TObject)');
+  Add('    procedure BtnClickHandler(Sender: TObject); external name ''BtnClickHandler'';');
+  Add('  end;');
+  Add('var ');
+  Add('  App: TApplication;');
+  Add('  Button1: TButton;');
+  Add('begin');
+  Add('  Button1.OnClick := @App.BtnClickHandler();');
+  CheckResolverException(
+    'Wrong number of parameters specified for call to "procedure BtnClickHandler(TObject) of Object"',
+    nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolver.TestProcType_WhileListCompare;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArrInt = array of Integer;');
+  Add('  TListCompare = function(Item1, Item2: Integer): integer;');
+  Add('procedure Sort(P: Integer; const List: TArrInt; const Compare: TListCompare);');
+  Add('begin');
+  Add('  while Compare(P,List[0])>0 do ;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_IsNested;
+begin
+  StartProgram(false);
+  Add('{$modeswitch nestedprocvars}');
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TNestedProc = procedure(i: integer) is nested;');
+  Add('procedure DoIt(i: integer);');
+  Add('var p: TNestedProc;');
+  Add('  procedure Sub(i: integer);');
+  Add('  var SubP: TNestedProc;');
+  Add('    procedure SubSub(i: integer);');
+  Add('    begin');
+  Add('      p:=@Sub;');
+  Add('      p:=@SubSub;');
+  Add('      SubP:=@Sub;');
+  Add('      SubP:=@SubSub;');
+  Add('    end;');
+  Add('  begin');
+  Add('    p:=@Sub;');
+  Add('    p:=@SubSub;');
+  Add('    SubP:=@Sub;');
+  Add('    SubP:=@SubSub;');
+  Add('  end;');
+  Add('begin');
+  Add('  p:=@Sub;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_IsNested_AssignProcFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch nestedprocvars}');
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TNestedProc = procedure(i: integer) is nested;');
+  Add('procedure DoIt(i: integer); begin end;');
+  Add('var p: TNestedProc;');
+  Add('begin');
+  Add('  p:=@DoIt;');
+  CheckResolverException('procedure type modifier "is nested" mismatch',nXModifierMismatchY);
+end;
+
+procedure TTestResolver.TestProcType_ReferenceTo;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProcRef = reference to procedure(i: longint = 0);',
+  '  TFuncRef = reference to function(i: longint = 0): longint;',
+  '  TObject = class',
+  '    function Grow(s: longint): longint;',
+  '  end;',
+  'var',
+  '  p: TProcRef;',
+  '  f: TFuncRef;',
+  'function tobject.Grow(s: longint): longint;',
+  '  function GrowSub(i: longint): longint;',
+  '  begin',
+  '    f:=@Grow;',
+  '    f:=@GrowSub;',
+  '    f;',
+  '    f();',
+  '    f(1);',
+  '  end;',
+  'begin',
+  '  f:=@Grow;',
+  '  f:=@GrowSub;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  'end;',
+  'procedure DoIt(i: longint);',
+  'begin',
+  'end;',
+  'function GetIt(i: longint): longint;',
+  '  function Sub(i: longint): longint;',
+  '  begin',
+  '    p:=@DoIt;',
+  '    f:=@GetIt;',
+  '    f:=@Sub;',
+  '  end;',
+  'begin',
+  '  p:=@DoIt;',
+  '  f:=@GetIt;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  'end;',
+  'begin',
+  '  p:=@DoIt;',
+  '  f:=@GetIt;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  '  p:=TProcRef(f);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_AllowNested;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proProcTypeWithoutIsNested];
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TProc = procedure(i: integer);');
+  Add('procedure DoIt(i: integer);');
+  Add('var p: TProc;');
+  Add('  procedure Sub(i: integer);');
+  Add('  var SubP: TProc;');
+  Add('    procedure SubSub(i: integer);');
+  Add('    begin');
+  Add('      p:=@DoIt;');
+  Add('      p:=@Sub;');
+  Add('      p:=@SubSub;');
+  Add('      SubP:=@DoIt;');
+  Add('      SubP:=@Sub;');
+  Add('      SubP:=@SubSub;');
+  Add('    end;');
+  Add('  begin');
+  Add('    p:=@DoIt;');
+  Add('    p:=@Sub;');
+  Add('    p:=@SubSub;');
+  Add('    SubP:=@DoIt;');
+  Add('    SubP:=@Sub;');
+  Add('    SubP:=@SubSub;');
+  Add('  end;');
+  Add('begin');
+  Add('  p:=@DoIt;');
+  Add('  p:=@Sub;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_AllowNestedOfObject;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proProcTypeWithoutIsNested];
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TMethodProc = procedure(i: integer) of object;');
+  Add('  TObject = class');
+  Add('    procedure DoIt(i: integer);');
+  Add('  end;');
+  Add('procedure TObject.DoIt(i: integer);');
+  Add('var p: TMethodProc;');
+  Add('  procedure Sub(i: integer);');
+  Add('  var SubP: TMethodProc;');
+  Add('    procedure SubSub(i: integer);');
+  Add('    begin');
+  Add('      p:=@DoIt;');
+  Add('      p:=@Sub;');
+  Add('      p:=@SubSub;');
+  Add('      SubP:=@DoIt;');
+  Add('      SubP:=@Sub;');
+  Add('      SubP:=@SubSub;');
+  Add('    end;');
+  Add('  begin');
+  Add('    p:=@DoIt;');
+  Add('    p:=@Sub;');
+  Add('    p:=@SubSub;');
+  Add('    SubP:=@DoIt;');
+  Add('    SubP:=@Sub;');
+  Add('    SubP:=@SubSub;');
+  Add('  end;');
+  Add('begin');
+  Add('  p:=@DoIt;');
+  Add('  p:=@Sub;');
+  Add('end;');
+  Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_AsArgOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  JSInteger = longint;',
+    '  TObject = class;',
+    '  TJSArrayCallBack = function (element : JSInteger) : Boolean;',
+    '  TObject = class',
+    '  public',
+    '    procedure forEach(const aCallBack : TJSArrayCallBack); virtual; abstract;',
+    '  end;',
+    '']),
+    '');
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('function showElement(el : JSInteger) : boolean  ;');
+  Add('begin');
+  Add('  result:=true;');
+  Add('end;');
+  Add('var a: TObject;');
+  Add('begin');
+  Add('  a.forEach(@ShowElement);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TControl = class');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('    procedure Click(Sender: TObject);');
+  Add('  end;');
+  Add('procedure TControl.Click(Sender: TObject);');
+  Add('begin');
+  Add('  if Assigned(OnClick) then ;');
+  Add('  OnClick:=@Click');
+  Add('  OnClick(Sender);');
+  Add('  Self.OnClick(Sender);');
+  Add('  with Self do OnClick(Sender);');
+  Add('end;');
+  Add('var Btn: TControl;');
+  Add('begin');
+  Add('  if Assigned(Btn.OnClick) then ;');
+  Add('  Btn.OnClick(Btn);');
+  Add('  Btn.OnClick(Btn);');
+  Add('  with Btn do OnClick(Btn);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_PropertyCallWrongArgFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
+  Add('  TControl = class');
+  Add('    FOnClick: TNotifyEvent;');
+  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
+  Add('  end;');
+  Add('var Btn: TControl;');
+  Add('begin');
+  Add('  Btn.OnClick(3);');
+  CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "TObject"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestProcType_Typecast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TNotifyEvent = procedure(Sender: Pointer) of object;');
+  Add('  TEvent = procedure of object;');
+  Add('  TProcA = procedure(i: longint);');
+  Add('  TFuncB = function(i, j: longint): longint;');
+  Add('var');
+  Add('  Notify: TNotifyEvent;');
+  Add('  Event: TEvent;');
+  Add('  ProcA: TProcA;');
+  Add('  FuncB: TFuncB;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  Notify:=TNotifyEvent(Event);');
+  Add('  Event:=TEvent(Event);');
+  Add('  Event:=TEvent(Notify);');
+  Add('  ProcA:=TProcA(FuncB);');
+  Add('  FuncB:=TFuncB(FuncB);');
+  Add('  FuncB:=TFuncB(ProcA);');
+  Add('  ProcA:=TProcA(p);');
+  Add('  FuncB:=TFuncB(p);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_InsideFunction;
+begin
+  StartProgram(false);
+  Add([
+  'function GetIt: longint;',
+  'type TGetter = function: longint;',
+  'var',
+  '  p: Pointer;',
+  'begin',
+  '  Result:=TGetter(p)();',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProcType_PassProcToUntyped;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCallWithoutParams: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEvent = procedure of object;',
+  '  TFunc = function: longint of object;',
+  'procedure DoIt; varargs; begin end;',
+  'procedure DoSome(const a; var b; c: pointer); begin end;',
+  'var',
+  '  E: TEvent;',
+  '  F: TFunc;',
+  'begin',
+  '  DoIt({#a1}E,{#a2}F);',
+  '  DoSome({#b1}E,{#b2}E,{#b3}E);',
+  '  DoSome({#c1}F,{#c2}F,{#c3}F);',
+  '']);
+  ParseProgram;
+
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestProcType_PassProcToUntyped ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCallWithoutParams:=false;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestProcType_PassProcToUntyped ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        //writeln('TTestResolver.TestProcType_PassProcToUntyped ',GetObjName(Ref.Declaration),' rrfImplicitCallWithoutParams=',rrfImplicitCallWithoutParams in Ref.Flags);
+        if rrfImplicitCallWithoutParams in Ref.Flags then
+          ActualImplicitCallWithoutParams:=true;
+        break;
+        end;
+      if ActualImplicitCallWithoutParams then
+        RaiseErrorAtSrcMarker('expected no implicit call at "#'+aMarker^.Identifier+'"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
+procedure TTestResolver.TestPointer;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TClass = class of TObject;');
+  Add('  TMyPtr = pointer;');
+  Add('  TArrInt = array of longint;');
+  Add('  TFunc = function: longint;');
+  Add('procedure DoIt; begin end;');
+  Add('var');
+  Add('  p: TMyPtr;');
+  Add('  Obj: TObject;');
+  Add('  Cl: TClass;');
+  Add('  a: tarrint;');
+  Add('  f: TFunc;');
+  Add('begin');
+  Add('  p:=nil;');
+  Add('  if p=nil then;');
+  Add('  if nil=p then;');
+  Add('  if Assigned(p) then;');
+  Add('  p:=obj;');
+  Add('  p:=cl;');
+  Add('  p:=a;');
+  Add('  p:=Pointer(f);');
+  Add('  p:=@DoIt;');
+  Add('  p:=Pointer(@DoIt)');
+  Add('  obj:=TObject(p);');
+  Add('  cl:=TClass(p);');
+  Add('  a:=TArrInt(p);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPointer_AssignPointerToClassFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  obj:=p;');
+  CheckResolverException('Incompatible types: got "Pointer" expected "TObject"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestPointer_TypecastToMethodTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  e:=TEvent(p);');
+  CheckResolverException('Illegal type conversion: "Pointer" to "procedure type of Object"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestPointer_TypecastFromMethodTypeFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  p:=Pointer(e);');
+  CheckResolverException('Illegal type conversion: "procedure type of Object" to "Pointer"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestPointer_TypecastMethod_proMethodAddrAsPointer;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proMethodAddrAsPointer];
+  StartProgram(false);
+  Add('type');
+  Add('  TEvent = procedure of object;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  e: TEvent;');
+  Add('begin');
+  Add('  e:=TEvent(p);');
+  Add('  p:=Pointer(e);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestPointer_OverloadSignature;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TClass = class of TObject;');
+  Add('  TBird = class(TObject) end;');
+  Add('  TBirds = class of TBird;');
+  Add('procedure {#pointer}DoIt(p: Pointer); begin end;');
+  Add('procedure {#tobject}DoIt(o: TObject); begin end;');
+  Add('procedure {#tclass}DoIt(c: TClass); begin end;');
+  Add('var');
+  Add('  p: pointer;');
+  Add('  o: TObject;');
+  Add('  c: TClass;');
+  Add('  b: TBird;');
+  Add('  bc: TBirds;');
+  Add('begin');
+  Add('  {@pointer}DoIt(p);');
+  Add('  {@tobject}DoIt(o);');
+  Add('  {@tclass}DoIt(c);');
+  Add('  {@tobject}DoIt(b);');
+  Add('  {@tclass}DoIt(bc);');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestHint_ElementHints;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TDeprecated = longint deprecated;',
+  '  TLibrary = longint library;',
+  '  TPlatform = longint platform;',
+  '  TExperimental = longint experimental;',
+  '  TUnimplemented = longint unimplemented;',
+  'var',
+  '  vDeprecated: TDeprecated;',
+  '  vLibrary: TLibrary;',
+  '  vPlatform: TPlatform;',
+  '  vExperimental: TExperimental;',
+  '  vUnimplemented: TUnimplemented;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nSymbolXIsDeprecated,'Symbol "TDeprecated" is deprecated');
+  CheckResolverHint(mtWarning,nSymbolXBelongsToALibrary,'Symbol "TLibrary" belongs to a library');
+  CheckResolverHint(mtWarning,nSymbolXIsNotPortable,'Symbol "TPlatform" is not portable');
+  CheckResolverHint(mtWarning,nSymbolXIsExperimental,'Symbol "TExperimental" is experimental');
+  CheckResolverHint(mtWarning,nSymbolXIsNotImplemented,'Symbol "TUnimplemented" is implemented');
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestHint_ElementHintsMsg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TDeprecated = longint deprecated ''foo'';',
+  'var',
+  '  vDeprecated: TDeprecated;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nSymbolXIsDeprecatedY,'Symbol "TDeprecated" is deprecated: ''foo''');
+  CheckResolverUnexpectedHints;
+end;
+
+initialization
+  RegisterTests([TTestResolver]);
+
+end.
+
diff --git a/packages/fcl-passrc/tests/tcscanner.pas b/packages/fcl-passrc/tests/tcscanner.pas
index 33ff26e684..7f95a78b98 100644
--- a/packages/fcl-passrc/tests/tcscanner.pas
+++ b/packages/fcl-passrc/tests/tcscanner.pas
@@ -60,25 +60,35 @@ type
     procedure TearDown; override;
     Function TokenToString(tk : TToken) : string;
     Procedure AssertEquals(Msg : String; Expected,Actual : TToken); overload;
+    Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitch); overload;
+    Procedure AssertEquals(Msg : String; Expected,Actual : TModeSwitches); overload;
     procedure NewSource(Const Source : string; DoClear : Boolean = True);
     Procedure DoTestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
     Procedure TestToken(t : TToken; Const ASource : String; Const CheckEOF : Boolean = True);
     Procedure TestTokens(t : array of TToken; Const ASource : String; Const CheckEOF : Boolean = True;Const DoClear : Boolean = True);
     Property LastIDentifier : String Read FLI Write FLi;
+    Property Scanner : TPascalScanner Read FScanner;
   published
+    Procedure TestEmpty;
     procedure TestEOF;
     procedure TestWhitespace;
     procedure TestComment1;
     procedure TestComment2;
     procedure TestComment3;
+    procedure TestComment4;
+    procedure TestComment5;
     procedure TestNestedComment1;
     procedure TestNestedComment2;
     procedure TestNestedComment3;
     procedure TestNestedComment4;
+    procedure TestNestedComment5;
     procedure TestIdentifier;
+    procedure TestSelf;
+    procedure TestSelfNoToken;
     procedure TestString;
     procedure TestNumber;
     procedure TestChar;
+    procedure TestCharString;
     procedure TestBraceOpen;
     procedure TestBraceClose;
     procedure TestMul;
@@ -120,6 +130,7 @@ type
     procedure TestConst;
     procedure TestConstructor;
     procedure TestDestructor;
+    procedure TestDispinterface;
     procedure TestDiv;
     procedure TestDo;
     procedure TestDownto;
@@ -162,10 +173,11 @@ type
     procedure TestRecord;
     procedure TestRepeat;
     procedure TestResourceString;
-    procedure TestSelf;
     procedure TestSet;
     procedure TestShl;
     procedure TestShr;
+    procedure TestShlC;
+    procedure TestShrC;
     procedure TestSpecialize;
     procedure TestThen;
     procedure TestThreadvar;
@@ -182,13 +194,17 @@ type
     procedure TestXor;
     procedure TestLineEnding;
     procedure TestTab;
+    Procedure TestEscapedKeyWord;
     Procedure TestTokenSeries;
     Procedure TestTokenSeriesNoWhiteSpace;
     Procedure TestTokenSeriesComments;
     Procedure TestTokenSeriesNoComments;
     Procedure TestDefine0;
+    procedure TestDefine01;
     Procedure TestDefine1;
     Procedure TestDefine2;
+    Procedure TestDefine21;
+    procedure TestDefine22;
     Procedure TestDefine3;
     Procedure TestDefine4;
     Procedure TestDefine5;
@@ -199,6 +215,8 @@ type
     Procedure TestDefine10;
     Procedure TestDefine11;
     Procedure TestDefine12;
+    Procedure TestDefine13;
+    Procedure TestDefine14;
     Procedure TestInclude;
     Procedure TestInclude2;
     Procedure TestUnDefine1;
@@ -206,6 +224,23 @@ type
     procedure TestMacro2;
     procedure TestMacro3;
     procedure TestMacroHandling;
+    procedure TestIFDefined;
+    procedure TestIFUnDefined;
+    procedure TestIFAnd;
+    procedure TestIFAndShortEval;
+    procedure TestIFOr;
+    procedure TestIFOrShortEval;
+    procedure TestIFXor;
+    procedure TestIFAndOr;
+    procedure TestIFEqual;
+    procedure TestIFNotEqual;
+    procedure TestIFGreaterThan;
+    procedure TestIFGreaterEqualThan;
+    procedure TestIFLesserThan;
+    procedure TestIFLesserEqualThan;
+    procedure TestIFDefinedElseIf;
+    procedure TestIfError;
+    Procedure TestModeSwitch;
   end;
 
 implementation
@@ -354,16 +389,48 @@ begin
   AssertEquals(Msg,TokenToString(Expected),TokenToString(Actual));
 end;
 
+procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TModeSwitch);
+begin
+  AssertEquals(Msg,GetEnumName(TypeInfo(TModeSwitch),Ord(Expected)),
+                   GetEnumName(TypeInfo(TModeSwitch),Ord(Actual)))
+end;
+
+procedure TTestScanner.AssertEquals(Msg: String; Expected, Actual: TModeSwitches);
+
+  Function ToString(S : TModeSwitches) : String;
+
+  Var
+    M : TModeSwitch;
+
+  begin
+    Result:='';
+    For M in TModeswitch do
+      if M in S then
+        begin
+        If (Result<>'') then
+          Result:=Result+', ';
+        Result:=Result+GetEnumName(TypeInfo(TModeSwitch), Ord(M));
+        end;
+  end;
+
+begin
+  AssertEquals(Msg,ToString(Expected),ToString(Actual));
+end;
+
 procedure TTestScanner.NewSource(const Source: string; DoClear : Boolean = True);
 begin
   if DoClear then
     FResolver.Clear;
   FResolver.AddStream('afile.pp',TStringStream.Create(Source));
+  Writeln('// '+TestName);
+  Writeln(Source);
+//  FreeAndNil(FScanner);
+//  FScanner:=TTestingPascalScanner.Create(FResolver);
   FScanner.OpenFile('afile.pp');
 end;
 
 procedure TTestScanner.DoTestToken(t: TToken; const ASource: String;
-  Const CheckEOF: Boolean);
+  const CheckEOF: Boolean);
 
 Var
   tk : ttoken;
@@ -378,10 +445,12 @@ begin
     if (tk=tkLineEnding) and not (t in [tkEOF,tkLineEnding]) then
       tk:=FScanner.FetchToken;
     AssertEquals('EOF reached.',tkEOF,FScanner.FetchToken);
-    end;
+    end
+
 end;
 
-procedure TTestScanner.TestToken(t: TToken; const ASource: String; Const CheckEOF: Boolean);
+procedure TTestScanner.TestToken(t: TToken; const ASource: String;
+  const CheckEOF: Boolean);
 Var
   S : String;
 begin
@@ -397,7 +466,7 @@ begin
 end;
 
 procedure TTestScanner.TestTokens(t: array of TToken; const ASource: String;
-  const CheckEOF: Boolean;Const DoClear : Boolean = True);
+  const CheckEOF: Boolean; const DoClear: Boolean);
 Var
   tk : ttoken;
   i : integer;
@@ -420,6 +489,13 @@ begin
     end;
 end;
 
+procedure TTestScanner.TestEmpty;
+begin
+  AssertNotNull('Have Scanner',Scanner);
+  AssertTrue('Options is empty',[]=Scanner.Options);
+  AssertEquals('FPC modes is default',FPCModeSwitches,Scanner.CurrentModeSwitches);
+end;
+
 procedure TTestScanner.TestEOF;
 begin
   TestToken(tkEOF,'')
@@ -453,6 +529,20 @@ begin
   TestToken(tkComment,'//');
 end;
 
+procedure TTestScanner.TestComment4;
+
+begin
+  DoTestToken(tkComment,'(* abc *)',False);
+  AssertEquals('Correct comment',' abc ',Scanner.CurTokenString);
+end;
+
+procedure TTestScanner.TestComment5;
+
+begin
+  DoTestToken(tkComment,'(* abc'+LineEnding+'def *)',False);
+  AssertEquals('Correct comment',' abc'+LineEnding+'def ',Scanner.CurTokenString);
+end;
+
 procedure TTestScanner.TestNestedComment1;
 begin
   TestToken(tkComment,'// { comment } ');
@@ -473,6 +563,11 @@ begin
   TestToken(tkComment,'{ (* comment *) }');
 end;
 
+procedure TTestScanner.TestNestedComment5;
+begin
+  TestToken(tkComment,'(* (* comment *) *)');
+end;
+
 
 procedure TTestScanner.TestIdentifier;
 
@@ -487,6 +582,11 @@ begin
   TestToken(pscanner.tkString,'''A string''');
 end;
 
+procedure TTestScanner.TestCharString;
+
+begin
+  TestToken(pscanner.tkChar,'''A''');
+end;
 
 procedure TTestScanner.TestNumber;
 
@@ -788,6 +888,10 @@ begin
   TestToken(tkdestructor,'destructor');
 end;
 
+procedure TTestScanner.TestDispinterface;
+begin
+  TestToken(tkdispinterface,'dispinterface');
+end;
 
 procedure TTestScanner.TestDiv;
 
@@ -895,7 +999,7 @@ end;
 
 procedure TTestScanner.TestHelper;
 begin
-  TestToken(tkHelper,'helper');
+  TestToken(tkIdentifier,'helper');
 end;
 
 
@@ -1007,7 +1111,7 @@ end;
 procedure TTestScanner.TestOn;
 
 begin
-  TestToken(tkon,'on');
+  TestToken(tkIdentifier,'on');
 end;
 
 
@@ -1084,9 +1188,15 @@ end;
 procedure TTestScanner.TestSelf;
 
 begin
+  FScanner.Options:=FScanner.Options + [po_selftoken];
   TestToken(tkself,'self');
 end;
 
+procedure TTestScanner.TestSelfNoToken;
+begin
+  TestToken(tkIdentifier,'self');
+end;
+
 
 procedure TTestScanner.TestSet;
 
@@ -1108,6 +1218,16 @@ begin
   TestToken(tkshr,'shr');
 end;
 
+procedure TTestScanner.TestShlC;
+begin
+  TestToken(tkshl,'<<');
+end;
+
+procedure TTestScanner.TestShrC;
+begin
+  TestToken(tkshr,'>>');
+end;
+
 
 procedure TTestScanner.TestSpecialize;
 
@@ -1220,6 +1340,11 @@ begin
   TestToken(tkTab,#9);
 end;
 
+procedure TTestScanner.TestEscapedKeyWord;
+begin
+  TestToken(tkIdentifier,'&xor');
+end;
+
 procedure TTestScanner.TestTokenSeries;
 begin
   TestTokens([tkin,tkWhitespace,tkOf,tkWhiteSpace,tkthen,tkWhiteSpace,tkIdentifier],'in of then aninteger')
@@ -1249,6 +1374,13 @@ begin
     Fail('Define not defined');
 end;
 
+procedure TTestScanner.TestDefine01;
+begin
+  TestTokens([tkComment],'(*$DEFINE NEVER*)');
+  If FSCanner.Defines.IndexOf('NEVER')=-1 then
+    Fail('Define not defined');
+end;
+
 procedure TTestScanner.TestDefine1;
 begin
   TestTokens([tkComment],'{$IFDEF NEVER} of {$ENDIF}');
@@ -1261,6 +1393,19 @@ begin
   TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ENDIF}');
 end;
 
+procedure TTestScanner.TestDefine21;
+begin
+  FSCanner.Defines.Add('ALWAYS');
+  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'(*$IFDEF ALWAYS*) of (*$ENDIF*)');
+end;
+
+procedure TTestScanner.TestDefine22;
+begin
+  FSCanner.Defines.Add('ALWAYS');
+  // No whitespace. Test border of *)
+  TestTokens([tkComment,tkOf,tkWhitespace,tkcomment],'(*$IFDEF ALWAYS*)of (*$ENDIF*)');
+end;
+
 procedure TTestScanner.TestDefine3;
 begin
   FSCanner.Defines.Add('ALWAYS');
@@ -1328,6 +1473,33 @@ begin
   TestTokens([tkin],'{$IFDEF ALWAYS} of {$ELSE} in {$ENDIF}');
 end;
 
+procedure TTestScanner.TestDefine13;
+begin
+  FScanner.SkipComments:=True;
+  FScanner.SkipWhiteSpace:=True;
+  TestTokens([tkin],'{$IFDEF ALWAYS} }; ą è {$ELSE} in {$ENDIF}');
+end;
+
+procedure TTestScanner.TestDefine14;
+Const
+   Source = '{$ifdef NEVER_DEFINED}' +sLineBreak+
+            'type'+sLineBreak+
+            '  TNPEventModel = ('+sLineBreak+
+            '  NPEventModelCarbon = 0,'+sLineBreak+
+            '  NPEventModelCocoa = 1'+sLineBreak+
+            '}; // yes, this is an error... except this code should never be included.'+sLineBreak+
+            'ą'+sLineBreak+
+            '|'+sLineBreak+
+            '{$endif}'+sLineBreak+
+            ''+sLineBreak+
+            'begin'+sLineBreak+
+            'end.'+sLineBreak;
+begin
+  NewSource(Source,True);
+  While FScanner.fetchToken<>tkEOF do
+
+end;
+
 procedure TTestScanner.TestInclude;
 begin
   FResolver.AddStream('myinclude.inc',TStringStream.Create('if true then'));
@@ -1355,21 +1527,21 @@ procedure TTestScanner.TestMacro1;
 begin
   FScanner.SkipWhiteSpace:=True;
   FScanner.SkipComments:=True;
-  TestTokens([tkbegin,tkend,tkDot],'{$DEFINE MM:=begin end.}'#13#10'MM',True,False);
+  TestTokens([tkbegin,tkend,tkDot],'{$MACRO on}{$DEFINE MM:=begin end.}'#13#10'MM',True,False);
 end;
 
 procedure TTestScanner.TestMacro2;
 begin
   FScanner.SkipWhiteSpace:=True;
   FScanner.SkipComments:=True;
-  TestTokens([tkbegin,tkend,tkDot],'{$DEFINE MM:=begin end}'#13#10'MM .',True,False);
+  TestTokens([tkbegin,tkend,tkDot],'{$MACRO on}{$DEFINE MM:=begin end}'#13#10'MM .',True,False);
 end;
 
 procedure TTestScanner.TestMacro3;
 begin
   FScanner.SkipComments:=True;
   FScanner.SkipWhiteSpace:=True;
-  TestTokens([tkof],'{$DEFINE MM:=begin end}'#13#10'{$IFDEF MM} of {$ELSE} in {$ENDIF}');
+  TestTokens([tkof],'{$MACRO on}{$DEFINE MM:=begin end}'#13#10'{$IFDEF MM} of {$ELSE} in {$ENDIF}');
 end;
 
 procedure TTestScanner.TestMacroHandling;
@@ -1377,12 +1549,181 @@ begin
   TTestingPascalScanner(FScanner).DoSpecial:=True;
   FScanner.SkipComments:=True;
   FScanner.SkipWhiteSpace:=True;
-  TestTokens([tkIdentifier],'{$DEFINE MM:=begin end}'#13#10'MM');
+  TestTokens([tkIdentifier],'{$MACRO on}{$DEFINE MM:=begin end}'#13#10'MM');
   AssertEQuals('Correct identifier', 'somethingweird',LastIdentifier);
 end;
 
+procedure TTestScanner.TestIFDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],'{$DEFINE A}{$IF defined(A)}begin{$ENDIF}end.',True,False);
+end;
 
+procedure TTestScanner.TestIFUnDefined;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],'{$IF undefined(A)}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFAnd;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$DEFINE A}{$IF defined(A) and undefined(B)}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFAndShortEval;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$UNDEFINE A}{$IF defined(A) and undefined(B)}wrong{$ELSE}begin{$ENDIF}end.',
+    True,False);
+end;
+
+procedure TTestScanner.TestIFOr;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$DEFINE B}{$IF defined(A) or defined(B)}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFOrShortEval;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$DEFINE A}{$IF defined(A) or defined(B)}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFXor;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$DEFINE B}{$IF defined(A) xor defined(B)}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFAndOr;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkbegin,tkend,tkDot],
+     '{$IF   defined(A) and   defined(B) or   defined(C)}wrong1{$ENDIF}'+LineEnding
+    +'{$IF   defined(A) and   defined(B) or undefined(C)}{$ELSE}wrong2{$ENDIF}'+LineEnding
+    +'{$IF   defined(A) and undefined(B) or   defined(C)}wrong3{$ENDIF}'+LineEnding
+    +'{$IF   defined(A) and undefined(B) or undefined(C)}{$ELSE}wrong4{$ENDIF}'+LineEnding
+    +'{$IF undefined(A) and   defined(B) or   defined(C)}wrong5{$ENDIF}'+LineEnding
+    +'{$IF undefined(A) and   defined(B) or undefined(C)}{$ELSE}wrong6{$ENDIF}'+LineEnding
+    +'{$IF undefined(A) and undefined(B) or   defined(C)}{$ELSE}wrong7{$ENDIF}'+LineEnding
+    +'{$IF undefined(A) and undefined(B) or undefined(C)}begin{$ENDIF}end.',
+    True,False);
+end;
+
+procedure TTestScanner.TestIFEqual;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddMacro('Version','30101');
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$IF Version=30101}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFNotEqual;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddMacro('Version','30101');
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$IF Version<>30000}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFGreaterThan;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddMacro('Version','30101');
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$IF Version>30000}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFGreaterEqualThan;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddMacro('Version','30101');
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$IF Version>=30000}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFLesserThan;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddMacro('Version','30101');
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$IF Version<40000}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFLesserEqualThan;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddMacro('Version','30101');
+  TestTokens([tkbegin,tkend,tkDot],
+    '{$IF Version<=30101}begin{$ENDIF}end.',True,False);
+end;
+
+procedure TTestScanner.TestIFDefinedElseIf;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  FScanner.AddDefine('cpu32');
+  TestTokens([tkconst,tkIdentifier,tkEqual,tkString,tkSemicolon,tkbegin,tkend,tkDot],
+    'const platform = '+LineEnding
+    +'{$if defined(cpu32)} ''x86'''+LineEnding
+    +'{$elseif defined(cpu64)} ''x64'''+LineEnding
+    +'{$else} {$error unknown platform} {$endif};'+LineEnding
+    +'begin end.',True,False);
+end;
 
+procedure TTestScanner.TestIfError;
+begin
+  FScanner.SkipWhiteSpace:=True;
+  FScanner.SkipComments:=True;
+  TestTokens([tkprogram,tkIdentifier,tkSemicolon,tkbegin,tkend,tkDot],
+    'program Project1;'+LineEnding
+    +'begin'+LineEnding
+    +'{$if sizeof(integer) <> 4} {$error wrong sizeof(integer)} {$endif}'+LineEnding
+    +'end.',True,False);
+end;
+
+procedure TTestScanner.TestModeSwitch;
+
+Const
+   PlusMinus = [' ','+','-'];
+
+Var
+  M : TModeSwitch;
+  C : Char;
+begin
+  For M in TModeSwitch do
+    for C in PlusMinus do
+      if SModeSwitchNames[M]<>'' then
+        begin
+        Scanner.CurrentModeSwitches:=[];
+        NewSource('{$MODESWITCH '+SModeSwitchNames[M]+' '+C+'}');
+        While not (Scanner.FetchToken=tkEOF) do;
+        if C in [' ','+'] then
+          AssertTrue(SModeSwitchNames[M]+C+' sets '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches)
+        else
+          AssertFalse(SModeSwitchNames[M]+C+' removes '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches);
+        end;
+end;
 
 initialization
   RegisterTests([TTestTokenFinder,TTestStreamLineReader,TTestScanner]);
diff --git a/packages/fcl-passrc/tests/tcstatements.pas b/packages/fcl-passrc/tests/tcstatements.pas
index c58ba0d735..652bb67db8 100644
--- a/packages/fcl-passrc/tests/tcstatements.pas
+++ b/packages/fcl-passrc/tests/tcstatements.pas
@@ -1,3 +1,7 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestStatementParser.TestCallQualified2
+}
 unit tcstatements;
 
 {$mode objfpc}{$H+}
@@ -15,6 +19,8 @@ Type
   private
     FStatement: TPasImplBlock;
     FVariables : TStrings;
+    procedure DoTestCallOtherFormat;
+    procedure TestCallFormat(FN: String; Two: Boolean);
   Protected
     Procedure SetUp; override;
     Procedure TearDown; override;
@@ -44,12 +50,22 @@ Type
     Procedure TestCallQualified2;
     Procedure TestCallNoArgs;
     Procedure TestCallOneArg;
+    procedure TestCallWriteFormat1;
+    procedure TestCallWriteFormat2;
+    procedure TestCallWritelnFormat1;
+    procedure TestCallWritelnFormat2;
+    procedure TestCallStrFormat1;
+    procedure TestCallStrFormat2;
+    procedure TestCallOtherFormat;
     Procedure TestIf;
     Procedure TestIfBlock;
     Procedure TestIfAssignment;
     Procedure TestIfElse;
     Procedure TestIfElseBlock;
     Procedure TestIfSemiColonElseError;
+    procedure TestIfforElseBlock;
+    procedure TestIfRaiseElseBlock;
+    procedure TestIfWithBlock;
     Procedure TestNestedIf;
     Procedure TestNestedIfElse;
     Procedure TestWhile;
@@ -75,10 +91,12 @@ Type
     Procedure TestCase2Cases;
     Procedure TestCaseBlock;
     Procedure TestCaseElseBlockEmpty;
+    procedure TestCaseOtherwiseBlockEmpty;
     Procedure TestCaseElseBlockAssignment;
     Procedure TestCaseElseBlock2Assignments;
     Procedure TestCaseIfCaseElse;
     Procedure TestCaseIfElse;
+    Procedure TestCaseElseNoSemicolon;
     Procedure TestRaise;
     Procedure TestRaiseEmpty;
     Procedure TestRaiseAt;
@@ -92,9 +110,21 @@ Type
     Procedure TestTryExceptOn2;
     Procedure TestTryExceptOnElse;
     Procedure TestTryExceptOnIfElse;
+    procedure TestTryExceptRaise;
     Procedure TestAsm;
+    Procedure TestAsmBlock;
+    Procedure TestAsmBlockWithEndLabel;
+    Procedure TestAsmBlockInIfThen;
+    Procedure TestGotoInIfThen;
+    procedure AssignToAddress;
+    procedure FinalizationNoSemicolon;
+    procedure MacroComment;
+    Procedure PLatformIdentifier;
+    Procedure PLatformIdentifier2;
+    Procedure Onidentifier;
   end;
 
+
 implementation
 
 { TTestStatementParser }
@@ -116,7 +146,7 @@ procedure TTestStatementParser.AddStatements(ASource: array of string);
 Var
   I :Integer;
 begin
-  StartProgram('afile');
+  StartProgram(ExtractFileUnitName(MainFilename));
   if FVariables.Count>0 then
     begin
     Add('Var');
@@ -364,9 +394,10 @@ begin
   S:=Statement as TPasImplSimple;
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   B:=S.Expr as TBinaryExpr;
+  TAssert.AssertSame('B.left.Parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.Parent=B',B,B.right.Parent);
   AssertExpression('Unit name',B.Left,pekIdent,'Unita');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
-
 end;
 
 procedure TTestStatementParser.TestCallQualified2;
@@ -381,11 +412,11 @@ begin
   S:=Statement as TPasImplSimple;
   AssertExpression('Doit call',S.Expr,pekBinary,TBinaryExpr);
   B:=S.Expr as TBinaryExpr;
-  AssertExpression('Unit name',B.Left,pekIdent,'Unita');
-  AssertExpression('Doit call',B.Right,pekBinary,TBinaryExpr);
-  B:=B.Right  as TBinaryExpr;
-  AssertExpression('Unit name',B.Left,pekIdent,'ClassB');
   AssertExpression('Doit call',B.Right,pekIdent,'Doit');
+  AssertExpression('First two parts of unit name',B.left,pekBinary,TBinaryExpr);
+  B:=B.left as TBinaryExpr;
+  AssertExpression('Unit name part 1',B.Left,pekIdent,'Unita');
+  AssertExpression('Unit name part 2',B.right,pekIdent,'ClassB');
 end;
 
 procedure TTestStatementParser.TestCallNoArgs;
@@ -406,6 +437,7 @@ begin
 end;
 
 procedure TTestStatementParser.TestCallOneArg;
+
 Var
   S : TPasImplSimple;
   P : TParamsExpr;
@@ -422,6 +454,76 @@ begin
   AssertExpression('Parameter is constant',P.Params[0],pekNumber,'1');
 end;
 
+procedure TTestStatementParser.TestCallFormat(FN : String; Two : Boolean);
+
+Var
+  S : TPasImplSimple;
+  P : TParamsExpr;
+  N : String;
+begin
+  N:=fn+'(a:3';
+  if Two then
+    N:=N+':2';
+  N:=N+');';
+  TestStatement(N);
+  AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
+  AssertEquals('Simple statement',TPasImplSimple,Statement.ClassType);
+  S:=Statement as TPasImplSimple;
+  AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
+  P:=S.Expr as TParamsExpr;
+  AssertExpression('Correct function call name',P.Value,pekIdent,FN);
+  AssertEquals('One param',1,Length(P.Params));
+  AssertExpression('Parameter is identifier',P.Params[0],pekIdent,'a');
+  AssertExpression('Parameter has formatting constant 1' ,P.Params[0].format1,pekNumber,'3');
+  if Two then
+    AssertExpression('Parameter has formatting constant 2',P.Params[0].format2,pekNumber,'2');
+end;
+
+procedure TTestStatementParser.TestCallWriteFormat1;
+
+begin
+  TestCalLFormat('write',False);
+end;
+
+procedure TTestStatementParser.TestCallWriteFormat2;
+
+begin
+  TestCalLFormat('write',True);
+end;
+
+procedure TTestStatementParser.TestCallWritelnFormat1;
+begin
+  TestCalLFormat('writeln',False);
+
+end;
+
+procedure TTestStatementParser.TestCallWritelnFormat2;
+begin
+  TestCalLFormat('writeln',True);
+end;
+
+procedure TTestStatementParser.TestCallStrFormat1;
+begin
+  TestCalLFormat('str',False);
+end;
+
+procedure TTestStatementParser.TestCallStrFormat2;
+begin
+  TestCalLFormat('str',True);
+end;
+
+procedure TTestStatementParser.DoTestCallOtherFormat;
+
+begin
+  TestCalLFormat('nono',False);
+end;
+
+procedure TTestStatementParser.TestCallOtherFormat;
+
+begin
+  AssertException('Only Write(ln) and str allow format',EParserError,@DoTestCallOtherFormat);
+end;
+
 procedure TTestStatementParser.TestIf;
 
 Var
@@ -496,6 +598,41 @@ begin
   AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
 end;
 
+procedure TTestStatementParser.TestIfforElseBlock;
+
+Var
+  I : TPasImplIfElse;
+
+begin
+  TestStatement(['if a then','for X := 1 downto 0 do Writeln(X)','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('For statement',TPasImplForLoop,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfRaiseElseBlock;
+Var
+  I : TPasImplIfElse;
+begin
+  TestStatement(['if a then','raise','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('For statement',TPasImplRaise,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfWithBlock;
+Var
+  I : TPasImplIfElse;
+begin
+  TestStatement(['if a then','with b do something','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('For statement',TPasImplWithDo,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
 procedure TTestStatementParser.TestIfSemiColonElseError;
 
 begin
@@ -657,7 +794,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=1 to 10 do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Loop type',ltNormal,F.Looptype);
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
@@ -674,7 +811,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a in SomeSet Do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Loop type',ltIn,F.Looptype);
   AssertEquals('In loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekIdent,'SomeSet');
@@ -691,7 +828,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=1+1 to 5+5 do',';']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start expression',F.StartExpr,pekBinary,TBinaryExpr);
   B:=F.StartExpr as TBinaryExpr;
@@ -713,7 +850,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=1 to 10 do','begin','end']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
   AssertExpression('End value',F.EndExpr,pekNumber,'10');
@@ -731,7 +868,7 @@ begin
   DeclareVar('integer');
   TestStatement(['For a:=10 downto 1 do','begin','end']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Down loop',True,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'10');
   AssertExpression('End value',F.EndExpr,pekNumber,'1');
@@ -749,14 +886,14 @@ begin
   DeclareVar('integer','b');
   TestStatement(['For a:=1 to 10 do','For b:=11 to 20 do','begin','end']);
   F:=AssertStatement('For statement',TPasImplForLoop) as TPasImplForLoop;
-  AssertEquals('Loop variable name','a',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'a');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'1');
   AssertExpression('End value',F.EndExpr,pekNumber,'10');
   AssertNotNull('Have while body',F.Body);
   AssertEquals('begin end block',TPasImplForLoop,F.Body.ClassType);
   F:=F.Body as TPasImplForLoop;
-  AssertEquals('Loop variable name','b',F.VariableName);
+  AssertExpression('Loop variable name',F.VariableName,pekIdent,'b');
   AssertEquals('Up loop',False,F.Down);
   AssertExpression('Start value',F.StartExpr,pekNumber,'11');
   AssertExpression('End value',F.EndExpr,pekNumber,'20');
@@ -974,6 +1111,20 @@ begin
   AssertEquals('Zero statements ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
 end;
 
+procedure TTestStatementParser.TestCaseOtherwiseBlockEmpty;
+
+Var
+  C : TPasImplCaseOf;
+begin
+  DeclareVar('integer');
+  TestStatement(['case a of','1 : begin end;','otherwise',' end;']);
+  C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
+  AssertNotNull('Have case expression',C.CaseExpr);
+  AssertNotNull('Have else branch',C.ElseBranch);
+  AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
+  AssertEquals('Zero statements ',0,TPasImplCaseElse(C.ElseBranch).Elements.Count);
+end;
+
 procedure TTestStatementParser.TestCaseElseBlockAssignment;
 Var
   C : TPasImplCaseOf;
@@ -1067,6 +1218,29 @@ begin
   AssertNotNull('If statement has else block',TPasImplIfElse(S.Elements[0]).ElseBranch);
 end;
 
+procedure TTestStatementParser.TestCaseElseNoSemicolon;
+Var
+  C : TPasImplCaseOf;
+  S : TPasImplCaseStatement;
+begin
+  DeclareVar('integer');
+  TestStatement(['case a of','1 : dosomething;','2 : dosomethingmore','else','a:=1;','end;']);
+  C:=AssertStatement('Case statement',TpasImplCaseOf) as TpasImplCaseOf;
+  AssertNotNull('Have case expression',C.CaseExpr);
+  AssertExpression('Case expression',C.CaseExpr,pekIdent,'a');
+  AssertEquals('case label count',3,C.Elements.Count);
+  S:=TPasImplCaseStatement(C.Elements[0]);
+  AssertEquals('case 1',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'1');
+  S:=TPasImplCaseStatement(C.Elements[1]);
+  AssertEquals('case 2',1,S.Expressions.Count);
+  AssertExpression('Case With identifier 1',TPasExpr(S.Expressions[0]),pekNumber,'2');
+  AssertEquals('third is else',TPasImplCaseElse,TObject(C.Elements[2]).ClassType);
+  AssertNotNull('Have else branch',C.ElseBranch);
+  AssertEquals('Correct else branch class',TPasImplCaseElse,C.ElseBranch.ClassType);
+  AssertEquals('1 statements in else branch ',1,TPasImplCaseElse(C.ElseBranch).Elements.Count);
+end;
+
 procedure TTestStatementParser.TestRaise;
 
 Var
@@ -1306,8 +1480,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[0]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
 //  AssertEquals('Variable name',
@@ -1344,8 +1518,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[0]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse');
   // Exception handler 2
@@ -1353,8 +1527,8 @@ begin
   O:=TPasImplExceptOn(E.Elements[1]);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'Y');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception2');
+  AssertEquals('Exception Variable name','Y',O.VariableName);
+  AssertEquals('Exception Type name','Exception2',O.TypeName);
   S:=TPasImplSimple(O.Elements[0]);
   AssertExpression('DoSomethingElse call',S.Expr,pekIdent,'DoSomethingElse2');
 end;
@@ -1387,8 +1561,8 @@ begin
   AssertEquals(1,E.Elements.Count);
   AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
   O:=TPasImplExceptOn(E.Elements[0]);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplIfElse,TPasElement(O.Elements[0]).ClassType);
   I:=TPasImplIfElse(O.Elements[0]);
@@ -1430,8 +1604,8 @@ begin
   AssertEquals(1,E.Elements.Count);
   AssertEquals('Except on handler',TPasImplExceptOn,TPasElement(E.Elements[0]).ClassType);
   O:=TPasImplExceptOn(E.Elements[0]);
-  AssertExpression('Exception Variable name',O.VarExpr,pekIdent,'E');
-  AssertExpression('Exception Type name',O.TypeExpr,pekIdent,'Exception');
+  AssertEquals('Exception Variable name','E',O.VariableName);
+  AssertEquals('Exception Type name','Exception',O.TypeName);
   AssertEquals(1,O.Elements.Count);
   AssertEquals('Simple statement',TPasImplSimple,TPasElement(O.Elements[0]).ClassType);
   S:=TPasImplSimple(O.Elements[0]);
@@ -1445,6 +1619,29 @@ begin
   AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomethingMore');
 end;
 
+procedure TTestStatementParser.TestTryExceptRaise;
+Var
+  T : TPasImplTry;
+  S : TPasImplSimple;
+  E : TPasImplTryExcept;
+
+begin
+  TestStatement(['Try','  DoSomething;','except','  raise','end']);
+  T:=AssertStatement('Try statement',TPasImplTry) as TPasImplTry;
+  AssertEquals(1,T.Elements.Count);
+  AssertNotNull(T.FinallyExcept);
+  AssertNull(T.ElseBranch);
+  AssertNotNull(T.Elements[0]);
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
+  S:=TPasImplSimple(T.Elements[0]);
+  AssertExpression('DoSomething call',S.Expr,pekIdent,'DoSomething');
+  AssertEquals('Simple statement',TPasImplSimple,TPasElement(T.Elements[0]).ClassType);
+  AssertEquals('Except statement',TPasImplTryExcept,T.FinallyExcept.ClassType);
+  E:=TPasImplTryExcept(T.FinallyExcept);
+  AssertEquals(1,E.Elements.Count);
+  AssertEquals('Raise statement',TPasImplRaise,TPasElement(E.Elements[0]).ClassType);
+end;
+
 procedure TTestStatementParser.TestAsm;
 
 Var
@@ -1460,6 +1657,118 @@ begin
   AssertEquals('token 4 ','1',T.Tokens[3]);
 end;
 
+procedure TTestStatementParser.TestAsmBlock;
+begin
+  Source.Add('{$MODE DELPHI}');
+  Source.Add('function BitsHighest(X: Cardinal): Integer;');
+  Source.Add('asm');
+  Source.Add('end;');
+  Source.Add('begin');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestStatementParser.TestAsmBlockWithEndLabel;
+begin
+  Source.Add('{$MODE DELPHI}');
+  Source.Add('function BitsHighest(X: Cardinal): Integer;');
+  Source.Add('asm');
+  Source.Add('  MOV ECX, EAX');
+  Source.Add('  MOV EAX, -1');
+  Source.Add('  BSR EAX, ECX');
+  Source.Add('  JNZ @@End');
+  Source.Add('  MOV EAX, -1');
+  Source.Add('@@End:');
+  Source.Add('end;');
+  Source.Add('begin');
+  Source.Add('end.');
+  ParseModule;
+end;
+
+procedure TTestStatementParser.TestAsmBlockInIfThen;
+begin
+  Source.Add('{$MODE DELPHI}');
+  Source.Add('function Get8087StatusWord(ClearExceptions: Boolean): Word;');
+  Source.Add('  begin');
+  Source.Add('    if ClearExceptions then');
+  Source.Add('    asm');
+  Source.Add('    end');
+  Source.Add('    else');
+  Source.Add('    asm');
+  Source.Add('    end;');
+  Source.Add('  end;');
+  Source.Add('  begin');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
+Procedure TTestStatementParser.AssignToAddress;
+
+begin
+  AddStatements(['@Proc:=Nil']);
+  ParseModule;
+end;
+
+procedure TTestStatementParser.FinalizationNoSemicolon;
+begin
+  Source.Add('unit afile;');
+  Source.Add('{$mode objfpc}');
+  Source.Add('interface');
+  Source.Add('implementation');
+  Source.Add('initialization');
+  Source.Add('  writeln(''qqq'')');
+  Source.Add('finalization');
+  Source.Add('  writeln(''qqq'')');
+  ParseModule;
+end;
+
+procedure TTestStatementParser.MacroComment;
+begin
+  AddStatements(['{$MACRO ON}',
+  '{$DEFINE func := //}',
+  '  calltest;',
+  '  func (''1'',''2'',''3'');',
+  'CallTest2;'
+  ]);
+  ParseModule;
+end;
+
+procedure TTestStatementParser.PLatformIdentifier;
+begin
+  AddStatements(['write(platform);']);
+  ParseModule;
+end;
+
+procedure TTestStatementParser.PLatformIdentifier2;
+begin
+  AddStatements(['write(libs+platform);']);
+  ParseModule;
+end;
+
+procedure TTestStatementParser.Onidentifier;
+begin
+  Source.Add('function TryOn(const on: boolean): boolean;');
+  Source.Add('  begin');
+  Source.Add('  end;');
+  Source.Add('  begin');
+  Source.Add('  end.');
+  ParseModule;
+end;
+
+Procedure TTestStatementParser.TestGotoInIfThen;
+
+begin
+  AddStatements(['if expr then',
+  '  dosomething',
+  '   else if expr2 then',
+  '    goto try_qword',
+  '  else',
+  '    dosomething;',
+  '  try_qword:',
+  '  dosomething;']);
+  ParseModule;
+end;
+
 initialization
   RegisterTests([TTestStatementParser]);
 
diff --git a/packages/fcl-passrc/tests/tctypeparser.pas b/packages/fcl-passrc/tests/tctypeparser.pas
index 9f31a94bfa..647f57dbee 100644
--- a/packages/fcl-passrc/tests/tctypeparser.pas
+++ b/packages/fcl-passrc/tests/tctypeparser.pas
@@ -33,6 +33,7 @@ type
   TTestTypeParser = Class(TBaseTestTypeParser)
   private
   Protected
+    procedure StartTypeHelper(ForType: String; AParent: String);
     Procedure DoTestAliasType(Const AnAliasType : String; Const AHint : String);
     procedure DoTestStringType(const AnAliasType: String; const AHint: String);
     procedure DoTypeError(Const AMsg,ASource : string);
@@ -42,7 +43,7 @@ type
     Procedure DoParseEnumerated(Const ASource : String; Const AHint : String; ACount : integer);
     Procedure DoTestFileType(Const AType : String; Const AHint : String; ADestType : TClass = Nil);
     Procedure DoTestRangeType(Const AStart,AStop,AHint : String);
-    Procedure DoParseSimpleSet(Const ASource : String; Const AHint : String);
+    Procedure DoParseSimpleSet(Const ASource : String; Const AHint : String; IsPacked : Boolean = False);
     Procedure DoParseComplexSet(Const ASource : String; Const AHint : String);
     procedure DoParseRangeSet(const ASource: String; const AHint: String);
     Procedure DoTestComplexSet;
@@ -112,8 +113,13 @@ type
     procedure TestStaticArrayPlatform;
     Procedure TestStaticArrayPacked;
     Procedure TestStaticArrayTypedIndex;
+    Procedure TestStaticArrayOfMethod;
+    procedure TestStaticArrayOfProcedure;
     Procedure TestDynamicArray;
     Procedure TestDynamicArrayComment;
+    procedure TestDynamicArrayOfMethod;
+    procedure TestDynamicArrayOfProcedure;
+    Procedure TestGenericArray;
     Procedure TestSimpleEnumerated;
     Procedure TestSimpleEnumeratedComment;
     Procedure TestSimpleEnumeratedComment2;
@@ -126,6 +132,8 @@ type
     Procedure TestFileTypeDeprecated;
     Procedure TestFileTypePlatform;
     Procedure TestRangeType;
+    Procedure TestCharRangeType;
+    Procedure TestCharRangeType2;
     Procedure TestRangeTypeDeprecated;
     Procedure TestRangeTypePlatform;
     Procedure TestIdentifierRangeType;
@@ -133,11 +141,13 @@ type
     Procedure TestIdentifierRangeTypePlatform;
     Procedure TestNegativeIdentifierRangeType;
     Procedure TestSimpleSet;
+    Procedure TestPackedSet;
     Procedure TestSimpleSetDeprecated;
     Procedure TestSimpleSetPlatform;
     Procedure TestComplexSet;
     Procedure TestComplexSetDeprecated;
     Procedure TestComplexSetPlatform;
+    procedure TestRangeLowHigh;
     Procedure TestRangeSet;
     Procedure TestSubRangeSet;
     Procedure TestRangeSetDeprecated;
@@ -153,6 +163,10 @@ type
     Procedure TestReferenceFile;
     Procedure TestReferenceArray;
     Procedure TestReferencePointer;
+    Procedure TestInvalidColon;
+    Procedure TestTypeHelper;
+    procedure TestPointerReference;
+    Procedure TestPointerKeyWord;
   end;
 
   { TTestRecordTypeParser }
@@ -173,6 +187,7 @@ type
     procedure AssertField1(Hints: TPasMemberHints);
     procedure AssertField2(Hints: TPasMemberHints);
     procedure AssertMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
+    procedure AssertConstructor2(Hints: TPasMemberHints; isClass : Boolean = False);
     procedure AssertOperatorMethod2(Hints: TPasMemberHints; isClass : Boolean = False);
     procedure AssertVariant1(Hints: TPasMemberHints);
     procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
@@ -181,6 +196,7 @@ type
     procedure AssertOneIntegerField(Hints: TPasMemberHints);
     procedure AssertTwoIntegerFields(Hints1, Hints2: TPasMemberHints);
     procedure AssertIntegerFieldAndMethod(Hints1, Hints2: TPasMemberHints);
+    procedure AssertIntegerFieldAndConstructor(Hints1, Hints2: TPasMemberHints);
     procedure AssertRecordField(AIndex: Integer;Hints: TPasMemberHints);
     procedure AssertRecordVariant(AIndex: Integer;Hints: TPasMemberHints; VariantLabels : Array of string);
     Procedure AssertRecordVariantVariant(AIndex: Integer;Const AFieldName,ATypeName: string;Hints: TPasMemberHints; VariantLabels : Array of string);
@@ -225,6 +241,7 @@ type
     Procedure TestOnePlatformFieldDeprecated;
     Procedure TestOnePlatformFieldPlatform;
     Procedure TestOneConstOneField;
+    Procedure TestOneGenericField;
     Procedure TestTwoFields;
     procedure TestTwoFieldProtected;
     procedure TestTwoFieldStrictPrivate;
@@ -247,6 +264,7 @@ type
     Procedure TestTwoDeprecatedFieldsCombined;
     Procedure TestTwoDeprecatedFieldsCombinedDeprecated;
     Procedure TestTwoDeprecatedFieldsCombinedPlatform;
+    procedure TestFieldAndConstructor;
     Procedure TestFieldAndMethod;
     Procedure TestFieldAnd2Methods;
     Procedure TestFieldAndProperty;
@@ -398,6 +416,7 @@ type
     Procedure TestProcedureOutOpenArray;
     Procedure TestProcedureVarOpenArray;
     Procedure TestProcedureArrayOfConst;
+    Procedure TestProcedureReference;
     Procedure TestProcedureOfObject;
     Procedure TestProcedureOfObjectOneArg;
     Procedure TestProcedureIsNested;
@@ -694,6 +713,8 @@ begin
   AssertNotNull('have right expr', B.Right);
   AssertEquals('argument right expr type', TPrimitiveExpr, B.right.ClassType);
   AssertEquals('argument right expr value', '2', TPrimitiveExpr(B.right).Value);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 
 procedure TTestProcedureTypeParser.DoTestProcedureOneArgDefaultSet(
@@ -1072,6 +1093,13 @@ begin
   TestCallingConventions(@DoTestProcedureArrayOfConst);
 end;
 
+procedure TTestProcedureTypeParser.TestProcedureReference;
+begin
+  ParseType('reference to procedure',ccDefault,TPasProcedureType);
+  AssertEquals('Argument count',0,Proc.Args.Count);
+  AssertEquals('Is Reference to',True,Proc.IsReferenceTo);
+end;
+
 Procedure TTestProcedureTypeParser.TestProcedureOfObject;
 begin
   TestCallingConventions(@DoTestProcedureOfObject);
@@ -1188,13 +1216,12 @@ begin
   if HaveVariant then
     begin
     AssertNotNull('Have variants',TheRecord.Variants);
-    AssertNotNull('Have variant type',TheRecord.VariantType);
+    AssertNotNull('Have variant type',TheRecord.VariantEl);
     end
   else
     begin
     AssertNull('No variants',TheRecord.Variants);
-    AssertNull('No variant type',TheRecord.VariantType);
-    AssertEquals('No variant name','',TheRecord.VariantName);
+    AssertNull('No variant element',TheRecord.VariantEl);
     end;
   if AddComment then
     AssertComment;
@@ -1202,17 +1229,27 @@ end;
 
 procedure TTestRecordTypeParser.AssertVariantSelector(AName,AType : string);
 
+var
+  V: TPasVariable;
 begin
-  if (AType='') then
-    AType:='Integer';
-  AssertEquals('Have variant selector storage name',AName,TheRecord.VariantName);
-  AssertNotNull('Have variant selector type',TheRecord.VariantType);
-  AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,TheRecord.VariantType.ClassType);
-  AssertEquals('Have variant selector type name',AType,TheRecord.VariantType.Name);
+  AssertNotNull('Have variant element',TheRecord.VariantEl);
+  if AName<>'' then
+    begin
+    AssertEquals('Have variant variable',TPasVariable,TheRecord.VariantEl.ClassType);
+    V:=TPasVariable(TheRecord.VariantEl);
+    AssertEquals('Have variant variable name',AName,V.Name);
+    AssertNotNull('Have variant var type',V.VarType);
+    AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,V.VarType.ClassType);
+    AssertEquals('Have variant selector type name',lowercase(AType),lowercase(V.VarType.Name));
+    end else begin
+    AssertEquals('Have variant selector type',TPasUnresolvedTypeRef,TheRecord.VariantEl.ClassType);
+    AssertEquals('Have variant selector type name',lowercase(AType),lowercase(TheRecord.VariantEl.Name));
+    end;
 end;
 
 procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints);
 begin
+  if Hints=[] then ;
   AssertEquals('Member 1 type',TPasConst,TObject(TheRecord.Members[0]).ClassType);
   AssertEquals('Const 1 name','x',Const1.Name);
   AssertNotNull('Have 1 const expr',Const1.Expr);
@@ -1313,7 +1350,7 @@ procedure TTestRecordTypeParser.DoTestVariantNoStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : (y : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([]);
 end;
 
@@ -1322,7 +1359,7 @@ procedure TTestRecordTypeParser.DoTestDeprecatedVariantNoStorage(
 begin
   TestFields(['x : integer;','case integer of','0 : (y : integer deprecated;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([hDeprecated]);
 end;
 
@@ -1331,7 +1368,7 @@ procedure TTestRecordTypeParser.DoTestDeprecatedVariantStorage(
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([hDeprecated]);
 end;
 
@@ -1339,7 +1376,7 @@ procedure TTestRecordTypeParser.DoTestVariantStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([]);
 end;
 
@@ -1347,7 +1384,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsNoStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([]);
   AssertVariant2([]);
 end;
@@ -1356,7 +1393,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsStorage(const AHint: string);
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer;);','1 : (z : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([]);
   AssertVariant2([]);
 end;
@@ -1366,7 +1403,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsFirstDeprecatedStorage(
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer deprecated;);','1 : (z : integer;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([hdeprecated]);
   AssertVariant2([]);
 end;
@@ -1376,7 +1413,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsSecondDeprecatedStorage(
 begin
   TestFields(['x : integer;','case s : integer of','0 : (y : integer ;);','1 : (z : integer deprecated;)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('s','');
+  AssertVariantSelector('s','integer');
   AssertVariant1([]);
   AssertVariant2([hdeprecated]);
 end;
@@ -1385,7 +1422,7 @@ procedure TTestRecordTypeParser.DoTestVariantTwoLabels(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0,1 : (y : integer)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([],['0','1']);
 end;
 
@@ -1393,7 +1430,7 @@ procedure TTestRecordTypeParser.DoTestTwoVariantsTwoLabels(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0,1 : (y : integer);','2,3 : (z : integer);'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertVariant1([],['0','1']);
   AssertVariant2([],['2','3']);
 end;
@@ -1402,7 +1439,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedRecord(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
 end;
 
@@ -1410,7 +1447,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariant(const AHint: string);
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer);','    2 : ( j :  byte)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[],['2'])
@@ -1421,7 +1458,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariantFirstDeprecated(
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer deprecated);','    2 : ( j :  byte)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[hDeprecated],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[],['2'])
@@ -1432,7 +1469,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariantSecondDeprecated(
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer );','    2 : ( j :  byte deprecated)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])
@@ -1443,7 +1480,7 @@ procedure TTestRecordTypeParser.DoTestVariantNestedVariantBothDeprecated(const A
 begin
   TestFields(['x : integer;','case integer of','0 : ( y : record','  z : integer;','  case byte of ','    1 : (i : integer deprecated );','    2 : ( j :  byte deprecated)', 'end)'],AHint,True);
   AssertField1([]);
-  AssertVariantSelector('','');
+  AssertVariantSelector('','integer');
   AssertRecordVariant(0,[],['0']);
   AssertRecordVariantVariant(0,'i','Integer',[hdeprecated],['1']);
   AssertRecordVariantVariant(1,'j','Byte',[hDeprecated],['2'])
@@ -1507,6 +1544,21 @@ begin
   AssertTrue('Method hints match',P.Hints=Hints)
 end;
 
+procedure TTestRecordTypeParser.AssertConstructor2(Hints: TPasMemberHints;
+  isClass: Boolean);
+Var
+  P : TPasProcedure;
+
+begin
+  if IsClass then
+    AssertEquals('Member 2 type',TPasClassConstructor,TObject(TheRecord.Members[1]).ClassType)
+  else
+    AssertEquals('Member 2 type',TPasConstructor,TObject(TheRecord.Members[1]).ClassType);
+  P:=TPasProcedure(TheRecord.Members[1]);
+  AssertEquals('Constructor name','create',P.Name);
+  AssertTrue('Constructor hints match',P.Hints=Hints)
+end;
+
 procedure TTestRecordTypeParser.AssertOperatorMethod2(Hints: TPasMemberHints;
   isClass: Boolean);
 Var
@@ -1546,6 +1598,14 @@ begin
   AssertMethod2(Hints2);
 end;
 
+procedure TTestRecordTypeParser.AssertIntegerFieldAndConstructor(Hints1,
+  Hints2: TPasMemberHints);
+begin
+  AssertEquals('Two members',2,TheRecord.Members.Count);
+  AssertField1(Hints1);
+  AssertConstructor2(Hints2);
+end;
+
 procedure TTestRecordTypeParser.AssertRecordField(AIndex: Integer;
   Hints: TPasMemberHints);
 
@@ -1733,6 +1793,16 @@ begin
   AssertField2([]);
 end;
 
+procedure TTestRecordTypeParser.TestOneGenericField;
+begin
+  TestFields(['Generic : Integer;'],'',False);
+  AssertEquals('Member 1 field type',TPasVariable,TObject(TheRecord.Members[0]).ClassType);
+  AssertEquals('Field 1 name','Generic',Field1.Name);
+  AssertNotNull('Have 1 Field type',Field1.VarType);
+  AssertEquals('Field 1 type',TPasUnresolvedTypeRef,Field1.VarType.ClassType);
+  AssertEquals('Field 1 type name','Integer',Field1.VarType.Name);
+end;
+
 procedure TTestRecordTypeParser.TestTwoFields;
 begin
   TestFields(['x : integer;','y : integer'],'',False);
@@ -1743,6 +1813,7 @@ procedure TTestRecordTypeParser.TestTwoFieldPrivateNoDelphi;
 Var
   EC : TClass;
 begin
+  EC:=nil;
   try
     TestFields(['private','x : integer'],'',False);
     Fail('Need po_Delphi for visibility specifier');
@@ -1758,16 +1829,22 @@ end;
 procedure TTestRecordTypeParser.TestTwoFieldProtected;
 Var
   B : Boolean;
+  EName: String;
 begin
+  B:=false;
+  EName:='';
   try
     TestFields(['protected','x : integer'],'',False);
     Fail('Protected not allowed as record visibility specifier')
   except
     on E : Exception do
+      begin
+      EName:=E.ClassName;
       B:=E is EParserError;
+      end;
   end;
   If not B then
-    Fail('Wrong exception class.');
+    Fail('Wrong exception class "'+EName+'".');
 end;
 
 procedure TTestRecordTypeParser.TestTwoFieldPrivate;
@@ -1886,6 +1963,14 @@ begin
   AssertTwoIntegerFields([hdeprecated],[hdeprecated]);
 end;
 
+procedure TTestRecordTypeParser.TestFieldAndConstructor;
+
+begin
+  Parser.Options:=[po_delphi];
+  TestFields(['x : integer;','constructor create;'],'',False);
+  AssertIntegerFieldAndConstructor([],[]);
+end;
+
 procedure TTestRecordTypeParser.TestFieldAndMethod;
 begin
   Parser.Options:=[po_delphi];
@@ -2307,6 +2392,7 @@ Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
 
 Var
   D : String;
+
 begin
   Hint:=AHint;
   Add('Type');
@@ -2321,11 +2407,19 @@ begin
   Add('  '+D+';');
 //  Writeln(source.text);
   ParseDeclarations;
-  AssertEquals('One type definition',1,Declarations.Types.Count);
+  if ATypeClass.InHeritsFrom(TPasClassType) then
+    AssertEquals('One type definition',1,Declarations.Classes.Count)
+  else
+    AssertEquals('One type definition',1,Declarations.Types.Count);
   If (AtypeClass<>Nil) then
-    AssertEquals('First declaration is type definition.',ATypeClass,TObject(Declarations.Types[0]).ClassType);
-  AssertEquals('First declaration has correct name.','A',TPasType(Declarations.Types[0]).Name);
-  Result:=TPasType(Declarations.Types[0]);
+    begin
+    if ATypeClass.InHeritsFrom(TPasClassType) then
+      Result:=TPasType(Declarations.Classes[0])
+    else
+      Result:=TPasType(Declarations.Types[0]);
+    AssertEquals('First declaration is type definition.',ATypeClass,Result.ClassType);
+    end;
+  AssertEquals('First declaration has correct name.','A',Result.Name);
   FType:=Result;
   Definition:=Result;
   if (Hint<>'') then
@@ -2440,12 +2534,15 @@ begin
   AssertEquals('Range start',AStop,Stringreplace(TPasRangeType(TheType).RangeEnd,' ','',[rfReplaceAll]));
 end;
 
-procedure TTestTypeParser.DoParseSimpleSet(const ASource: String;
-  const AHint: String);
+procedure TTestTypeParser.DoParseSimpleSet(const ASource: String; const AHint: String; IsPacked: Boolean);
 begin
-  ParseType('Set of '+ASource,TPasSetType,AHint);
+  if IsPacked then
+    ParseType('Packed Set of '+ASource,TPasSetType,AHint)
+  else
+    ParseType('Set of '+ASource,TPasSetType,AHint);
   AssertNotNull('Have enumtype',TPasSetType(TheType).EnumType);
   AssertEquals('Element type ',TPasUnresolvedTypeRef,TPasSetType(TheType).EnumType.ClassType);
+  AssertEquals('IsPacked is correct',isPacked,TPasSetType(TheType).IsPacked);
 end;
 
 procedure TTestTypeParser.DoParseComplexSet(const ASource: String;
@@ -2823,6 +2920,30 @@ begin
   AssertEquals('Array type','Boolean',TPasArrayType(TheType).IndexRange);
 end;
 
+procedure TTestTypeParser.TestStaticArrayOfMethod;
+begin
+  DoParseArray('array[0..127] of procedure of object','',TPasProcedureType);
+  AssertEquals('Array element type',TPasProcedureType,TPasArrayType(TheType).ElType.ClassType);
+end;
+
+procedure TTestTypeParser.TestStaticArrayOfProcedure;
+begin
+  DoParseArray('array[0..127] of procedure','',TPasProcedureType);
+  AssertEquals('Array element type',TPasProcedureType,TPasArrayType(TheType).ElType.ClassType);
+end;
+
+procedure TTestTypeParser.TestDynamicArrayOfMethod;
+begin
+  DoParseArray('array of procedure of object','',TPasProcedureType);
+  AssertEquals('Array element type',TPasProcedureType,TPasArrayType(TheType).ElType.ClassType);
+end;
+
+procedure TTestTypeParser.TestDynamicArrayOfProcedure;
+begin
+  DoParseArray('array of procedure ','',TPasProcedureType);
+  AssertEquals('Array element type',TPasProcedureType,TPasArrayType(TheType).ElType.ClassType);
+end;
+
 procedure TTestTypeParser.TestDynamicArray;
 begin
   DoParseArray('array of integer','',Nil);
@@ -2837,6 +2958,20 @@ begin
   AssertComment;
 end;
 
+procedure TTestTypeParser.TestGenericArray;
+begin
+  Add('Type');
+  Add('generic TArray<T> = array of T;');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One type definition',1,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasArrayType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('First declaration has correct name.','TArray',TPasType(Declarations.Types[0]).Name);
+  FType:=TPasType(Declarations.Types[0]);
+  AssertEquals('Array type','',TPasArrayType(TheType).IndexRange);
+  AssertEquals('Generic Array type',True,TPasArrayType(TheType).IsGenericArray);
+end;
+
 procedure TTestTypeParser.TestSimpleEnumerated;
 
 begin
@@ -2943,6 +3078,16 @@ begin
   DoTestRangeType('1','4','');
 end;
 
+procedure TTestTypeParser.TestCharRangeType;
+begin
+  DoTestRangeType('#1','#4','');
+end;
+
+procedure TTestTypeParser.TestCharRangeType2;
+begin
+  DoTestRangeType('''A''','''B''','');
+end;
+
 procedure TTestTypeParser.TestRangeTypeDeprecated;
 begin
   DoTestRangeType('1','4','deprecated');
@@ -3011,6 +3156,18 @@ begin
   DoTestComplexSet;
 end;
 
+procedure TTestTypeParser.TestPackedSet;
+begin
+  DoParseSimpleSet('Byte','',True);
+end;
+
+procedure TTestTypeParser.TestRangeLowHigh;
+
+begin
+  DoParseRangeSet('low(TRange)..high(TRange)','');
+end;
+
+
 procedure TTestTypeParser.TestRangeSet;
 begin
   // TRange = (rLow, rMiddle, rHigh);
@@ -3151,6 +3308,62 @@ begin
   AssertSame('Second declaration references first.',Declarations.Types[0],TPasPointerType(Declarations.Types[1]).DestType);
 end;
 
+procedure TTestTypeParser.TestInvalidColon;
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseType(':1..2',TPasSetType);
+  except
+    on E: EParserError do
+      ok:=true;
+  end;
+  AssertEquals('wrong colon in type raised an error',true,ok);
+end;
+
+
+procedure TTestTypeParser.StartTypeHelper(ForType: String; AParent: String);
+Var
+  S : String;
+begin
+
+  S:='TMyClass = Type Helper';
+  if (AParent<>'') then
+    begin
+    S:=S+'('+AParent;
+    S:=S+')';
+    end;
+  S:=S+' for '+ForType;
+  Add(S);
+
+end;
+
+procedure TTestTypeParser.TestTypeHelper;
+begin
+  ParseType('Type Helper for AnsiString end',TPasClassType,'');
+end;
+
+procedure TTestTypeParser.TestPointerReference;
+begin
+  Add('Type');
+  Add('  pReference = ^Reference;');
+  Add('  Reference = object');
+  Add('  end;');
+  ParseDeclarations;
+  AssertEquals('type definition count',1,Declarations.Types.Count);
+  AssertEquals('object definition count',1,Declarations.Classes.Count);
+end;
+
+procedure TTestTypeParser.TestPointerKeyWord;
+begin
+  Add('type');
+  Add('  &file = object');
+  Add('  end;');
+  ParseDeclarations;
+  AssertEquals('object definition count',1,Declarations.Classes.Count);
+end;
+
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);
diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas
new file mode 100644
index 0000000000..7b709a2b0b
--- /dev/null
+++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas
@@ -0,0 +1,1762 @@
+{
+  Examples:
+    ./testpassrc --suite=TTestResolver.TestEmpty
+}
+unit tcuseanalyzer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, PasTree, PScanner, PasResolver, tcbaseparser,
+  testregistry, strutils, tcresolver, PasUseAnalyzer, PasResolveEval;
+
+type
+
+  { TCustomTestUseAnalyzer }
+
+  TCustomTestUseAnalyzer = Class(TCustomTestResolver)
+  private
+    FAnalyzer: TPasAnalyzer;
+    FPAMessages: TFPList; // list of TPAMessage
+    FPAGoodMessages: TFPList;
+    function GetPAMessages(Index: integer): TPAMessage;
+    procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure AnalyzeModule; virtual;
+    procedure AnalyzeProgram; virtual;
+    procedure AnalyzeUnit; virtual;
+    procedure AnalyzeWholeProgram; virtual;
+    procedure CheckUsedMarkers; virtual;
+    procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
+      const MsgText: string); virtual;
+    procedure CheckUseAnalyzerUnexpectedHints; virtual;
+    procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
+  public
+    property Analyzer: TPasAnalyzer read FAnalyzer;
+    function PAMessageCount: integer;
+    property PAMessages[Index: integer]: TPAMessage read GetPAMessages;
+  end;
+
+  { TTestUseAnalyzer }
+
+  TTestUseAnalyzer = Class(TCustomTestUseAnalyzer)
+  published
+    // single module
+    procedure TestM_ProgramLocalVar;
+    procedure TestM_AssignStatement;
+    procedure TestM_BeginBlock;
+    procedure TestM_ForLoopStatement;
+    procedure TestM_AsmStatement;
+    procedure TestM_CaseOfStatement;
+    procedure TestM_IfThenElseStatement;
+    procedure TestM_WhileDoStatement;
+    procedure TestM_RepeatUntilStatement;
+    procedure TestM_TryFinallyStatement;
+    procedure TestM_TypeAlias;
+    procedure TestM_Unary;
+    procedure TestM_Const;
+    procedure TestM_Record;
+    procedure TestM_Array;
+    procedure TestM_NestedFuncResult;
+    procedure TestM_Enums;
+    procedure TestM_ProcedureType;
+    procedure TestM_Params;
+    procedure TestM_Class;
+    procedure TestM_ClassForward;
+    procedure TestM_Class_Property;
+    procedure TestM_Class_PropertyOverride;
+    procedure TestM_Class_MethodOverride;
+    procedure TestM_Class_MethodOverride2;
+    procedure TestM_TryExceptStatement;
+
+    // single module hints
+    procedure TestM_Hint_UnitNotUsed;
+    procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
+    procedure TestM_Hint_ParameterNotUsed;
+    procedure TestM_Hint_ParameterNotUsed_Abstract;
+    procedure TestM_Hint_ParameterNotUsedTypecast;
+    procedure TestM_Hint_LocalVariableNotUsed;
+    procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
+    procedure TestM_Hint_InterfaceUnitVariableUsed;
+    procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
+    procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
+    procedure TestM_Hint_LocalXYNotUsed;
+    procedure TestM_Hint_PrivateFieldIsNeverUsed;
+    procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
+    procedure TestM_Hint_PrivateMethodIsNeverUsed;
+    procedure TestM_Hint_LocalDestructor_No_IsNeverUsed;
+    procedure TestM_Hint_PrivateTypeNeverUsed;
+    procedure TestM_Hint_PrivateConstNeverUsed;
+    procedure TestM_Hint_PrivatePropertyNeverUsed;
+    procedure TestM_Hint_LocalClassInProgramNotUsed;
+    procedure TestM_Hint_LocalMethodInProgramNotUsed;
+    procedure TestM_Hint_AssemblerParameterIgnored;
+    procedure TestM_Hint_AssemblerDelphiParameterIgnored;
+    procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
+    procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
+    procedure TestM_Hint_FunctionResultRecord;
+    procedure TestM_Hint_FunctionResultPassRecordElement;
+    procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
+    procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
+
+    // whole program optimization
+    procedure TestWP_LocalVar;
+    procedure TestWP_UnitUsed;
+    procedure TestWP_UnitNotUsed;
+    procedure TestWP_UnitInitialization;
+    procedure TestWP_UnitFinalization;
+    procedure TestWP_CallInherited;
+    procedure TestWP_ProgramPublicDeclarations;
+    procedure TestWP_ClassDefaultProperty;
+    procedure TestWP_Published;
+    procedure TestWP_PublishedSetType;
+    procedure TestWP_PublishedArrayType;
+    procedure TestWP_PublishedClassOfType;
+    procedure TestWP_PublishedRecordType;
+    procedure TestWP_PublishedProcType;
+    procedure TestWP_PublishedProperty;
+    procedure TestWP_BuiltInFunctions;
+    procedure TestWP_TypeInfo;
+  end;
+
+implementation
+
+{ TCustomTestUseAnalyzer }
+
+procedure TCustomTestUseAnalyzer.OnAnalyzerMessage(Sender: TObject;
+  Msg: TPAMessage);
+begin
+  Msg.AddRef;
+  FPAMessages.Add(Msg);
+end;
+
+function TCustomTestUseAnalyzer.GetPAMessages(Index: integer): TPAMessage;
+begin
+  Result:=TPAMessage(FPAMessages[Index]);
+end;
+
+procedure TCustomTestUseAnalyzer.SetUp;
+begin
+  inherited SetUp;
+  FPAMessages:=TFPList.Create;
+  FPAGoodMessages:=TFPList.Create;
+  FAnalyzer:=TPasAnalyzer.Create;
+  FAnalyzer.Resolver:=ResolverEngine;
+  Analyzer.OnMessage:=@OnAnalyzerMessage;
+end;
+
+procedure TCustomTestUseAnalyzer.TearDown;
+var
+  i: Integer;
+begin
+  FreeAndNil(FPAGoodMessages);
+  for i:=0 to FPAMessages.Count-1 do
+    TPAMessage(FPAMessages[i]).Release;
+  FreeAndNil(FPAMessages);
+  FreeAndNil(FAnalyzer);
+  inherited TearDown;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeModule;
+begin
+  Analyzer.AnalyzeModule(Module);
+  Analyzer.EmitModuleHints(Module);
+  CheckUsedMarkers;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeProgram;
+begin
+  ParseProgram;
+  AnalyzeModule;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeUnit;
+begin
+  ParseUnit;
+  AnalyzeModule;
+end;
+
+procedure TCustomTestUseAnalyzer.AnalyzeWholeProgram;
+begin
+  ParseProgram;
+  Analyzer.AnalyzeWholeProgram(Module as TPasProgram);
+  CheckUsedMarkers;
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUsedMarkers;
+var
+  aMarker: PSrcMarker;
+  p: SizeInt;
+  Postfix: String;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  ExpectedUsed: Boolean;
+  FoundEl: TPAElement;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
+    p:=RPos('_',aMarker^.Identifier);
+    if p>1 then
+      begin
+      Postfix:=copy(aMarker^.Identifier,p+1);
+
+      if Postfix='used' then
+        ExpectedUsed:=true
+      else if Postfix='notused' then
+        ExpectedUsed:=false
+      else
+        RaiseErrorAtSrcMarker('TCustomTestUseAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker);
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        FoundEl:=nil;
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          FoundEl:=Analyzer.FindElement(El);
+          if FoundEl<>nil then break;
+          end;
+        if FoundEl<>nil then
+          begin
+          if not ExpectedUsed then
+            RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker);
+          end
+        else
+          begin
+          if ExpectedUsed then
+            RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker);
+          end;
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
+  MsgNumber: integer; const MsgText: string);
+var
+  i: Integer;
+  Msg: TPAMessage;
+  s: string;
+begin
+  i:=PAMessageCount-1;
+  while i>=0 do
+    begin
+    Msg:=PAMessages[i];
+    if (Msg.MsgNumber=MsgNumber) then
+      begin
+      if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
+        begin
+        FPAGoodMessages.Add(Msg);
+        exit;
+        end;
+      end;
+    dec(i);
+    end;
+  // mismatch
+  writeln('TCustomTestUseAnalyzer.CheckHasHint: ');
+  for i:=0 to PAMessageCount-1 do
+    begin
+    Msg:=PAMessages[i];
+    writeln('  ',i,'/',PAMessageCount,': [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') {',Msg.MsgText,'}');
+    end;
+  s:='';
+  str(MsgType,s);
+  Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUseAnalyzerUnexpectedHints;
+var
+  i: Integer;
+  Msg: TPAMessage;
+  s: String;
+begin
+  for i:=0 to PAMessageCount-1 do
+    begin
+    Msg:=PAMessages[i];
+    if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
+    s:='';
+    str(Msg.MsgType,s);
+    Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
+    end;
+end;
+
+procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string;
+  Used: boolean);
+var
+  aResolver: TTestEnginePasResolver;
+  PAEl: TPAElement;
+begin
+  aResolver:=FindModuleWithFilename(aFilename);
+  AssertNotNull('unit not found "'+aFilename+'"',aResolver);
+  AssertNotNull('unit module not found "'+aFilename+'"',aResolver.Module);
+  PAEl:=Analyzer.FindElement(aResolver.Module);
+  if PAEl<>nil then
+    begin
+    // unit is used
+    if not Used then
+      Fail('expected unit "'+aFilename+'" not used, but it is used');
+    end
+  else
+    begin
+    // unit is not used
+    if Used then
+      Fail('expected unit "'+aFilename+'" used, but it is not used');
+    end;
+end;
+
+function TCustomTestUseAnalyzer.PAMessageCount: integer;
+begin
+  Result:=FPAMessages.Count;
+end;
+
+{ TTestUseAnalyzer }
+
+procedure TTestUseAnalyzer.TestM_ProgramLocalVar;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var {#l_notused}l: longint;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_AssignStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_notused}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('begin');
+  Add('  b:=c;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_BeginBlock;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('begin');
+  Add('  begin');
+  Add('  a:=1;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_ForLoopStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  for a:=b to c do d:=a;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_AsmStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('begin');
+  Add('  asm end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_CaseOfStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('const');
+  Add('  {#a_used}a = 1;');
+  Add('  {#b_used}b = 2;');
+  Add('var');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  case a of');
+  Add('    b: c:=1;');
+  Add('  else');
+  Add('    d:=2;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_IfThenElseStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('begin');
+  Add('  if a=0 then b:=1 else c:=2;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_WhileDoStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('begin');
+  Add('  while a>0 do b:=1;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_RepeatUntilStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('begin');
+  Add('  repeat a:=1; until b>1;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_TryFinallyStatement;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('begin');
+  Add('  try');
+  Add('    a:=1;');
+  Add('  finally');
+  Add('    b:=2;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_TypeAlias;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('var');
+  Add('  {#a_used}a: integer;');
+  Add('  {#b_used}b: integer;');
+  Add('  {#c_notused}c: integer;');
+  Add('begin');
+  Add('  a:=b;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Unary;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: longint;');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  a:=+b;');
+  Add('  a:=c+d;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Const;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: boolean;');
+  Add('  {#c_used}c: array of longint;');
+  Add('  {#d_used}d: string;');
+  Add('begin');
+  Add('  a:=+1;');
+  Add('  b:=true;');
+  Add('  c:=nil;');
+  Add('  d:=''foo'';');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Record;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {#trec_used}TRec = record');
+  Add('    {#a_used}a: integer;');
+  Add('    {#b_notused}b: integer;');
+  Add('    {#c_used}c: integer;');
+  Add('  end;');
+  Add('var');
+  Add('  {#r_used}r: TRec;');
+  Add('begin');
+  Add('  r.a:=3;');
+  Add('  with r do c:=4;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Array;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {#tarrayint_used}TArrayInt = array of integer;');
+  Add('var');
+  Add('  {#a_used}a: TArrayInt;');
+  Add('  {#b_used}b: integer;');
+  Add('  {#c_used}c: TArrayInt;');
+  Add('  {#d_used}d: integer;');
+  Add('  {#e_used}e: TArrayInt;');
+  Add('  {#f_used}f: integer;');
+  Add('  {#g_used}g: TArrayInt;');
+  Add('  {#h_used}h: TArrayInt;');
+  Add('  {#i_used}i: TArrayInt;');
+  Add('begin');
+  Add('  a[b]:=c[d];');
+  Add('  SetLength(e,f)');
+  Add('  if low(g)=high(h)+length(i) then');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_NestedFuncResult;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {#tarrayint_used}TArrayInt = array of integer;');
+  Add('  function {#nestedfunc_used}NestedFunc({#b_notused}b: longint): TArrayInt;');
+  Add('  begin');
+  Add('  end;');
+  Add('var');
+  Add('  {#d_used}d: longint;');
+  Add('begin');
+  Add('  NestedFunc(d);');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Enums;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt(const o);');
+  Add('type');
+  Add('  {#TEnum_used}TEnum = (red,blue);');
+  Add('  {#TEnums_used}TEnums = set of TEnum;');
+  Add('var');
+  Add('  {#a_used}a: TEnum;');
+  Add('  {#b_used}b: TEnums;');
+  Add('  {#c_used}c: TEnum;');
+  Add('  {#d_used}d: TEnums;');
+  Add('  {#e_used}e: TEnums;');
+  Add('  {#f_used}f: TEnums;');
+  Add('  {#g_used}g: TEnum;');
+  Add('  {#h_used}h: TEnum;');
+  Add('begin');
+  Add('  b:=[a];');
+  Add('  if c in d then;');
+  Add('  if low(e)=high(f) then;');
+  Add('  if pred(g)=succ(h) then;');
+  Add('end;');
+  Add('var {#s_used}s: string;');
+  Add('begin');
+  Add('  DoIt(s);');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_ProcedureType;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('type');
+  Add('  {#TProc_used}TProc = procedure;');
+  Add('  {#TFunc_used}TFunc = function(): longint;');
+  Add('var');
+  Add('  {#p_used}p: TProc;');
+  Add('  {#f_used}f: TFunc;');
+  Add('begin');
+  Add('  p:=nil;');
+  Add('  f:=nil;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Params;
+begin
+  StartProgram(false);
+  Add('procedure {#DoIt_used}DoIt(const o);');
+  Add('type');
+  Add('  {#TEnum_used}TEnum = (red,blue);');
+  Add('var');
+  Add('  {#a_used}a: longint;');
+  Add('  {#b_used}b: string;');
+  Add('  {#c_used}c: longint;');
+  Add('  {#d_used}d: TEnum;');
+  Add('begin');
+  Add('  DoIt(a);');
+  Add('  DoIt(b[c]);');
+  Add('  DoIt([d]);');
+  Add('  DoIt(red);');
+  Add('end;');
+  Add('var {#s_used}s: string;');
+  Add('begin');
+  Add('  DoIt(s);');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {tobject_used}TObject = class');
+  Add('    {#a_used}a: integer;');
+  Add('  end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Obj.a:=3;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_ClassForward;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_notused}integer = longint;');
+  Add('  {#TObject_used}TObject = class end;');
+  Add('  TFelidae = class;');
+  Add('  {#TCheetah_used}TCheetah = class');
+  Add('  public');
+  Add('    {#i_notused}i: integer;');
+  Add('    {#f_used}f: TFelidae;');
+  Add('  end;');
+  Add('  {TFelidae_used}TFelidae = class');
+  Add('  end;');
+  Add('var {#c_used}c: TCheetah;');
+  Add('begin');
+  Add('  c.f:=nil;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {tobject_used}TObject = class');
+  Add('    {#fa_used}Fa: integer;');
+  Add('    {#fb_used}Fb: integer;');
+  Add('    {#fc_used}Fc: integer;');
+  Add('    {#fd_used}Fd: integer;');
+  Add('    {#fe_notused}Fe: integer;');
+  Add('    function {#getfc_used}GetFC: integer;');
+  Add('    procedure {#setfd_used}SetFD({#setfd_value_used}Value: integer);');
+  Add('    property {#A_used}A: integer read Fa write Fb;');
+  Add('    property {#C_used}C: integer read GetFC write SetFD;');
+  Add('  end;');
+  Add('function TObject.GetFC: integer;');
+  Add('begin');
+  Add('  Result:=Fc;');
+  Add('end;');
+  Add('procedure TObject.SetFD({#setfd_value_impl_notused}Value: integer);');
+  Add('begin');
+  Add('  Fd:=Value;');
+  Add('end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Obj.A:=Obj.A;');
+  Add('  Obj.C:=Obj.C;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_PropertyOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#integer_used}integer = longint;');
+  Add('  {tobject_used}TObject = class');
+  Add('    {#fa_used}FA: integer;');
+  Add('    {#fb_notused}FB: integer;');
+  Add('    property {#obj_a_notused}A: integer read FA write FB;');
+  Add('  end;');
+  Add('  {tmobile_used}TMobile = class(TObject)');
+  Add('    {#fc_used}FC: integer;');
+  Add('    property {#mob_a_used}A write FC;');
+  Add('  end;');
+  Add('var {#m_used}M: TMobile;');
+  Add('begin');
+  Add('  M.A:=M.A;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_MethodOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {tobject_used}TObject = class');
+  Add('    procedure {#obj_doa_used}DoA; virtual; abstract;');
+  Add('    procedure {#obj_dob_notused}DoB; virtual; abstract;');
+  Add('  end;');
+  Add('  {tmobile_used}TMobile = class(TObject)');
+  Add('    constructor {#mob_create_used}Create;');
+  Add('    procedure {#mob_doa_used}DoA; override;');
+  Add('    procedure {#mob_dob_used}DoB; override;');
+  Add('  end;');
+  Add('constructor TMobile.Create; begin end;');
+  Add('procedure TMobile.DoA; begin end;');
+  Add('procedure TMobile.DoB; begin end;');
+  Add('var {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=TMobile.Create;'); // use TMobile before o.DoA
+  Add('  o.DoA;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Class_MethodOverride2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {tobject_used}TObject = class');
+  Add('    procedure {#obj_doa_used}DoA; virtual; abstract;');
+  Add('  end;');
+  Add('  {tmobile_used}TMobile = class(TObject)');
+  Add('    constructor {#mob_create_used}Create;');
+  Add('    procedure {#mob_doa_used}DoA; override;');
+  Add('  end;');
+  Add('constructor TMobile.Create; begin end;');
+  Add('procedure TMobile.DoA; begin end;');
+  Add('var {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o.DoA;');
+  Add('  o:=TMobile.Create;'); // use TMobile after o.DoA
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_TryExceptStatement;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {tobject_used}TObject = class');
+  Add('    constructor Create; external name ''create'';');
+  Add('  end;');
+  Add('  {texception_used}Exception = class(TObject);');
+  Add('  {tdivbyzero_used}EDivByZero = class(Exception);');
+  Add('procedure {#DoIt_used}DoIt;');
+  Add('var');
+  Add('  {#a_used}a: Exception;');
+  Add('  {#b_used}b: Exception;');
+  Add('  {#c_used}c: Exception;');
+  Add('  {#d_used}d: Exception;');
+  Add('  {#f_used}f: Exception;');
+  Add('begin');
+  Add('  try');
+  Add('    a:=nil;');
+  Add('  except');
+  Add('    raise b;');
+  Add('  end;');
+  Add('  try');
+  Add('    if Assigned(c) then ;');
+  Add('  except');
+  Add('    on {#e1_used}E1: Exception do raise;');
+  Add('    on {#e2_notused}E2: EDivByZero do raise d;');
+  Add('    else f:=nil;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var State: longint; external name ''state'';',
+    'procedure DoIt; external name ''doing'';',
+    '']),
+    LinesToStr([
+    ]));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  State:=3;');
+  Add('  DoIt;');
+  AnalyzeProgram;
+
+  // unit hints: no hint, even though no code is actually used
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(i: longint);');
+  Add('begin end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure DoIt(i: longint); virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  Add('  TObject.DoIt(3);');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TSortCompare = function(a,b: Pointer): integer;');
+  Add('  TObjCompare = function(a,b: TObject): integer;');
+  Add('procedure Sort(const Compare: TSortCompare);');
+  Add('begin');
+  Add('  Compare(nil,nil);');
+  Add('end;');
+  Add('procedure DoIt(const Compare: TObjCompare);');
+  Add('begin');
+  Add('  Sort(TSortCompare(Compare));');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt(nil);');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt;');
+  Add('const');
+  Add('  a = 13;');
+  Add('  b: longint = 14;');
+  Add('var');
+  Add('  c: char;');
+  Add('  d: longint = 15;');
+  Add('begin end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var i: longint;',
+  'begin',
+  '  for i:=1 to 2 do ;',
+  'end;',
+  'begin',
+  '  DoIt;',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
+begin
+  StartUnit(true);
+  Add('interface');
+  Add('const {#a_used}a = 1;');
+  Add('const {#b_used}b: longint = 2;');
+  Add('var {#c_used}c: longint = 3;');
+  Add('type');
+  Add('  {#TColor_used}TColor = longint;');
+  Add('  {#TFlag_used}TFlag = (red,green);');
+  Add('  {#TFlags_used}TFlags = set of TFlag;');
+  Add('  {#TArrInt_used}TArrInt = array of integer;');
+  Add('implementation');
+  Add('const {#d_notused}d = 1;');
+  Add('const {#e_notused}e: longint = 2;');
+  Add('var {#f_notused}f: longint = 3;');
+  Add('type');
+  Add('  {#ImpTColor_notused}ImpTColor = longint;');
+  Add('  {#ImpTFlag_notused}ImpTFlag = (red,green);');
+  Add('  {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
+  Add('  {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
+  AnalyzeUnit;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(i: longint);');
+  Add('begin');
+  Add('  i:=3;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
+    'Value parameter "i" is assigned but never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt;');
+  Add('const');
+  Add('  a: longint = 14;');
+  Add('var');
+  Add('  b: char;');
+  Add('  c: longint = 15;');
+  Add('begin');
+  Add('  a:=16;');
+  Add('  b:=#65;');
+  Add('  c:=17;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "a" is assigned but never used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "b" is assigned but never used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "c" is assigned but never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt;');
+  Add('type');
+  Add('  TColor = longint;');
+  Add('  TFlag = (red,green);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TArrInt = array of integer;');
+  Add('  procedure Sub; begin end;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    a: longint;');
+  Add('  end;');
+  Add('var m: TMobile;');
+  Add('begin');
+  Add('  m:=nil;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
+    'Private field "TMobile.a" is never used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "m" is assigned but never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    a: longint;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('  a:=3;');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
+    'Private field "TMobile.a" is assigned but never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    procedure DoSome; external name ''foo'';');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,
+    'Private method "TMobile.DoSome" is never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('    destructor Destroy; override;');
+  Add('  end;');
+  Add('var DestroyCount: longint = 0;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('destructor TMobile.Destroy;');
+  Add('begin');
+  Add('  inc(DestroyCount);');
+  Add('  inherited;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=TMobile.Create;');
+  Add('  o.Destroy;');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    type t = longint;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAPrivateTypeXNeverUsed,
+    'Private type "TMobile.t" never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    const c = 3;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAPrivateConstXNeverUsed,
+    'Private const "TMobile.c" never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  private');
+  Add('    FA: longint;');
+  Add('    property A: longint read FA;');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  TMobile.Create;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAPrivatePropertyXNeverUsed,
+    'Private property "TMobile.A" never used');
+  CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
+    'Private field "TMobile.FA" is never used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  m: TMobile;');
+  Add('begin');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add('type');
+  Add('  TMobile = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TMobile.Create;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  m: TMobile;');
+  Add('begin');
+  Add('  if m=nil then ;');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(i: longint); assembler;');
+  Add('type');
+  Add('  {#tcolor_notused}TColor = longint;');
+  Add('  {#tflag_notused}TFlag = (red,green);');
+  Add('  {#tflags_notused}TFlags = set of TFlag;');
+  Add('  {#tarrint_notused}TArrInt = array of integer;');
+  Add('const');
+  Add('  {#a_notused}a = 13;');
+  Add('  {#b_notused}b: longint = 14;');
+  Add('var');
+  Add('  {#c_notused}c: char;');
+  Add('  {#d_notused}d: longint = 15;');
+  Add('  procedure {#sub_notused}Sub; begin end;');
+  Add('asm end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_AssemblerDelphiParameterIgnored;
+begin
+  StartProgram(true);
+  Add([
+  '{$mode Delphi}',
+  'procedure DoIt(i: longint);',
+  'type',
+  '  {#tcolor_notused}TColor = longint;',
+  '  {#tflag_notused}TFlag = (red,green);',
+  '  {#tflags_notused}TFlags = set of TFlag;',
+  '  {#tarrint_notused}TArrInt = array of integer;',
+  'const',
+  '  {#a_notused}a = 13;',
+  '  {#b_notused}b: longint = 14;',
+  'var',
+  '  {#c_notused}c: char;',
+  '  {#d_notused}d: longint = 15;',
+  '  procedure {#sub_notused}Sub; begin end;',
+  'asm end;',
+  'begin',
+  '  DoIt(1);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
+begin
+  StartProgram(true);
+  Add('function DoIt: longint;');
+  Add('begin end;');
+  Add('begin');
+  Add('  DoIt();');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+    sPAFunctionResultDoesNotSeemToBeSet);
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class function DoIt: longint; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  Add('  TObject.DoIt;');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TPoint = record X,Y:longint; end;');
+  Add('function Point(Left: longint): TPoint;');
+  Add('begin');
+  Add('  Result.X:=Left;');
+  Add('end;');
+  Add('begin');
+  Add('  Point(1);');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
+    'Local variable "X" is assigned but never used');
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
+begin
+  StartProgram(true);
+  Add('type');
+  Add('  TPoint = record X,Y:longint; end;');
+  Add('procedure Three(out x: longint);');
+  Add('begin');
+  Add('  x:=3;');
+  Add('end;');
+  Add('function Point(): TPoint;');
+  Add('begin');
+  Add('  Three(Result.X)');
+  Add('end;');
+  Add('begin');
+  Add('  Point();');
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
+begin
+  StartProgram(true);
+  Add('procedure DoIt(out x: longint);');
+  Add('begin');
+  Add('  x:=3;');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  DoIt(i);');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure AssertTrue(b: boolean);',
+  'begin',
+  '  if b then ;',
+  'end;',
+  'procedure AssertFalse(b: boolean);',
+  'begin',
+  '  AssertTrue(not b);',
+  'end;',
+  'begin',
+  '  AssertFalse(true);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestWP_LocalVar;
+begin
+  StartProgram(false);
+  Add('var {#a_notused}a: longint;');
+  Add('var {#b_used}b: longint;');
+  Add('var {#c_used}c: longint;');
+  Add('begin');
+  Add('  b:=2;');
+  Add('  afile.c:=3;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  i:=3;');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit2.pp',true);
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitNotUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit2.pp',false);
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitInitialization;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    '']),
+    LinesToStr([
+    'initialization',
+    'i:=2;']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('begin');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit1.pp',true);
+  CheckUnitUsed('unit2.pp',true);
+end;
+
+procedure TTestUseAnalyzer.TestWP_UnitFinalization;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    '']),
+    LinesToStr([
+    'finalization',
+    'i:=2;']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add('uses unit1;');
+  Add('begin');
+  AnalyzeWholeProgram;
+
+  CheckUnitUsed('unit1.pp',true);
+  CheckUnitUsed('unit2.pp',true);
+end;
+
+procedure TTestUseAnalyzer.TestWP_CallInherited;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#TObject_used}TObject = class');
+  Add('    procedure {#TObjectDoA_used}DoA;');
+  Add('    procedure {#TObjectDoB_used}DoB;');
+  Add('  end;');
+  Add('  {#TMobile_used}TMobile = class');
+  Add('    procedure {#TMobileDoA_used}DoA;');
+  Add('    procedure {#TMobileDoC_used}DoC;');
+  Add('  end;');
+  Add('procedure TObject.DoA; begin end;');
+  Add('procedure TObject.DoB; begin end;');
+  Add('procedure TMobile.DoA;');
+  Add('begin');
+  Add('  inherited;');
+  Add('end;');
+  Add('procedure TMobile.DoC;');
+  Add('begin');
+  Add('  inherited DoB;');
+  Add('end;');
+  Add('var o: TMobile;');
+  Add('begin');
+  Add('  o.DoA;');
+  Add('  o.DoC;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ProgramPublicDeclarations;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  {#vPublic_used}vPublic: longint; public;');
+  Add('  {#vPrivate_notused}vPrivate: longint;');
+  Add('procedure {#DoPublic_used}DoPublic; public; begin end;');
+  Add('procedure {#DoPrivate_notused}DoPrivate; begin end;');
+  Add('begin');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ClassDefaultProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('    function {#getitems_notused}Getitems(Index: longint): string;');
+  Add('    procedure {#setitems_used}Setitems(Index: longint; Value: String);');
+  Add('    property {#items_used}Items[Index: longint]: string read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('function TObject.Getitems(Index: longint): string; begin end;');
+  Add('procedure TObject.Setitems(Index: longint; Value: String); begin end;');
+  Add('var');
+  Add('  {#l_used}L: TObject;');
+  Add('begin');
+  Add('  L[0]:=''birdy'';');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_Published;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('  private');
+  Add('    {#fcol_used}FCol: string;');
+  Add('    {#fbird_notused}FBird: string;');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: longint;');
+  Add('    procedure {#doit_used}ProcA; virtual; abstract;');
+  Add('    property {#col_used}Col: string read FCol;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedSetType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tflag_used}TFlag = (red, green);');
+  Add('  {#tflags_used}TFlags = set of TFlag;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TFlag;');
+  Add('    {#fieldb_used}FieldB: TFlags;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedArrayType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tdynarr_used}TDynArr = array of longint;');
+  Add('  {#tstatarr_used}TStatArr = array[boolean] of longint;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TDynArr;');
+  Add('    {#fieldb_used}FieldB: TStatArr;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedClassOfType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobjectclass_used}TObjectClass = class of TObject;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TObjectClass;');
+  Add('  end;');
+  Add('  {#tclass_used}TClass = class of TObject;');
+  Add('var');
+  Add('  {#c_used}c: TClass;');
+  Add('begin');
+  Add('  c:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedRecordType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#trec_used}TRec = record');
+  Add('    {treci_used}i: longint;');
+  Add('  end;');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TRec;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedProcType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#ta_used}ta = array of longint;');
+  Add('  {#tb_used}tb = array of longint;');
+  Add('  {#tproca_used}TProcA = procedure;');
+  Add('  {#tfunca_used}TFuncA = function: ta;');
+  Add('  {#tprocb_used}TProcB = procedure(a: tb);');
+  Add('  {#tobject_used}TObject = class');
+  Add('  published');
+  Add('    {#fielda_used}FieldA: TProcA;');
+  Add('    {#fieldb_used}FieldB: TFuncA;');
+  Add('    {#fieldc_used}FieldC: TProcB;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_PublishedProperty;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  {#defcol_used}DefCol = 3;');
+  Add('  {#defsize_notused}DefSize = 43;');
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('  private');
+  Add('    {#fcol_used}FCol: longint;');
+  Add('    {#fsize_used}FSize: longint;');
+  Add('    {#fbird_notused}FBird: string;');
+  Add('    {#fcolstored_used}FColStored: boolean;');
+  Add('    {#fsizestored_notused}FSizeStored: boolean;');
+  Add('  public');
+  Add('    property {#size_used}Size: longint read FSize stored FSizeStored default DefSize;');
+  Add('  published');
+  Add('    property {#col_used}Col: longint read FCol stored FColStored default DefCol;');
+  Add('  end;');
+  Add('var');
+  Add('  {#o_used}o: TObject;');
+  Add('begin');
+  Add('  if o.Size=13 then ;');
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_BuiltInFunctions;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#tordenum_used}TOrdEnum = (ordenum1,ordenum2);',
+  'begin',
+  '  if ord(ordenum1)=1 then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_TypeInfo;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#integer_used}integer = longint;',
+  '  {#trec_used}TRec = record',
+  '    {#trecv_used}v: integer;',
+  '  end;',
+  '  {#tclass_used}TClass = class of TObject;',
+  '  {#tobject_used}TObject = class',
+  '    class function {#tobject_classtype_used}ClassType: TClass; virtual; abstract;',
+  '  end;',
+  '  {#tbirds_used}TBirds = class of TBird;',
+  '  {#tbird_used}TBird = class',
+  '  end;',
+  'function {#getbirdclass_used}GetBirdClass: TBirds;',
+  'begin',
+  '  Result:=nil;',
+  'end;',
+  'var',
+  '  {#i_used}i: integer;',
+  '  {#s_used}s: string;',
+  '  {#p_used}p: pointer;',
+  '  {#r_used}r: TRec;',
+  '  {#o_used}o: TObject;',
+  '  {#c_used}c: TClass;',
+  'begin',
+  '  p:=typeinfo(integer);',
+  '  p:=typeinfo(longint);',
+  '  p:=typeinfo(i);',
+  '  p:=typeinfo(s);',
+  '  p:=typeinfo(p);',
+  '  p:=typeinfo(r.v);',
+  '  p:=typeinfo(TObject.ClassType);',
+  '  p:=typeinfo(o.ClassType);',
+  '  p:=typeinfo(o);',
+  '  p:=typeinfo(c);',
+  '  p:=typeinfo(c.ClassType);',
+  '  p:=typeinfo(GetBirdClass);',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+initialization
+  RegisterTests([TTestUseAnalyzer]);
+
+end.
+
diff --git a/packages/fcl-passrc/tests/tcvarparser.pas b/packages/fcl-passrc/tests/tcvarparser.pas
index 58bae61867..7a5eb6b249 100644
--- a/packages/fcl-passrc/tests/tcvarparser.pas
+++ b/packages/fcl-passrc/tests/tcvarparser.pas
@@ -26,12 +26,18 @@ Type
     Procedure TearDown; override;
   Published
     Procedure TestSimpleVar;
+    Procedure TestSimpleVarHelperName;
+    procedure TestSimpleVarHelperType;
     Procedure TestSimpleVarDeprecated;
     Procedure TestSimpleVarPlatform;
     Procedure TestSimpleVarInitialized;
     procedure TestSimpleVarInitializedDeprecated;
     procedure TestSimpleVarInitializedPlatform;
+    Procedure TestSimpleVarAbsolute;
+    Procedure TestSimpleVarAbsoluteDot;
+    Procedure TestSimpleVarAbsolute2Dots;
     Procedure TestVarProcedure;
+    Procedure TestVarFunctionINitialized;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarRecord;
     Procedure TestVarRecordDeprecated;
@@ -42,6 +48,7 @@ Type
     Procedure TestVarExternal;
     Procedure TestVarExternalLib;
     Procedure TestVarExternalLibName;
+    procedure TestVarExternalNoSemiColon;
     Procedure TestVarCVar;
     Procedure TestVarCVarExternal;
     Procedure TestVarPublic;
@@ -120,6 +127,28 @@ begin
   AssertVariableType('b');
 end;
 
+procedure TTestVarParser.TestSimpleVarHelperName;
+
+Var
+  R : TPasVariable;
+
+begin
+  Add('Var');
+  Add('  Helper : integer;');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One variable definition',1,Declarations.Variables.Count);
+  AssertEquals('First declaration is type definition.',TPasVariable,TObject(Declarations.Variables[0]).ClassType);
+  R:=TPasVariable(Declarations.Variables[0]);
+  AssertEquals('First declaration has correct name.','Helper',R.Name);
+end;
+
+procedure TTestVarParser.TestSimpleVarHelperType;
+begin
+  ParseVar('helper','');
+  AssertVariableType('helper');
+end;
+
 procedure TTestVarParser.TestSimpleVarDeprecated;
 begin
   ParseVar('b','deprecated');
@@ -156,12 +185,39 @@ begin
   AssertExpression('Variable value',TheVar.expr,pekNumber,'123');
 end;
 
+procedure TTestVarParser.TestSimpleVarAbsolute;
+begin
+  ParseVar('q absolute v','');
+  AssertVariableType('q');
+  AssertEquals('correct absolute location','v',TheVar.AbsoluteLocation);
+end;
+
+procedure TTestVarParser.TestSimpleVarAbsoluteDot;
+begin
+  ParseVar('q absolute v.w','');
+  AssertVariableType('q');
+  AssertEquals('correct absolute location','v.w',TheVar.AbsoluteLocation);
+end;
+
+procedure TTestVarParser.TestSimpleVarAbsolute2Dots;
+begin
+  ParseVar('q absolute v.w.x','');
+  AssertVariableType('q');
+  AssertEquals('correct absolute location','v.w.x',TheVar.AbsoluteLocation);
+end;
+
 procedure TTestVarParser.TestVarProcedure;
 begin
   ParseVar('procedure','');
   AssertVariableType(TPasProcedureType);
 end;
 
+procedure TTestVarParser.TestVarFunctionINitialized;
+begin
+  ParseVar('function (device: pointer): pointer; cdecl = nil','');
+  AssertVariableType(TPasFunctionType);
+end;
+
 procedure TTestVarParser.TestVarProcedureDeprecated;
 begin
   ParseVar('procedure','deprecated');
@@ -245,20 +301,26 @@ begin
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
 end;
 
+procedure TTestVarParser.TestVarExternalNoSemiColon;
+begin
+  ParseVar('integer external','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+end;
+
 procedure TTestVarParser.TestVarExternalLib;
 begin
   ParseVar('integer; external name ''mylib''','');
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
-  AssertEquals('Library name','',TheVar.LibraryName);
-  AssertEquals('Library name','''mylib''',TheVar.ExportName);
+  AssertNull('Library name',TheVar.LibraryName);
+  AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarExternalLibName;
 begin
-  ParseVar('integer; external ''mylib'' name ''d''','');
+  ParseVar('integer; external ''mylib'' name ''de''','');
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
-  AssertEquals('Library name','''mylib''',TheVar.LibraryName);
-  AssertEquals('Library name','''d''',TheVar.ExportName);
+  AssertNotNull('Library name',TheVar.LibraryName);
+  AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarCVar;
@@ -281,9 +343,9 @@ end;
 
 procedure TTestVarParser.TestVarPublicName;
 begin
-  ParseVar('integer; public name ''c''','');
+  ParseVar('integer; public name ''ce''','');
   AssertEquals('Variable modifiers',[vmpublic],TheVar.VarModifiers);
-  AssertEquals('Public export name','''c''',TheVar.ExportName);
+  AssertNotNull('Public export name',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarDeprecatedExternalName;
@@ -291,7 +353,8 @@ begin
   ParseVar('integer deprecated; external name ''me''','');
   CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hdeprecated')));
   AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
-  AssertEquals('Library name','''me''',TheVar.ExportName);
+  AssertNull('Library name',TheVar.LibraryName);
+  AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
 procedure TTestVarParser.TestVarHintPriorToInit;
diff --git a/packages/fcl-passrc/tests/testpassrc.lpi b/packages/fcl-passrc/tests/testpassrc.lpi
index 1d615d2902..c12aa54114 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpi
+++ b/packages/fcl-passrc/tests/testpassrc.lpi
@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
@@ -16,9 +16,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
@@ -30,7 +27,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestProcedureFunction.TestOperatorTokens"/>
+        <CommandLineParams Value="--suite=TTestExpressions.TestArrayAccess"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -38,7 +35,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="12">
+    <Units Count="15">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -87,6 +84,18 @@
         <Filename Value="tcpassrcutil.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit11>
+      <Unit12>
+        <Filename Value="tcresolver.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="tcgenerics.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="tcuseanalyzer.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit14>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -98,6 +107,20 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <OtherUnitFiles Value="../src"/>
     </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-passrc/tests/testpassrc.lpr b/packages/fcl-passrc/tests/testpassrc.lpr
index 0590042139..ad8ebc9031 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpr
+++ b/packages/fcl-passrc/tests/testpassrc.lpr
@@ -5,7 +5,8 @@ program testpassrc;
 uses
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc, tcpassrcutil;
+  tcexprparser, tcprocfunc, tcpassrcutil, tcresolver, tcgenerics,
+  tcuseanalyzer, pasresolveeval;
 
 type
 
diff --git a/packages/fcl-pdf/examples/testfppdf.lpr b/packages/fcl-pdf/examples/testfppdf.lpr
index 3e97d2221c..652ea16d13 100644
--- a/packages/fcl-pdf/examples/testfppdf.lpr
+++ b/packages/fcl-pdf/examples/testfppdf.lpr
@@ -1,5 +1,5 @@
 { This program generates a multi-page PDF document and tests various
-  functionality on each of the 5 pages.
+  functionality on each of the pages.
 
   You can also specify to generate single pages by using the -p <n>
   command line parameter.
@@ -22,17 +22,20 @@ uses
   fpreadjpeg,
   fppdf,
   fpparsettf,
+  fpttf,
   typinfo;
 
 type
 
   TPDFTestApp = class(TCustomApplication)
   private
-    Fpg: integer;
+    FPage: integer;
     FRawJPEG,
     FImageCompression,
     FTextCompression,
     FFontCompression: boolean;
+    FNoFontEmbedding: boolean;
+    FSubsetFontEmbedding: boolean;
     FDoc: TPDFDocument;
     function    SetUpDocument: TPDFDocument;
     procedure   SaveDocument(D: TPDFDocument);
@@ -42,8 +45,10 @@ type
     procedure   SimpleLines(D: TPDFDocument; APage: integer);
     procedure   SimpleImage(D: TPDFDocument; APage: integer);
     procedure   SimpleShapes(D: TPDFDocument; APage: integer);
+    procedure   AdvancedShapes(D: TPDFDocument; APage: integer);
     procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
     procedure   SampleLandscape(D: TPDFDocument; APage: integer);
+    procedure   TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer; const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
   protected
     procedure   DoRun; override;
   public
@@ -54,6 +59,8 @@ type
 var
   Application: TPDFTestApp;
 
+const
+  cPageCount: integer = 8;
 
 function TPDFTestApp.SetUpDocument: TPDFDocument;
 var
@@ -66,11 +73,18 @@ begin
   Result := TPDFDocument.Create(Nil);
   Result.Infos.Title := Application.Title;
   Result.Infos.Author := 'Graeme Geldenhuys';
-  Result.Infos.Producer := 'fpGUI Toolkit 0.8';
+  Result.Infos.Producer := 'fpGUI Toolkit 1.4.1';
   Result.Infos.ApplicationName := ApplicationName;
   Result.Infos.CreationDate := Now;
 
-  lOpts := [];
+  lOpts := [poPageOriginAtTop];
+  if FSubsetFontEmbedding then
+    Include(lOpts, poSubsetFont);
+  if FNoFontEmbedding then
+  begin
+    Include(lOpts, poNoEmbeddedFonts);
+    Exclude(lOpts, poSubsetFont);
+  end;
   if FFontCompression then
     Include(lOpts, poCompressFonts);
   if FTextCompression then
@@ -83,8 +97,8 @@ begin
 
   Result.StartDocument;
   S := Result.Sections.AddSection; // we always need at least one section
-  lPageCount := 7;
-  if Fpg <> -1 then
+  lPageCount := cPageCount;
+  if FPage <> -1 then
     lPageCount := 1;
   for i := 1 to lPageCount do
   begin
@@ -124,35 +138,53 @@ end;
 procedure TPDFTestApp.SimpleText(D: TPDFDocument; APage: integer);
 var
   P : TPDFPage;
-  FtTitle, FtText1, FtText2, FtText3: integer;
+  FtTitle, FtText1, FtText2: integer;
+  FtWaterMark: integer;
 begin
   P := D.Pages[APage];
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clRed);
-  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans', clGreen); // TODO: this color value means nothing - not used at all
-  FtText2 := D.AddFont('Times-BoldItalic', clBlack);
-  // FtText3 := D.AddFont('arial.ttf', 'Arial', clBlack);
-  FtText3 := FtText1; // to reduce font dependecies, but above works too if you have arial.ttf available
+  FtTitle := D.AddFont('Helvetica');
+  FtText1 := D.AddFont('FreeSans.ttf', 'FreeSans');
+  FtText2 := D.AddFont('Times-BoldItalic');
+  FtWaterMark := D.AddFont('Helvetica-Bold');
 
   { Page title }
   P.SetFont(FtTitle, 23);
   P.SetColor(clBlack, false);
   P.WriteText(25, 20, 'Sample Text');
 
+  P.SetFont(FtWaterMark, 120);
+  P.SetColor(clWaterMark, false);
+  P.WriteText(55, 190, 'Sample', 45);
+
   // -----------------------------------
   // Write text using PDF standard fonts
   P.SetFont(FtTitle, 12);
   P.SetColor(clBlue, false);
   P.WriteText(25, 50, '(25mm,50mm) Helvetica: The quick brown fox jumps over the lazy dog.');
+  P.SetColor(clBlack, false);
+  P.WriteText(25, 57, 'Click the URL:  http://www.freepascal.org');
+  P.AddExternalLink(54, 58, 49, 5, 'http://www.freepascal.org', false);
+
+  // strike-through text
+  P.WriteText(25, 64, 'Strike-Through text', 0, false, true);
+
+  // strike-through text
+  P.WriteText(65, 64, 'Underlined text', 0, true);
+
+  // rotated text
+  P.SetColor(clBlue, false);
+  P.WriteText(25, 100, 'Rotated text at 30 degrees', 30);
 
   P.SetFont(ftText2,16);
-  P.SetColor($c00000, false);
-  P.WriteText(60, 100, '(60mm,100mm) Times-BoldItalic: Big text at absolute position');
+  P.SetColor($C00000, false);
+  P.WriteText(50, 100, '(50mm,100mm) Times-BoldItalic: Big text at absolute position');
+
 
   // -----------------------------------
   // TrueType testing purposes
-  P.SetFont(ftText3, 13);
+  P.SetFont(FtText1, 13);
   P.SetColor(clBlack, false);
 
   P.WriteText(15, 120, 'Languages: English: Hello, World!');
@@ -162,7 +194,6 @@ begin
   P.WriteText(40, 160, 'Russian: Здравствуйте мир');
   P.WriteText(40, 170, 'Vietnamese: Xin chào thế giới');
 
-  P.SetFont(ftText1, 13);
   P.WriteText(15, 185, 'Box Drawing: ╠ ╣ ╦ ╩ ├ ┤ ┬ ┴');
 
   P.WriteText(15, 200, 'Typography: “What’s wrong?”');
@@ -171,6 +202,13 @@ begin
   P.WriteText(40, 230, 'OK then…    (êçèûÎÐð£¢ß)  \\//{}()#<>');
 
   P.WriteText(25, 280, 'B субботу двадцать третьего мая приезжает твоя любимая теща.');
+
+  { draw a rectangle around the text }
+  TextInABox(P, 25, 255, 23, clRed, 'FreeSans', '“Text in a Box gyj?”');
+
+  { lets make a hyperlink more prominent }
+  TextInABox(P, 100, 255, 12, clMagenta, 'FreeSans', 'http://www.freepascal.org');
+  P.AddExternalLink(99, 255, 49, 5, 'http://www.freepascal.org', false);
 end;
 
 procedure TPDFTestApp.SimpleLinesRaw(D: TPDFDocument; APage: integer);
@@ -181,7 +219,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -189,30 +227,30 @@ begin
   P.WriteText(25, 20, 'Sample Line Drawing (DrawLine)');
 
   P.SetColor(clBlack, True);
-  P.SetPenStyle(ppsSolid);
+  P.SetPenStyle(ppsSolid, 1);
   lPt1.X := 30;   lPt1.Y := 100;
   lPt2.X := 150;  lPt2.Y := 150;
-  P.DrawLine(lPt1, lPt2, 0.2);
+  P.DrawLine(lPt1, lPt2, 1);
 
   P.SetColor(clBlue, True);
-  P.SetPenStyle(ppsDash);
+  P.SetPenStyle(ppsDash, 1);
   lPt1.X := 50;   lPt1.Y := 70;
   lPt2.X := 180;  lPt2.Y := 100;
-  P.DrawLine(lPt1, lPt2, 0.1);
+  P.DrawLine(lPt1, lPt2, 1);
 
   { we can also use coordinates directly, without TPDFCoord variables }
 
   P.SetColor(clRed, True);
-  P.SetPenStyle(ppsDashDot);
+  P.SetPenStyle(ppsDashDot, 1);
   P.DrawLine(40, 140, 160, 80, 1);
 
   P.SetColor(clBlack, True);
-  P.SetPenStyle(ppsDashDotDot);
-  P.DrawLine(60, 50, 60, 120, 1.5);
+  P.SetPenStyle(ppsDashDotDot, 1);
+  P.DrawLine(60, 50, 60, 120, 1);
 
   P.SetColor(clBlack, True);
-  P.SetPenStyle(ppsDot);
-  P.DrawLine(10, 80, 130, 130, 0.5);
+  P.SetPenStyle(ppsDot, 1);
+  P.DrawLine(10, 80, 130, 130, 1);
 end;
 
 procedure TPDFTestApp.SimpleLines(D: TPDFDocument; APage: integer);
@@ -224,7 +262,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clRed);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -232,11 +270,11 @@ begin
   P.WriteText(25, 20, 'Sample Line Drawing (DrawLineStyle)');
 
   // write the text at position 100 mm from left and 120 mm from top
-  TsThinBlack := D.AddLineStyleDef(0.2, clBlack, ppsSolid);
-  TsThinBlue := D.AddLineStyleDef(0.1, clBlue, ppsDash);
+  TsThinBlack := D.AddLineStyleDef(1, clBlack, ppsSolid);
+  TsThinBlue := D.AddLineStyleDef(1, clBlue, ppsDash);
   TsThinRed := D.AddLineStyleDef(1, clRed, ppsDashDot);
-  TsThick := D.AddLineStyleDef(1.5, clBlack, ppsDashDotDot);
-  TsThinBlackDot := D.AddLineStyleDef(0.5, clBlack, ppsDot);
+  TsThick := D.AddLineStyleDef(1, clBlack, ppsDashDotDot);
+  TsThinBlackDot := D.AddLineStyleDef(1, clBlack, ppsDot);
 
   lPt1.X := 30;   lPt1.Y := 100;
   lPt2.X := 150;  lPt2.Y := 150;
@@ -262,7 +300,7 @@ Var
 begin
   P := D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -279,13 +317,17 @@ begin
   P.DrawImageRawSize(25, 130, W, H, IDX);  // left-bottom coordinate of image
   P.WriteText(145, 90, '[Full size (defined in pixels)]');
 
-  { half size image }
+  { quarter size image }
   P.DrawImageRawSize(25, 190, W shr 1, H shr 1, IDX); // could also have used: Integer(W div 2), Integer(H div 2)
-  P.WriteText(90, 165, '[Quarter size (defined in pixels)]');
+  P.WriteText(85, 180, '[Quarter size (defined in pixels)]');
+  { rotated image }
+  P.DrawImageRawSize(150, 190, W shr 1, H shr 1, IDX, 30);
 
   { scalled image to 2x2 centimeters }
   P.DrawImage(25, 230, 20.0, 20.0, IDX); // left-bottom coordinate of image
   P.WriteText(50, 220, '[2x2 cm scaled image]');
+  { rotatedd image }
+  P.DrawImage(120, 230, 20.0, 20.0, IDX, 30);
 end;
 
 procedure TPDFTestApp.SimpleShapes(D: TPDFDocument; APage: integer);
@@ -293,10 +335,13 @@ var
   P: TPDFPage;
   FtTitle: integer;
   lPt1: TPDFCoord;
+  lPoints: array of TPDFCoord;
+  i: integer;
+  lLineWidth: TPDFFloat;
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -305,30 +350,64 @@ begin
 
   // ========== Rectangles ============
 
-  { PDF origin coordinate is Bottom-Left, and we want to use Image Coordinate of Top-Left }
+  { PDF origin coordinate is Bottom-Left. }
   lPt1.X := 30;
-  lPt1.Y := 60+20; // origin + height
-  P.SetColor(clRed, true);
-  P.SetColor($37b344, false); // some green color
+  lPt1.Y := 75;
+  P.SetColor($c00000, true);
+  P.SetColor(clLtGray, false);
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 3, true, true);
 
   lPt1.X := 20;
-  lPt1.Y := 50+20; // origin + height
+  lPt1.Y := 65;
   P.SetColor(clBlue, true);
-  P.SetColor($b737b3, false); // some purple color
+  P.SetColor($ffff80, false); // pastel yellow
   P.DrawRect(lPt1.X, lPt1.Y, 40, 20, 1, true, true);
 
   P.SetPenStyle(ppsDashDot);
   P.SetColor(clBlue, true);
-  P.DrawRect(110, 70+20 {origin+height}, 40, 20, 1, false, true);
+  P.DrawRect(110, 75, 40, 20, 1, false, true);
+
+  P.SetPenStyle(ppsDash);
+  P.SetColor($37b344, true);  // some green color
+  P.DrawRect(100, 70, 40, 20, 2, false, true);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor($c00000, true);
+  P.DrawRect(90, 65, 40, 20, 4, false, true);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(170, 75, 30, 15, 1, false, true, 30);
+
+
+  // ========== Rounded Rectangle ===========
+  lPt1.X := 30;
+  lPt1.Y := 120;
+  P.SetColor($c00000, true);
+  P.SetColor(clLtGray, false);
+  P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 5, 2, true, true);
+
+  lPt1.X := 20;
+  lPt1.Y := 110;
+  P.SetColor(clBlue, true);
+  P.SetColor($ffff80, false); // pastel yellow
+  P.DrawRoundedRect(lPt1.X, lPt1.Y, 40, 20, 2.4, 1, true, true);
+
+  P.SetPenStyle(ppsDashDot);
+  P.SetColor(clBlue, true);
+  P.DrawRoundedRect(110, 120, 40, 20, 1.5, 1, false, true);
 
   P.SetPenStyle(ppsDash);
   P.SetColor($37b344, true);  // some green color
-  P.DrawRect(100, 60+20 {origin+height}, 40, 20, 2, false, true);
+  P.DrawRoundedRect(100, 115, 40, 20, 3, 2, false, true);
 
   P.SetPenStyle(ppsSolid);
-  P.SetColor($b737b3, true);  // some purple color
-  P.DrawRect(90, 50+20 {origin+height}, 40, 20, 4, false, true);
+  P.SetColor($c00000, true);
+  P.DrawRoundedRect(90, 110, 40, 20, 5, 3, false, true);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRoundedRect(170, 120, 30, 15, 5, 1, false, true, 30);
 
 
   // ========== Ellipses ============
@@ -340,35 +419,40 @@ begin
   lPt1.X := 60;
   lPt1.Y := 150;
   P.SetColor(clBlue, true);
-  P.SetColor($b737b3, false); // some purple color
+  P.SetColor($ffff80, false); // pastel yellow
   P.DrawEllipse(lPt1, 10, 10, 1, True, True);
 
   P.SetPenStyle(ppsDashDot);
   P.SetColor($b737b3, True);
-  P.DrawEllipse(140, 150, 35, 20, 1, False, True);
+  P.DrawEllipse(73, 150, 10, 20, 1, False, True);
 
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, True);
+  P.DrawEllipse(170, 150, 30, 15, 1, False, True, 30);
 
   // ========== Lines Pen Styles ============
 
-  P.SetPenStyle(ppsSolid);
+  lLineWidth := 1;
+
+  P.SetPenStyle(ppsSolid, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 200, 70, 200, 1);
+  P.DrawLine(30, 170, 70, 170, lLineWidth);
 
-  P.SetPenStyle(ppsDash);
+  P.SetPenStyle(ppsDash, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 210, 70, 210, 1);
+  P.DrawLine(30, 175, 70, 175, lLineWidth);
 
-  P.SetPenStyle(ppsDot);
+  P.SetPenStyle(ppsDot, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 220, 70, 220, 1);
+  P.DrawLine(30, 180, 70, 180, lLineWidth);
 
-  P.SetPenStyle(ppsDashDot);
+  P.SetPenStyle(ppsDashDot, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 230, 70, 230, 1);
+  P.DrawLine(30, 185, 70, 185, lLineWidth);
 
-  P.SetPenStyle(ppsDashDotDot);
+  P.SetPenStyle(ppsDashDotDot, lLineWidth);
   P.SetColor(clBlack, True);
-  P.DrawLine(30, 240, 70, 240, 1);
+  P.DrawLine(30, 190, 70, 190, lLineWidth);
 
 
   // ========== Line Attribute ============
@@ -376,21 +460,178 @@ begin
   P.SetPenStyle(ppsSolid);
   P.SetColor(clBlack, True);
   P.DrawLine(100, 170, 140, 170, 0.2);
-  P.DrawLine(100, 180, 140, 180, 0.3);
-  P.DrawLine(100, 190, 140, 190, 0.5);
-  P.DrawLine(100, 200, 140, 200, 1);
+  P.DrawLine(100, 175, 140, 175, 0.3);
+  P.DrawLine(100, 180, 140, 180, 0.5);
+  P.DrawLine(100, 185, 140, 185, 1);
 
   P.SetColor(clRed, True);
-  P.DrawLine(100, 210, 140, 210, 2);
+  P.DrawLine(100, 190, 140, 190, 2);
 
   P.SetColor($37b344, True);
-  P.DrawLine(100, 220, 140, 220, 3);
+  P.DrawLine(100, 195, 140, 195, 3);
 
   P.SetColor(clBlue, True);
-  P.DrawLine(100, 230, 140, 230, 4);
+  P.DrawLine(100, 200, 140, 200, 4);
 
   P.SetColor($b737b3, True);
-  P.DrawLine(100, 240, 140, 240, 5);
+  P.DrawLine(100, 205, 140, 205, 5);
+
+
+  // ========== PolyLines and Polygons ============
+  P.Matrix.SetYTranslation(70);
+  P.Matrix.SetXTranslation(20);
+
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 10, 50, -50, 1, false, true);
+
+  P.SetColor($c00000, true);
+  P.ResetPath;
+  SetLength(lPoints, 10);
+  for i := 0 to 9 do
+  begin
+    lPoints[i].X := Random(50);
+    lPoints[i].Y := Random(50) + 10.5;
+  end;
+  P.DrawPolyLine(lPoints, 1);
+  P.StrokePath;
+
+
+  P.Matrix.SetXTranslation(80);
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 10, 50, -50, 1, false, true);
+
+  P.SetColor($ffff80, false); // pastel yellow
+  P.SetColor(clBlue, true);
+  P.ResetPath;
+  P.DrawPolygon(lPoints, 1);
+  P.FillStrokePath;
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle, 8);
+  P.SetColor(clBlack, false);
+  P.WriteText(0, 8, 'Fill using the nonzero winding number rule');
+
+
+  P.Matrix.SetXTranslation(140);
+  P.SetPenStyle(ppsSolid);
+  P.SetColor(clBlack, true);
+  P.DrawRect(0, 10, 50, -50, 1, false, true);
+
+  P.SetColor($ffff80, false); // pastel yellow
+  P.SetColor(clBlue, true);
+  P.ResetPath;
+  P.DrawPolygon(lPoints, 1);
+  P.FillEvenOddStrokePath;
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle, 8);
+  P.SetColor(clBlack, false);
+  P.WriteText(0, 8, 'Fill using the even-odd rule');
+end;
+
+{ Each curve uses the exact same four coordinates, just with different CubicCurveToXXX
+  method calls. I also use the page Maxtix Y-Translation to adjust the coordinate
+  system before I draw each curve. I could also refactor each curves drawing
+  code into a single parametised procedure - simply to show that each of the
+  curves really do use the same code and coordinates. }
+procedure TPDFTestApp.AdvancedShapes(D: TPDFDocument; APage: integer);
+var
+  P: TPDFPage;
+  FtTitle: integer;
+  lPt1, lPt2, lPt3, lPt4: TPDFCoord;
+begin
+  P:=D.Pages[APage];
+  // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
+  FtTitle := D.AddFont('Helvetica');
+
+  { Page title }
+  P.SetFont(FtTitle,23);
+  P.SetColor(clBlack);
+  P.WriteText(25, 20, 'Advanced Drawing');
+
+  // ========== Cubic Bezier curve ===========
+
+  // PDF c operator curve ===========
+  lPt1 := PDFCoord(75, 70);
+  lPt2 := PDFCoord(78, 40);
+  lPt3 := PDFCoord(100, 35);
+  lPt4 := PDFCoord(140, 60);
+
+  p.SetColor(clBlack, true);
+  p.SetPenStyle(ppsSolid);
+  p.MoveTo(lPt1);
+  p.CubicCurveTo(lPt2, lPt3, lPt4, 1);
+  // for fun, lets draw the control points as well
+  P.SetColor(clLtGray, True);
+  P.SetColor(clLtGray, false);
+  P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
+  P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
+  P.SetPenStyle(ppsDot);
+  P.DrawLine(lPt1, lPt2, 1);
+  P.DrawLine(lPt3, lPt4, 1);
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle, 8);
+  P.SetColor(clBlack, false);
+  P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
+  p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
+  p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
+  p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
+
+  P.SetFont(FtTitle, 10);
+  P.WriteText(20, 50, 'CubicCurveTo(...)');
+
+
+  // PDF v operator curve ===========
+  P.Matrix.SetYTranslation(220);
+
+  p.SetColor(clBlack, true);
+  p.SetPenStyle(ppsSolid);
+  p.MoveTo(lPt1);
+  p.CubicCurveToV(lPt3, lPt4, 1);
+  // for fun, lets draw the control points as well
+  P.SetColor(clLtGray, True);
+  P.SetColor(clLtGray, false);
+  P.DrawEllipse(lPt3.X-0.8, lPt3.Y, 1, 1, 1, True, True);
+  P.SetPenStyle(ppsDot);
+  P.DrawLine(lPt3, lPt4, 1);
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle,8);
+  P.SetColor(clBlack, false);
+  P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
+  p.WriteText(lPt3.X+1, lPt3.Y, '(x2, y2)');
+  p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
+
+  P.SetFont(FtTitle, 10);
+  P.WriteText(20, 50, 'CubicCurveToV(...)');
+
+
+  // PDF y operator curve ===========
+  P.Matrix.SetYTranslation(140);
+
+  p.SetColor(clBlack, true);
+  p.SetPenStyle(ppsSolid);
+  p.MoveTo(lPt1);
+  p.CubicCurveToY(lPt2, lPt4, 1);
+  // for fun, lets draw the control points as well
+  P.SetColor(clLtGray, True);
+  P.SetColor(clLtGray, false);
+  P.DrawEllipse(lPt2.X-0.5, lPt2.Y, 1, 1, 1, True, True);
+  P.SetPenStyle(ppsDot);
+  P.DrawLine(lPt1, lPt2, 1);
+
+  p.SetPenStyle(ppsSolid);
+  P.SetFont(FtTitle,8);
+  P.SetColor(clBlack, false);
+  P.WriteText(lPt1.X+1, lPt1.Y, '(current point)');
+  p.WriteText(lPt2.X+1, lPt2.Y, '(x1, y1)');
+  p.WriteText(lPt4.X+1, lPt4.Y, '(xTo, yTo)');
+
+  P.SetFont(FtTitle, 10);
+  P.WriteText(20, 50, 'CubicCurveToY(...)');
 end;
 
 procedure TPDFTestApp.SampleMatrixTransform(D: TPDFDocument; APage: integer);
@@ -412,7 +653,7 @@ var
 begin
   P:=D.Pages[APage];
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -448,7 +689,7 @@ begin
   P.Orientation := ppoLandscape;
 
   // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
-  FtTitle := D.AddFont('Helvetica', clBlack);
+  FtTitle := D.AddFont('Helvetica');
 
   { Page title }
   P.SetFont(FtTitle,23);
@@ -464,15 +705,59 @@ begin
   P.WriteText(145, 95, Format('%d x %d  (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
 end;
 
+procedure TPDFTestApp.TextInABox(const APage: TPDFPage; const AX, AY: TPDFFloat; const APointSize: integer;
+    const ABoxColor: TARGBColor; const AFontName: string; const AText: UTF8String);
+var
+  lFontIdx: integer;
+  lFC: TFPFontCacheItem;
+  lHeight: single;
+  lDescenderHeight: single;
+  lTextHeightInMM: single;
+  lWidth: single;
+  lTextWidthInMM: single;
+  lDescenderHeightInMM: single;
+  i: integer;
+begin
+  for i := 0 to APage.Document.Fonts.Count-1 do
+  begin
+    if APage.Document.Fonts[i].Name = AFontName then
+    begin
+      lFontIdx := i;
+      break;
+    end;
+  end;
+  APage.SetFont(lFontIdx, APointSize);
+  APage.SetColor(clBlack, false);
+  APage.WriteText(AX, AY, AText);
+
+  lFC := gTTFontCache.Find(AFontName, False, False);
+  if not Assigned(lFC) then
+    raise Exception.Create(AFontName + ' font not found');
+
+  lHeight := lFC.TextHeight(AText, APointSize, lDescenderHeight);
+  { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. }
+  lTextHeightInMM := (lHeight * 25.4) / gTTFontCache.DPI;
+  lDescenderHeightInMM := (lDescenderHeight * 25.4) / gTTFontCache.DPI;
+
+  lWidth := lFC.TextWidth(AText, APointSize);
+  { convert the Font Units to mm as our PDFPage.UnitOfMeasure is set to mm. }
+  lTextWidthInMM := (lWidth * 25.4) / gTTFontCache.DPI;
+
+  { adjust the Y coordinate for the font Descender, because
+    WriteText() draws on the baseline. Also adjust the TextHeight
+    because CapHeight doesn't take into account the Descender. }
+  APage.SetColor(ABoxColor, true);
+  APage.DrawRect(AX, AY+lDescenderHeightInMM, lTextWidthInMM,
+      lTextHeightInMM+lDescenderHeightInMM, 1, false, true);
+end;
+
 { TPDFTestApp }
 
 procedure TPDFTestApp.DoRun;
 
   Function BoolFlag(C : Char;ADefault : Boolean) : Boolean;
-
   Var
     V : Integer;
-
   begin
     Result:=ADefault;
     if HasOption(C, '') then
@@ -486,12 +771,11 @@ procedure TPDFTestApp.DoRun;
 
 var
   ErrorMsg: String;
-
 begin
   StopOnException:=True;
   inherited DoRun;
   // quick check parameters
-  ErrorMsg := CheckOptions('hp:f:t:i:j:', '');
+  ErrorMsg := CheckOptions('hp:f:t:i:j:ns', '');
   if ErrorMsg <> '' then
   begin
     WriteLn('ERROR:  ' + ErrorMsg);
@@ -508,48 +792,55 @@ begin
     Exit;
   end;
 
-  Fpg := -1;
+  FPage := -1;
   if HasOption('p', '') then
   begin
-    Fpg := StrToInt(GetOptionValue('p', ''));
-    if (Fpg < 1) or (Fpg > 7) then
+    FPage := StrToInt(GetOptionValue('p', ''));
+    if (FPage < 1) or (FPage > cPageCount) then
     begin
-      Writeln('Error in -p parameter. Valid range is 1-7.');
+      Writeln(Format('Error in -p parameter. Valid range is 1-%d.', [cPageCount]));
       Writeln('');
       Terminate;
       Exit;
     end;
   end;
 
+  FNoFontEmbedding := HasOption('n', '');
+  FSubsetFontEmbedding := HasOption('s', '');
   FFontCompression := BoolFlag('f',true);
   FTextCompression := BoolFlag('t',False);
   FImageCompression := BoolFlag('i',False);
   FRawJPEG:=BoolFlag('j',False);
 
+  gTTFontCache.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
+  gTTFontCache.BuildFontCache;
+
   FDoc := SetupDocument;
   try
     FDoc.FontDirectory := 'fonts';
 
-    if Fpg = -1 then
+    if FPage = -1 then
     begin
       SimpleText(FDoc, 0);
       SimpleShapes(FDoc, 1);
-      SimpleLines(FDoc, 2);
-      SimpleLinesRaw(FDoc, 3);
-      SimpleImage(FDoc, 4);
-      SampleMatrixTransform(FDoc, 5);
-      SampleLandscape(FDoc, 6);
+      AdvancedShapes(FDoc, 2);
+      SimpleLines(FDoc, 3);
+      SimpleLinesRaw(FDoc, 4);
+      SimpleImage(FDoc, 5);
+      SampleMatrixTransform(FDoc, 6);
+      SampleLandscape(FDoc, 7);
     end
     else
     begin
-      case Fpg of
+      case FPage of
         1:  SimpleText(FDoc, 0);
         2:  SimpleShapes(FDoc, 0);
-        3:  SimpleLines(FDoc, 0);
-        4:  SimpleLinesRaw(FDoc, 0);
-        5:  SimpleImage(FDoc, 0);
-        6:  SampleMatrixTransform(FDoc, 0);
-        7:  SampleLandscape(FDoc, 0);
+        3:  AdvancedShapes(FDoc, 0);
+        4:  SimpleLines(FDoc, 0);
+        5:  SimpleLinesRaw(FDoc, 0);
+        6:  SimpleImage(FDoc, 0);
+        7:  SampleMatrixTransform(FDoc, 0);
+        8:  SampleLandscape(FDoc, 0);
       end;
     end;
 
@@ -566,11 +857,15 @@ procedure TPDFTestApp.WriteHelp;
 begin
   writeln('Usage:');
   writeln('    -h          Show this help.');
-  writeln('    -p <n>      Generate only one page. Valid range is 1-7.' + LineEnding +
-          '                If this option is not specified, then all 7 pages are' + LineEnding +
-          '                generated.');
+  writeln(Format(
+          '    -p <n>      Generate only one page. Valid range is 1-%d.' + LineEnding +
+          '                If this option is not specified, then all %0:d pages are' + LineEnding +
+          '                generated.', [cPageCount]));
+  writeln('    -n          If specified, no fonts will be embedded.');
+  writeln('    -s          If specified, subset TTF font embedding will occur.');
   writeln('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
-          '                disables compression. A value of 1 enables compression.');
+          '                disables compression. A value of 1 enables compression.' + LineEnding +
+          '                If -n is specified, this option is ignored.');
   writeln('    -t <0|1>    Toggle text compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.');
   writeln('    -i <0|1>    Toggle image compression. A value of 0' + LineEnding +
@@ -581,8 +876,8 @@ begin
 end;
 
 
-
 begin
+  Randomize;
   Application := TPDFTestApp.Create(nil);
   Application.Title := 'fpPDF Test Application';
   Application.Run;
diff --git a/packages/fcl-pdf/fpmake.pp b/packages/fcl-pdf/fpmake.pp
index 081d73b292..be284f025e 100644
--- a/packages/fcl-pdf/fpmake.pp
+++ b/packages/fcl-pdf/fpmake.pp
@@ -12,6 +12,7 @@ begin
     begin
 {$endif ALLPACKAGES}
     P:=AddPackage('fcl-pdf');
+    P.ShortName:='fcpd';
 
 {$ifdef ALLPACKAGES}
     P.Directory:=ADirectory;
@@ -27,17 +28,26 @@ begin
     P.Dependencies.Add('rtl-objpas');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-image');
+    P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('paszlib');
     P.Version:='3.1.1';
     T:=P.Targets.AddUnit('src/fpttfencodings.pp');
     T:=P.Targets.AddUnit('src/fpparsettf.pp');
+    T:=P.Targets.AddUnit('src/fpfonttextmapping.pp');
     With T do
       Dependencies.AddUnit('fpttfencodings');
+    T:=P.Targets.AddUnit('src/fpttfsubsetter.pp');
+    With T do
+      begin
+      Dependencies.AddUnit('fpparsettf');
+      Dependencies.AddUnit('fpfonttextmapping');
+      end;
     T:=P.Targets.AddUnit('src/fpttf.pp');
     T:=P.Targets.AddUnit('src/fppdf.pp');
     With T do
       begin
       Dependencies.AddUnit('fpparsettf');
+      Dependencies.AddUnit('fpttfsubsetter');
       end;
     
     // md5.ref
diff --git a/packages/fcl-pdf/src/fontmetrics_stdpdf.inc b/packages/fcl-pdf/src/fontmetrics_stdpdf.inc
new file mode 100644
index 0000000000..03739a99f7
--- /dev/null
+++ b/packages/fcl-pdf/src/fontmetrics_stdpdf.inc
@@ -0,0 +1,222 @@
+const
+
+  // helvetica  (used metric equivalent Liberation Sans as substitute)
+  FONT_HELVETICA_ARIAL: array[0..255] of integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,569,727,1139,1139,1821,1366,391,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,569,569,1196,1196,1196,1139,2079,1366,
+    1366,1479,1479,1366,1251,1593,1479,569,1024,1366,1139,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,569,569,569,961,1139,682,1139,1139,
+    1024,1139,1139,569,1139,1139,455,455,1024,455,1706,1139,1139,1139,1139,682,1024,
+    569,1139,1024,1479,1024,1024,1024,684,532,684,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,1139,
+    532,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1100,682,
+    682,682,748,1139,1708,1708,1708,1251,1366,1366,1366,1366,1366,1366,2048,1479,1366,
+    1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,1479,
+    1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1024,1139,1139,
+    1139,1139,569,569,569,569,1139,1139,1139,1139,1139,1139,1139,1124,1251,1139,1139,
+    1139,1139,1024,1139,1024 );
+  FONT_HELVETICA_ARIAL_CAPHEIGHT = 1409;
+  FONT_HELVETICA_ARIAL_DESCENDER = 431;
+
+  // helveticaB  (used metric equivalent Liberation Sans Bold as substitute)
+  FONT_HELVETICA_ARIAL_BOLD: array[0..255] of integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,682,971,1139,1139,1821,1479,487,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,682,682,1196,1196,1196,1251,1997,1479,
+    1479,1479,1479,1366,1251,1593,1479,569,1139,1479,1251,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,682,569,682,1196,1139,682,1139,1251,
+    1139,1251,1139,682,1251,1251,569,569,1139,569,1821,1251,1251,1251,1251,797,1139,
+    682,1251,1139,1593,1139,1139,1024,797,573,797,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,1139,
+    573,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1139,682,
+    682,682,748,1139,1708,1708,1708,1251,1479,1479,1479,1479,1479,1479,2048,1479,1366,
+    1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,1479,
+    1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1139,1139,1139,
+    1139,1139,569,569,569,569,1251,1251,1251,1251,1251,1251,1251,1124,1251,1251,1251,
+    1251,1251,1139,1251,1139 );
+  FONT_HELVETICA_ARIAL_BOLD_CAPHEIGHT = 688;
+  FONT_HELVETICA_ARIAL_BOLD_DESCENDER = 210;
+
+  // helveticaI  (used metric equivalent Liberation Sans Italic as substitute)
+  FONT_HELVETICA_ARIAL_ITALIC: array[0..255] of Integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,569,727,1139,1139,1821,1366,391,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,569,569,1196,1196,1196,1139,2079,1366,
+    1366,1479,1479,1366,1251,1593,1479,569,1024,1366,1139,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,569,569,569,961,1139,682,1139,1139,
+    1024,1139,1139,569,1139,1139,455,455,1024,455,1706,1139,1139,1139,1139,682,1024,
+    569,1139,1024,1479,1024,1024,1024,684,532,684,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,
+    1139,532,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1100,
+    682,682,682,748,1139,1708,1708,1708,1251,1366,1366,1366,1366,1366,1366,2048,1479,
+    1366,1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,
+    1479,1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1024,1139,
+    1139,1139,1139,569,569,569,569,1139,1139,1139,1139,1139,1139,1139,1124,1251,1139,
+    1139,1139,1139,1024,1139,1024 );
+  FONT_HELVETICA_ARIAL_ITALIC_CAPHEIGHT = 688;
+  FONT_HELVETICA_ARIAL_ITALIC_DESCENDER = 208;
+
+  // helveticaBI  (used metric equivalent Liberation Sans Bold Italic as substitute)
+  FONT_HELVETICA_ARIAL_BOLD_ITALIC: array[0..255] of Integer = (
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    569,682,971,1139,1139,1821,1479,487,682,682,797,1196,569,682,569,569,1139,1139,
+    1139,1139,1139,1139,1139,1139,1139,1139,682,682,1196,1196,1196,1251,1997,1479,
+    1479,1479,1479,1366,1251,1593,1479,569,1139,1479,1251,1706,1479,1593,1366,1593,
+    1479,1366,1251,1479,1366,1933,1366,1366,1251,682,569,682,1196,1139,682,1139,1251,
+    1139,1251,1139,682,1251,1251,569,569,1139,569,1821,1251,1251,1251,1251,797,1139,
+    682,1251,1139,1593,1139,1139,1024,797,573,797,1196,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,
+    1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,569,682,1139,1139,1139,
+    1139,573,1139,682,1509,758,1139,1196,682,1509,1131,819,1124,682,682,682,1180,1139,
+    682,682,682,748,1139,1708,1708,1708,1251,1479,1479,1479,1479,1479,1479,2048,1479,
+    1366,1366,1366,1366,569,569,569,569,1479,1479,1593,1593,1593,1593,1593,1196,1593,
+    1479,1479,1479,1479,1366,1366,1251,1139,1139,1139,1139,1139,1139,1821,1139,1139,
+    1139,1139,1139,569,569,569,569,1251,1251,1251,1251,1251,1251,1251,1124,1251,1251,
+    1251,1251,1251,1139,1251,1139 );
+  FONT_HELVETICA_ARIAL_BOLD_ITALIC_CAPHEIGHT = 688;
+  FONT_HELVETICA_ARIAL_BOLD_ITALIC_DESCENDER = 210;
+
+  // times  (used metric equivalent Liberation Serif as substitute)
+  FONT_TIMES: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,682,836,1024,1024,1706,1593,369,682,682,1024,1155,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,569,569,1155,1155,1155,909,1886,1479,1366,
+    1366,1479,1251,1139,1479,1479,682,797,1479,1251,1821,1479,1479,1139,1479,1366,
+    1139,1251,1479,1479,1933,1479,1479,1251,682,569,682,961,1024,682,909,1024,909,
+    1024,909,682,1024,1024,569,569,1024,569,1593,1024,1024,1024,1024,682,797,569,
+    1024,1024,1479,1024,1024,909,983,410,983,1108,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,682,1024,1024,1024,1024,
+    410,1024,682,1556,565,1024,1155,682,1556,1024,819,1124,614,614,682,1180,928,682,
+    682,614,635,1024,1536,1536,1536,909,1479,1479,1479,1479,1479,1479,1821,1366,1251,
+    1251,1251,1251,682,682,682,682,1479,1479,1479,1479,1479,1479,1479,1155,1479,1479,
+    1479,1479,1479,1479,1139,1024,909,909,909,909,909,909,1366,909,909,909,909,909,
+    569,569,569,569,1024,1024,1024,1024,1024,1024,1024,1124,1024,1024,1024,1024,1024,
+    1024,1024,1024 );
+  FONT_TIMES_CAPHEIGHT = 1341;
+  FONT_TIMES_DESCENDER = 442;
+
+  // timesI  (used metric equivalent Liberation Serif Italic as substitute)
+  FONT_TIMES_ITALIC: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,682,860,1024,1024,1706,1593,438,682,682,1024,1382,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,682,682,1382,1382,1382,1024,1884,1251,
+    1251,1366,1479,1251,1251,1479,1479,682,909,1366,1139,1706,1366,1479,1251,1479,
+    1251,1024,1139,1479,1251,1706,1251,1139,1139,797,569,797,864,1024,682,1024,1024,
+    909,1024,909,569,1024,1024,569,569,909,569,1479,1024,1024,1024,1024,797,797,569,
+    1024,909,1366,909,909,797,819,563,819,1108,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,797,1024,1024,1024,1024,
+    563,1024,682,1556,565,1024,1382,682,1556,1024,819,1124,614,614,682,1180,1071,512,
+    682,614,635,1024,1536,1536,1536,1024,1251,1251,1251,1251,1251,1251,1821,1366,1251,
+    1251,1251,1251,682,682,682,682,1479,1366,1479,1479,1479,1479,1479,1382,1479,1479,
+    1479,1479,1479,1139,1251,1024,1024,1024,1024,1024,1024,1024,1366,909,909,909,909,
+    909,569,569,569,569,1024,1024,1024,1024,1024,1024,1024,1124,1024,1024,1024,1024,
+    1024,909,1024,909 );
+  FONT_TIMES_ITALIC_CAPHEIGHT = 655;
+  FONT_TIMES_ITALIC_DESCENDER = 216;
+
+  //timesB  (used metric equivalent Liberation Serif Bold as substitute)
+  FONT_TIMES_BOLD: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,682,1137,1024,1024,2048,1706,569,682,682,1024,1167,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,682,682,1167,1167,1167,1024,1905,1479,
+    1366,1479,1479,1366,1251,1593,1593,797,1024,1593,1366,1933,1479,1593,1251,1593,
+    1479,1139,1366,1479,1479,2048,1479,1479,1366,682,569,682,1190,1024,682,1024,1139,
+    909,1139,909,682,1024,1139,569,682,1139,569,1706,1139,1024,1139,1139,909,797,682,
+    1139,1024,1479,1024,1024,909,807,451,807,1065,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,682,1024,1024,1024,1024,451,
+    1024,682,1530,614,1024,1167,682,1530,1024,819,1124,614,614,682,1180,1106,683,682,
+    614,676,1024,1536,1536,1536,1024,1479,1479,1479,1479,1479,1479,2048,1479,1366,
+    1366,1366,1366,797,797,797,797,1479,1479,1593,1593,1593,1593,1593,1167,1593,1479,
+    1479,1479,1479,1479,1251,1139,1024,1024,1024,1024,1024,1024,1479,909,909,909,909,
+    909,569,569,569,569,1024,1139,1024,1024,1024,1024,1024,1124,1024,1139,1139,1139,
+    1139,1024,1139,1024 );
+  FONT_TIMES_BOLD_CAPHEIGHT = 655;
+  FONT_TIMES_BOLD_DESCENDER = 216;
+
+  // timesBI  (used metric equivalent Liberation Serif Bold Italic as substitute)
+  FONT_TIMES_BOLD_ITALIC: array[0..255] of Integer = (
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    512,797,1137,1024,1024,1706,1593,569,682,682,1024,1167,512,682,512,569,1024,1024,
+    1024,1024,1024,1024,1024,1024,1024,1024,682,682,1167,1167,1167,1024,1704,1366,
+    1366,1366,1479,1366,1366,1479,1593,797,1024,1366,1251,1821,1479,1479,1251,1479,
+    1366,1139,1251,1479,1366,1821,1366,1251,1251,682,569,682,1167,1024,682,1024,1024,
+    909,1024,909,682,1024,1139,569,569,1024,569,1593,1139,1024,1024,1024,797,797,569,
+    1139,909,1366,1024,909,797,713,451,713,1167,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,
+    1593,1593,1593,1593,1593,1593,1593,1593,1593,1593,512,797,1024,1024,1024,1024,451,
+    1024,682,1530,545,1024,1241,682,1530,1024,819,1124,614,614,682,1180,1024,512,682,
+    614,614,1024,1536,1536,1536,1024,1366,1366,1366,1366,1366,1366,1933,1366,1366,
+    1366,1366,1366,797,797,797,797,1479,1479,1479,1479,1479,1479,1479,1167,1479,1479,
+    1479,1479,1479,1251,1251,1024,1024,1024,1024,1024,1024,1024,1479,909,909,909,909,
+    909,569,569,569,569,1024,1139,1024,1024,1024,1024,1024,1124,1024,1139,1139,1139,
+    1139,909,1024,909 );
+  FONT_TIMES_BOLD_ITALIC_CAPHEIGHT = 655;
+  FONT_TIMES_BOLD_ITALIC_DESCENDER = 216;
+
+  // courier courierB courierI courierBI
+  FONT_COURIER_FULL: array[0..255] of Integer = (
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,
+    1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229,1229 );
+  FONT_TIMES_COURIER_CAPHEIGHT = 613;
+  FONT_TIMES_COURIER_DESCENDER = 386;
+
+  // symbol
+  FONT_SYMBOL: array[0..255] of Integer = (
+  250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,250,
+  250,250,250,250,250,250,250,250,250,250,250,333,713,500,549,833,778,439,333,333,500,549,
+  250,549,250,278,500,500,500,500,500,500,500,500,500,500,278,278,549,549,549,444,549,722,
+  667,722,612,611,763,603,722,333,631,722,686,889,722,722,768,741,556,592,611,690,439,768,
+  645,795,611,333,863,333,658,500,500,631,549,549,494,439,521,411,603,329,603,549,549,576,
+  521,549,549,521,549,603,439,576,713,686,493,686,494,480,200,480,549,0,0,0,0,0,
+  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+  0,0,0,0,0,0,750,620,247,549,167,713,500,753,753,753,753,1042,987,603,987,603,
+  400,549,411,549,549,713,494,460,549,549,549,549,1000,603,1000,658,823,686,795,987,768,768,
+  823,768,768,713,713,713,713,713,713,713,768,713,790,790,890,823,549,250,713,603,603,1042,
+  987,603,987,603,494,329,790,790,786,713,384,384,384,384,384,384,494,494,494,494,0,329,
+  274,686,686,686,384,384,384,384,384,384,494,494,494,0);
+
+  // zapfdingbats
+  FONT_ZAPFDINGBATS: array[0..255] of Integer = (
+  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+  0,0,0,0,0,0,0,0,0,0,278,974,961,974,980,719,789,790,791,690,960,939,
+  549,855,911,933,911,945,974,755,846,762,761,571,677,763,760,759,754,494,552,537,577,692,
+  786,788,788,790,793,794,816,823,789,841,823,833,816,831,923,744,723,749,790,792,695,776,
+  768,792,759,707,708,682,701,826,815,789,789,707,687,696,689,786,787,713,791,785,791,873,
+  761,762,762,759,759,892,892,788,784,438,138,277,415,392,392,668,668,0,390,390,317,317,
+  276,276,509,509,410,410,234,234,334,334,0,0,0,0,0,0,0,0,0,0,0,0,
+  0,0,0,0,0,0,0,732,544,544,910,667,760,760,776,595,694,626,788,788,788,788,
+  788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,788,
+  788,788,788,788,788,788,788,788,788,788,788,788,788,788,894,838,1016,458,748,924,748,918,
+  927,928,928,834,873,828,924,924,917,930,931,463,883,836,836,867,867,696,696,874,0,874,
+  760,946,771,865,771,888,967,888,831,873,927,970,918,0);
+
+
diff --git a/packages/fcl-pdf/src/fpfonttextmapping.pp b/packages/fcl-pdf/src/fpfonttextmapping.pp
new file mode 100644
index 0000000000..facfe14c76
--- /dev/null
+++ b/packages/fcl-pdf/src/fpfonttextmapping.pp
@@ -0,0 +1,239 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by Graeme Geldenhuys
+
+    This unit defines classes that manage font glyph IDs and unicode
+    character codes.
+
+    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 FPFontTextMapping;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  contnrs;
+
+type
+
+  TTextMapping = class(TObject)
+  private
+    FCharID: uint32;
+    FGlyphID: uint32;
+    FNewGlyphID: uint32;
+    FGlyphData: TStream;
+    FIsCompoundGlyph: boolean;
+  public
+    constructor Create;
+    class function NewTextMap(const ACharID, AGlyphID: uint32): TTextMapping;
+    property    CharID: uint32 read FCharID write FCharID;
+    property    GlyphID: uint32 read FGlyphID write FGlyphID;
+    property    NewGlyphID: uint32 read FNewGlyphID write FNewGlyphID;
+    property    GlyphData: TStream read FGlyphData write FGlyphData;
+    property    IsCompoundGlyph: boolean read FIsCompoundGlyph write FIsCompoundGlyph;
+  end;
+
+
+  TTextMappingList = class(TObject)
+  private
+    FList: TFPObjectList;
+    function    GetCount: Integer;
+  protected
+    function    GetItem(AIndex: Integer): TTextMapping; virtual;
+    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); virtual;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function    Add(AObject: TTextMapping): Integer; overload;
+    function    Add(const ACharID, AGlyphID: uint32): Integer; overload;
+    function    Contains(const AGlyphID: uint32): boolean;
+    function    ContainsCharID(const AID: uint32): boolean;
+    function    GetNewGlyphID(const ACharID: uint32): uint32;
+    function    GetMaxCharID: uint32;
+    function    GetMaxGlyphID: uint32;
+    procedure   Insert(const AIndex: integer; const ACharID, AGlyphID: uint32);
+    procedure   Sort;
+    property    Count: Integer read GetCount;
+    property    Items[AIndex: Integer]: TTextMapping read GetItem write SetItem; default;
+  end;
+
+
+implementation
+
+{ TTextMapping }
+
+constructor TTextMapping.Create;
+begin
+  FGlyphData := nil;
+  FCharID := 0;
+  FGlyphID := 0;
+  FNewGlyphID := 0;
+  FIsCompoundGlyph := False;
+end;
+
+class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint32): TTextMapping;
+begin
+  Result := TTextMapping.Create;
+  Result.CharID := ACharID;
+  Result.GlyphID := AGlyphID;
+end;
+
+{ TTextMappingList }
+
+function TTextMappingList.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TTextMappingList.GetItem(AIndex: Integer): TTextMapping;
+begin
+  Result := TTextMapping(FList.Items[AIndex]);
+end;
+
+procedure TTextMappingList.SetItem(AIndex: Integer; AValue: TTextMapping);
+begin
+  FList.Items[AIndex] := AValue;
+end;
+
+constructor TTextMappingList.Create;
+begin
+  FList := TFPObjectList.Create(True);
+end;
+
+destructor TTextMappingList.Destroy;
+begin
+  FList.Free;
+  inherited Destroy;
+end;
+
+function TTextMappingList.Add(AObject: TTextMapping): Integer;
+var
+  i: integer;
+begin
+  Result := -1;
+  for i := 0 to FList.Count-1 do
+  begin
+    if TTextMapping(FList.Items[i]).CharID = AObject.CharID then
+      Exit; // mapping already exists
+  end;
+  Result := FList.Add(AObject);
+end;
+
+function TTextMappingList.Add(const ACharID, AGlyphID: uint32): Integer;
+var
+  o: TTextMapping;
+begin
+  o := TTextMapping.Create;
+  o.CharID := ACharID;
+  o.GlyphID := AGlyphID;
+  Result := Add(o);
+  if Result = -1 then
+    o.Free;
+end;
+
+function TTextMappingList.Contains(const AGlyphID: uint32): boolean;
+var
+  i: integer;
+begin
+  Result := False;
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].GlyphID = AGlyphID then
+    begin
+      Result := True;
+      Exit;
+    end;
+  end;
+end;
+
+function TTextMappingList.ContainsCharID(const AID: uint32): boolean;
+var
+  i: integer;
+begin
+  Result := False;
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].CharID = AID then
+    begin
+      Result := True;
+      Exit;
+    end;
+  end;
+end;
+
+function TTextMappingList.GetNewGlyphID(const ACharID: uint32): uint32;
+var
+  i: integer;
+begin
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].CharID = ACharID then
+    begin
+      Result := Items[i].NewGlyphID;
+      Exit;
+    end;
+  end;
+end;
+
+function TTextMappingList.GetMaxCharID: uint32;
+begin
+  Sort;
+  Result := Items[Count-1].CharID;
+end;
+
+function TTextMappingList.GetMaxGlyphID: uint32;
+var
+  gid: uint32;
+  i: integer;
+begin
+  gid := 0;
+  for i := 0 to Count-1 do
+  begin
+    if Items[i].GlyphID > gid then
+      gid := Items[i].GlyphID;
+  end;
+  result := gid;
+end;
+
+procedure TTextMappingList.Insert(const AIndex: integer; const ACharID, AGlyphID: uint32);
+var
+  o: TTextMapping;
+begin
+  o := TTextMapping.Create;
+  o.CharID := ACharID;
+  o.GlyphID := AGlyphID;
+  FList.Insert(AIndex, o);
+end;
+
+function CompareByCharID(A, B: TTextMapping): Integer; inline;
+begin
+  if A.CharID < B.CharID then
+    Result := -1
+  else if A.CharID > B.CharID then
+    Result := 1
+  else
+    Result := 0;
+end;
+
+function CompareByCharIDPtr(A, B: Pointer): Integer;
+begin
+  Result := CompareByCharID(TTextMapping(A), TTextMapping(B));
+end;
+
+procedure TTextMappingList.Sort;
+begin
+  FList.Sort(@CompareByCharIDPtr);
+end;
+
+end.
diff --git a/packages/fcl-pdf/src/fpparsettf.pp b/packages/fcl-pdf/src/fpparsettf.pp
index a4b7e91b42..d033a15af1 100644
--- a/packages/fcl-pdf/src/fpparsettf.pp
+++ b/packages/fcl-pdf/src/fpparsettf.pp
@@ -23,190 +23,201 @@ unit fpparsettf;
 interface
 
 uses
-  Classes, SysUtils, fpttfencodings;
+  Classes,
+  SysUtils,
+  fpttfencodings;
 
 type
   ETTF = Class(Exception);
 
   // Tables recognized in this unit.
-  TTTFTableType = (ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost);
+  TTTFTableType = (
+    // these are for general font information
+    ttUnknown,ttHead,tthhea,ttmaxp,tthmtx,ttcmap,ttname,ttOS2,ttpost,
+    // these are used for font subsetting
+    ttglyf,ttloca,ttcvt,ttprep,ttfpgm);
 
   TSmallintArray = Packed Array of Int16;
-  TWordArray = Packed Array of UInt16;
+  TWordArray = Packed Array of UInt16;    // redefined because the one in SysUtils is not a packed array
+
+  { Signed Fixed 16.16 Float }
+  TF16Dot16 = type Int32;
 
   TFixedVersionRec = packed record
     case Integer of
-      0:  (Minor, Major: Word);
-      1:  (Version: Cardinal);
+      0:  (Minor, Major: UInt16);
+      1:  (Version: UInt32);
   end;
 
+  { The file header record that starts at byte 0 of a TTF file }
   TTableDirectory = Packed Record
-    FontVersion : TFixedVersionRec;
-    Numtables : Word;
-    SearchRange : Word;
-    EntrySelector : Word;
-    RangeShift : Word;
+    FontVersion : TFixedVersionRec; { UInt32}
+    Numtables : UInt16;
+    SearchRange : UInt16;
+    EntrySelector : UInt16;
+    RangeShift : UInt16;
   end;
 
   TTableDirectoryEntry = Packed Record
-    Tag: Array[1..4] of char;
-    checkSum : Cardinal;
-    offset : Cardinal;
-    Length : Cardinal;
+    Tag: Array[1..4] of AnsiChar;
+    checkSum : UInt32;
+    offset : UInt32;
+    Length : UInt32;
   end;
   TTableDirectoryEntries = Array of TTableDirectoryEntry;
 
   TLongHorMetric = Packed record
-    AdvanceWidth : Word;
-    LSB: Smallint;              { leftSideBearing }
+    AdvanceWidth : UInt16;
+    LSB: Int16;              { leftSideBearing }
   end;
-  TLongHorMetrics = Packed Array of TLongHorMetric;
+  TLongHorMetricArray = Packed Array of TLongHorMetric;
 
 Type
   TPostScript = Packed Record
-    Format : TFixedVersionRec;
-    ItalicAngle : LongWord;
-    UnderlinePosition : SmallInt;
-    underlineThickness : SmallInt;
-    isFixedPitch : Cardinal;
-    minMemType42 : Cardinal;
-    maxMemType42 : Cardinal;
-    minMemType1 : Cardinal;
-    maxMemType1 : Cardinal;
+    Format : TFixedVersionRec;  { UInt32 }
+    ItalicAngle : TF16Dot16;  { Int32 }
+    UnderlinePosition : Int16;
+    underlineThickness : Int16;
+    isFixedPitch : UInt32;
+    minMemType42 : UInt32;
+    maxMemType42 : UInt32;
+    minMemType1 : UInt32;
+    maxMemType1 : UInt32;
   end;
 
   TMaxP = Packed Record
-    VersionNumber : TFixedVersionRec;
-    numGlyphs : Word;
-    maxPoints : Word;
-    maxContours : Word;
-    maxCompositePoints : word;
-    maxCompositeContours : word;
-    maxZones : Word;
-    maxTwilightPoints : word;
-    maxStorage : Word;
-    maxFunctionDefs : Word;
-    maxInstructionDefs : Word;
-    maxStackElements : Word;
-    maxSizeOfInstructions : word;
-    maxComponentElements : Word;
-    maxComponentDepth : Word;
+    VersionNumber : TFixedVersionRec;  { UInt32 }
+    numGlyphs : UInt16;
+    maxPoints : UInt16;
+    maxContours : UInt16;
+    maxCompositePoints : UInt16;
+    maxCompositeContours : UInt16;
+    maxZones : UInt16;
+    maxTwilightPoints : UInt16;
+    maxStorage : UInt16;
+    maxFunctionDefs : UInt16;
+    maxInstructionDefs : UInt16;
+    maxStackElements : UInt16;
+    maxSizeOfInstructions : UInt16;
+    maxComponentElements : UInt16;
+    maxComponentDepth : UInt16;
   end;
 
   TOS2Data = Packed Record
-    version : Word;
-    xAvgCharWidth : SmallInt;
-    usWeightClass : Word;
-    usWidthClass : Word;
-    fsType : SmallInt;
-    ySubscriptXSize : SmallInt;
-    ySubscriptYSize : SmallInt;
-    ySubscriptXOffset : SmallInt;
-    ySubscriptYOffset : Smallint;
-    ySuperscriptXSize : Smallint;
-    ySuperscriptYSize : Smallint;
-    ySuperscriptXOffset : Smallint;
-    ySuperscriptYOffset : Smallint;
-    yStrikeoutSize : SmallInt;
-    yStrikeoutPosition : Smallint;
-    sFamilyClass : SmallInt;    // we could split this into a record of Class & SubClass values.
+    version : UInt16;
+    xAvgCharWidth : Int16;
+    usWeightClass : UInt16;
+    usWidthClass : UInt16;
+    fsType : Int16;
+    ySubscriptXSize : Int16;
+    ySubscriptYSize : Int16;
+    ySubscriptXOffset : Int16;
+    ySubscriptYOffset : Int16;
+    ySuperscriptXSize : Int16;
+    ySuperscriptYSize : Int16;
+    ySuperscriptXOffset : Int16;
+    ySuperscriptYOffset : Int16;
+    yStrikeoutSize : Int16;
+    yStrikeoutPosition : Int16;
+    sFamilyClass : Int16;    // we could split this into a record of Class & SubClass values.
     panose : Array[0..9] of byte;
-    ulUnicodeRange1 : Cardinal;
-    ulUnicodeRange2 : Cardinal;
-    ulUnicodeRange3 : Cardinal;
-    ulUnicodeRange4 : Cardinal;
-    achVendID : Array[0..3] of char;
-    fsSelection : word;
-    usFirstCharIndex : Word;
-    usLastCharIndex : Word;
-    sTypoAscender: Smallint;
-    sTypoDescender : Smallint;
-    sTypoLineGap : Smallint;
-    usWinAscent : Word;
-    usWinDescent : Word;
-    ulCodePageRange1 : Cardinal;
-    ulCodePageRange2 : Cardinal;
-    sxHeight : smallint;
-    sCapHeight : smallint;
-    usDefaultChar : word;
-    usBreakChar : word;
-    usMaxContext  : word;
+    ulUnicodeRange1 : UInt32;
+    ulUnicodeRange2 : UInt32;
+    ulUnicodeRange3 : UInt32;
+    ulUnicodeRange4 : UInt32;
+    achVendID : Array[0..3] of AnsiChar;
+    fsSelection : UInt16;
+    usFirstCharIndex : UInt16;
+    usLastCharIndex : UInt16;
+    sTypoAscender: Int16;
+    sTypoDescender : Int16;
+    sTypoLineGap : Int16;
+    usWinAscent : UInt16;
+    usWinDescent : UInt16;
+    ulCodePageRange1 : UInt32;
+    ulCodePageRange2 : UInt32;
+    sxHeight : Int16;
+    sCapHeight : Int16;
+    usDefaultChar : UInt16;
+    usBreakChar : UInt16;
+    usMaxContext  : UInt16;
   end;
 
   { Nicely described at [https://www.microsoft.com/typography/otspec/head.htm] }
   THead = Packed record
-    FileVersion : TFixedVersionRec;
-    FontRevision : TFixedVersionRec;
-    CheckSumAdjustment : Cardinal;
-    MagicNumber : Cardinal;
-    Flags : Word;
-    UnitsPerEm: word;
+    FileVersion : TFixedVersionRec;  { UInt32 }
+    FontRevision : TFixedVersionRec;  { UInt32 }
+    CheckSumAdjustment : UInt32;
+    MagicNumber : UInt32;
+    Flags : UInt16;
+    UnitsPerEm: UInt16;
     Created : Int64;
     Modified : Int64;
-    BBox: Packed array[0..3] of Smallint;
-    MacStyle : word;
-    LowestRecPPEM : word;
-    FontDirectionHint : smallint;
-    IndexToLocFormat : Smallint;
-    glyphDataFormat : Smallint;
+    BBox: Packed array[0..3] of Int16;
+    MacStyle : UInt16;
+    LowestRecPPEM : UInt16;
+    FontDirectionHint : Int16;
+    IndexToLocFormat : Int16;
+    glyphDataFormat : Int16;
   end;
 
   { structure described at [https://www.microsoft.com/typography/otspec/hhea.htm] }
   THHead = packed record
-    TableVersion : TFixedVersionRec;
-    Ascender : Smallint;
-    Descender : Smallint;
-    LineGap : Smallint;
-    AdvanceWidthMax : Word;
-    MinLeftSideBearing : Smallint;
-    MinRightSideBearing : Smallint;
-    XMaxExtent : Smallint;
-    CaretSlopeRise : Smallint;
-    CaretSlopeRun : Smallint;
-    Reserved : Array[0..4] of Smallint;
-    metricDataFormat : Smallint;
-    numberOfHMetrics : Word;
+    TableVersion : TFixedVersionRec;  { UInt32 }
+    Ascender : Int16;
+    Descender : Int16;
+    LineGap : Int16;
+    AdvanceWidthMax : UInt16;
+    MinLeftSideBearing : Int16;
+    MinRightSideBearing : Int16;
+    XMaxExtent : Int16;
+    CaretSlopeRise : Int16;
+    CaretSlopeRun : Int16;
+    caretOffset: Int16; // reserved field
+    Reserved : Array[0..3] of Int16;
+    metricDataFormat : Int16;
+    numberOfHMetrics : UInt16;
   end;
 
   { Character to glyph mapping
     Structure described at [https://www.microsoft.com/typography/otspec/cmap.htm] }
   TCmapHeader = packed record
-    Version: word;
-    SubTableCount: word;
+    Version: UInt16;
+    SubTableCount: UInt16;
   end;
 
   TCmapSubTableEntry = packed record
-    PlatformID: word;
-    EncodingID: word;
-    Offset: Cardinal;
+    PlatformID: UInt16;
+    EncodingID: UInt16;
+    Offset: UInt32;
   end;
   TCmapSubTables = Array of TCmapSubTableEntry;
 
   TCmapFmt4 = packed record
-    Format: word;
-    Length: word;
-    LanguageID: word;
-    SegmentCount2: word;
-    SearchRange: word;
-    EntrySelector: word;
-    RangeShift: word;
+    Format: UInt16;
+    Length: UInt16;
+    LanguageID: UInt16;
+    SegmentCount2: UInt16;
+    SearchRange: UInt16;
+    EntrySelector: UInt16;
+    RangeShift: UInt16;
   end;
 
   TUnicodeMapSegment = Packed Record
-    StartCode : Word;
-    EndCode : Word;
-    IDDelta : Smallint;
-    IDRangeOffset : Word;
+    StartCode : UInt16;
+    EndCode : UInt16;
+    IDDelta : Int16;
+    IDRangeOffset : UInt16;
   end;
   TUnicodeMapSegmentArray = Array of TUnicodeMapSegment;
 
   TNameRecord = Packed Record
-    PlatformID : Word;
-    EncodingID : Word;
-    LanguageID : Word;
-    NameID : Word;
-    StringLength : Word;
-    StringOffset : Word;
+    PlatformID : UInt16;
+    EncodingID : UInt16;
+    LanguageID : UInt16;
+    NameID : UInt16;
+    StringLength : UInt16;
+    StringOffset : UInt16;
   end;
 
   TNameEntry = Packed Record
@@ -216,6 +227,19 @@ Type
   TNameEntries = Array of TNameEntry;
 
 
+  TGlyphHeader = packed record
+    numberOfContours: int16;
+    xMin: uint16;
+    yMin: uint16;
+    xMax: uint16;
+    yMax: uint16;
+  end;
+
+
+  { As per the TTF specification document...
+      https://www.microsoft.com/typography/tt/ttf_spec/ttch02.doc
+    ...all TTF files are always stored in Big-Endian byte ordering (pg.31 Data Types).
+  }
   TTFFileInfo = class(TObject)
   private
     FFilename: string;
@@ -230,7 +254,7 @@ Type
     FHHEad : THHead;
     FOS2Data : TOS2Data;
     FPostScript : TPostScript;
-    FWidths: TLongHorMetrics; // hmtx data
+    FWidths: TLongHorMetricArray; // hmtx data
     // Needed to create PDF font def.
     FOriginalSize : Cardinal;
     FMissingWidth: Integer;
@@ -240,10 +264,9 @@ Type
     function GetMissingWidth: integer;
   Protected
     // Stream reading functions.
-    Function IsNativeData : Boolean; virtual;
-    function ReadShort(AStream: TStream): Smallint; inline;
-    function ReadULong(AStream: TStream): Longword; inline;
-    function ReadUShort(AStream: TStream): Word; inline;
+    function ReadInt16(AStream: TStream): Int16; inline;
+    function ReadUInt32(AStream: TStream): UInt32; inline;
+    function ReadUInt16(AStream: TStream): UInt16; inline;
     // Parse the various well-known tables
     procedure ParseHead(AStream : TStream); virtual;
     procedure ParseHhea(AStream : TStream); virtual;
@@ -266,9 +289,11 @@ Type
     CharBase:  PTTFEncodingNames;
     PostScriptName: string;
     FamilyName: string;
+    HumanFriendlyName: string; // aka FullName
     destructor Destroy; override;
     { Returns the Glyph Index value in the TTF file, where AValue is the ordinal value of a character. }
     function  GetGlyphIndex(AValue: word): word;
+    function  GetTableDirEntry(const ATableName: string; var AEntry: TTableDirectoryEntry): boolean;
     // Load a TTF file from file or stream.
     Procedure LoadFromFile(const AFileName : String);
     Procedure LoadFromStream(AStream: TStream); virtual;
@@ -288,7 +313,7 @@ Type
     Function CapHeight: SmallInt;
     { Returns the glyph advance width, based on the AIndex (glyph index) value. The result is in font units. }
     function GetAdvanceWidth(AIndex: word): word;
-    function ItalicAngle: LongWord;
+    function ItalicAngle: single;
     { max glyph bounding box values - as space separated values }
     function BBox: string;
     property MissingWidth: Integer read GetMissingWidth;
@@ -304,7 +329,7 @@ Type
     property CmapSubtables : TCmapSubTables Read FSubtables;
     property CmapUnicodeMap : TCmapFmt4 Read FUnicodeMap;
     property CmapUnicodeMapSegments : TUnicodeMapSegmentArray Read FUnicodeMapSegments;
-    Property Widths : TLongHorMetrics Read FWidths;
+    Property Widths : TLongHorMetricArray Read FWidths;
     Property MaxP : TMaxP Read FMaxP;
     Property OS2Data : TOS2Data Read FOS2Data;
     Property PostScript : TPostScript Read FPostScript;
@@ -328,7 +353,8 @@ procedure FillMem(Dest: pointer; Size: longint; Data: Byte );
 
 Const
   TTFTableNames : Array[TTTFTableType] of String
-                 = ('','head','hhea','maxp','hmtx','cmap','name','OS/2','post');
+                 = ('','head','hhea','maxp','hmtx','cmap','name','OS/2','post',
+                 'glyf', 'loca', 'cvt ', 'prep', 'fpgm');
 
 
 Const
@@ -356,6 +382,7 @@ implementation
 
 resourcestring
   rsFontEmbeddingNotAllowed = 'Font licence does not allow embedding';
+  rsErrUnexpectedUnicodeSubtable = 'Unexpected unicode subtable format, expected 4, got %s';
 
 Function GetTableType(Const AName : String) : TTTFTableType;
 begin
@@ -385,25 +412,23 @@ begin
   FillChar(Dest^, Size, Data);
 end;
 
-function TTFFileInfo.ReadULong(AStream: TStream): Longword;inline;
+function TTFFileInfo.ReadUInt32(AStream: TStream): UInt32;
 begin
   Result:=0;
   AStream.ReadBuffer(Result,SizeOf(Result));
-  if Not IsNativeData then
-    Result:=BEtoN(Result);
+  Result:=BEtoN(Result);
 end;
 
-function TTFFileInfo.ReadUShort(AStream: TStream): Word;inline;
+function TTFFileInfo.ReadUInt16(AStream: TStream): UInt16;
 begin
   Result:=0;
   AStream.ReadBuffer(Result,SizeOf(Result));
-  if Not IsNativeData then
-    Result:=BEtoN(Result);
+  Result:=BEtoN(Result);
 end;
 
-function TTFFileInfo.ReadShort(AStream: TStream): Smallint;inline;
+function TTFFileInfo.ReadInt16(AStream: TStream): Int16;
 begin
-  Result:=SmallInt(ReadUShort(AStream));
+  Result:=Int16(ReadUInt16(AStream));
 end;
 
 procedure TTFFileInfo.ParseHead(AStream : TStream);
@@ -411,8 +436,6 @@ var
   i : Integer;
 begin
   AStream.ReadBuffer(FHead,SizeOf(FHead));
-  if IsNativeData then
-    exit;
   FHead.FileVersion.Version := BEtoN(FHead.FileVersion.Version);
   FHead.FileVersion.Minor := FixMinorVersion(FHead.FileVersion.Minor);
   FHead.FontRevision.Version := BEtoN(FHead.FontRevision.Version);
@@ -433,34 +456,29 @@ begin
 end;
 
 procedure TTFFileInfo.ParseHhea(AStream : TStream);
-
 begin
   AStream.ReadBuffer(FHHEad,SizeOf(FHHEad));
-  if IsNativeData then
-    exit;
   FHHEad.TableVersion.Version := BEToN(FHHEad.TableVersion.Version);
   FHHEad.TableVersion.Minor := FixMinorVersion(FHHEad.TableVersion.Minor);
   FHHEad.Ascender:=BEToN(FHHEad.Ascender);
   FHHEad.Descender:=BEToN(FHHEad.Descender);
   FHHEad.LineGap:=BEToN(FHHEad.LineGap);
+  FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
   FHHEad.MinLeftSideBearing:=BEToN(FHHEad.MinLeftSideBearing);
   FHHEad.MinRightSideBearing:=BEToN(FHHEad.MinRightSideBearing);
   FHHEad.XMaxExtent:=BEToN(FHHEad.XMaxExtent);
   FHHEad.CaretSlopeRise:=BEToN(FHHEad.CaretSlopeRise);
   FHHEad.CaretSlopeRun:=BEToN(FHHEad.CaretSlopeRun);
+  FHHEad.caretOffset := BEToN(FHHEad.caretOffset);
   FHHEad.metricDataFormat:=BEToN(FHHEad.metricDataFormat);
   FHHEad.numberOfHMetrics:=BEToN(FHHEad.numberOfHMetrics);
-  FHHead.AdvanceWidthMax := BEToN(FHHead.AdvanceWidthMax);
 end;
 
 procedure TTFFileInfo.ParseMaxp(AStream : TStream);
-
 begin
   AStream.ReadBuffer(FMaxP,SizeOf(TMaxP));
-  if IsNativeData then
-    exit;
   With FMaxP do
-    begin
+  begin
     VersionNumber.Version := BEtoN(VersionNumber.Version);
     VersionNumber.Minor := FixMinorVersion(VersionNumber.Minor);
     numGlyphs:=BEtoN(numGlyphs);
@@ -477,24 +495,20 @@ begin
     maxSizeOfInstructions :=BEtoN(maxSizeOfInstructions);
     maxComponentElements :=BEtoN(maxComponentElements);
     maxComponentDepth :=BEtoN(maxComponentDepth);
-    end;
+  end;
 end;
 
 procedure TTFFileInfo.ParseHmtx(AStream : TStream);
-
 var
   i : Integer;
-
 begin
   SetLength(FWidths,FHHead.numberOfHMetrics);
   AStream.ReadBuffer(FWidths[0],SizeOf(TLongHorMetric)*Length(FWidths));
-  if IsNativeData then
-    exit;
   for I:=0 to FHHead.NumberOfHMetrics-1 do
-    begin
+  begin
     FWidths[I].AdvanceWidth:=BEtoN(FWidths[I].AdvanceWidth);
     FWidths[I].LSB:=BEtoN(FWidths[I].LSB);
-    end;
+  end;
 end;
 
 
@@ -506,55 +520,57 @@ var
   Segm : TUnicodeMapSegment;
   GlyphIDArray : Array of word;
   S : TStream;
-
 begin
   TableStartPos:=AStream.Position;
-  FCMapH.Version:=ReadUShort(AStream);
-  FCMapH.SubtableCount:=ReadUShort(AStream);
+  FCMapH.Version:=ReadUInt16(AStream);
+  FCMapH.SubtableCount:=ReadUInt16(AStream);
   SetLength(FSubtables,CMapH.SubtableCount);
   for I:= 0 to FCMapH.SubtableCount-1 do
     begin
-    FSubtables[i].PlatformID:=ReadUShort(AStream);
-    FSubtables[i].EncodingID:=ReadUShort(AStream);
-    FSubtables[i].Offset:=ReadULong(AStream); // 4 bytes - Offset of subtable
+    FSubtables[i].PlatformID:=ReadUInt16(AStream);
+    FSubtables[i].EncodingID:=ReadUInt16(AStream);
+    FSubtables[i].Offset:=ReadUInt32(AStream); // 4 bytes - Offset of subtable
     end;
   UE:=FCMapH.SubtableCount-1;
+  if UE=0 then
+    // No CMap subtable entries, this is not an error, just exit.
+    exit;
   While (UE>=0) and ((FSubtables[UE].PlatformID<>3) or (FSubtables[UE].EncodingID<> 1)) do
     Dec(UE);
   if (UE=-1) then
-    Raise ETTF.Create('No Format 4 map (unicode) table found <'+FFileName + ' - ' + PostScriptName+'>');
+    exit;
   TT:=TableStartPos+FSubtables[UE].Offset;
   AStream.Position:=TT;
-  FUnicodeMap.Format:= ReadUShort(AStream);               // 2 bytes - Format of subtable
+  FUnicodeMap.Format:= ReadUInt16(AStream);               // 2 bytes - Format of subtable
   if (FUnicodeMap.Format<>4) then
-    Raise ETTF.CreateFmt('Unexpected unicode subtable format, expected 4, got %s',[FUnicodeMap.Format]);
-  FUnicodeMap.Length:=ReadUShort(AStream);
+    Raise ETTF.CreateFmt(rsErrUnexpectedUnicodeSubtable, [FUnicodeMap.Format]);
+  FUnicodeMap.Length:=ReadUInt16(AStream);
   S:=TMemoryStream.Create;
   try
     // Speed up the process, read everything in a single mem block.
     S.CopyFrom(AStream,Int64(FUnicodeMap.Length)-4);
     S.Position:=0;
-    FUnicodeMap.LanguageID:=ReadUShort(S);
-    FUnicodeMap.SegmentCount2:=ReadUShort(S);            // 2 bytes - Segments count
-    FUnicodeMap.SearchRange:=ReadUShort(S);
-    FUnicodeMap.EntrySelector:=ReadUShort(S);
-    FUnicodeMap.RangeShift:=ReadUShort(S);
+    FUnicodeMap.LanguageID:=ReadUInt16(S);
+    FUnicodeMap.SegmentCount2:=ReadUInt16(S);            // 2 bytes - Segments count
+    FUnicodeMap.SearchRange:=ReadUInt16(S);
+    FUnicodeMap.EntrySelector:=ReadUInt16(S);
+    FUnicodeMap.RangeShift:=ReadUInt16(S);
     SegCount:=FUnicodeMap.SegmentCount2 div 2;
     SetLength(FUnicodeMapSegments,SegCount);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].EndCode:=ReadUShort(S);
-    ReadUShort(S);
+      FUnicodeMapSegments[i].EndCode:=ReadUInt16(S);
+    ReadUInt16(S);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].StartCode:=ReadUShort(S);
+      FUnicodeMapSegments[i].StartCode:=ReadUInt16(S);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].IDDelta:=ReadShort(S);
+      FUnicodeMapSegments[i].IDDelta:=ReadInt16(S);
     for i:=0 to SegCount-1 do
-      FUnicodeMapSegments[i].IDRangeOffset:=ReadUShort(S);
+      FUnicodeMapSegments[i].IDRangeOffset:=ReadUInt16(S);
     UE:=S.Position;
     UE:=(S.Size-UE) div 2;
     SetLength(GlyphIDArray,UE);
     For J:=0 to UE-1 do
-      GlyphIDArray[J]:=ReadUShort(S);
+      GlyphIDArray[J]:=ReadUInt16(S);
     J:=0;
     for i:=0 to SegCount-1 do
       With FUnicodeMapSegments[i] do
@@ -601,9 +617,9 @@ var
 
 begin
   TableStartPos:= AStream.Position;                   // memorize Table start position
-  ReadUShort(AStream);                  // skip 2 bytes - Format
-  Count:=ReadUShort(AStream);                        // 2 bytes
-  StringOffset:=ReadUShort(AStream);                 // 2 bytes
+  ReadUInt16(AStream);                  // skip 2 bytes - Format
+  Count:=ReadUInt16(AStream);                        // 2 bytes
+  StringOffset:=ReadUInt16(AStream);                 // 2 bytes
   E := FNameEntries;
   SetLength(E,Count);
   FillMem(@N, SizeOf(TNameRecord), 0);
@@ -645,15 +661,23 @@ begin
       writeln('NameID = ', E[i].Info.NameID);
       writeln('Value = ', E[i].Value);
     {$ENDIF}
+
     if (PostScriptName='')
        and (E[i].Info.NameID=NameIDPostScriptName)
        and (E[i].Info.EncodingID=NameMSEncodingUGL) then
       PostScriptName:=E[i].Value;
+
     if (FamilyName = '')
         and (E[i].Info.NameID = NameIDFontFamily)
         and (E[i].Info.LanguageID = 1033)
         and (E[i].Info.EncodingID = 1) then
       FamilyName := E[i].Value;
+
+    if (HumanFriendlyName = '')
+        and (E[i].Info.NameID = NameIDFullFontName)
+        and (E[i].Info.LanguageID = 1033)
+        and (E[i].Info.EncodingID = 1) then
+      HumanFriendlyName := E[i].Value;
   end; { for i ... }
 end;
 
@@ -663,80 +687,76 @@ begin
   FillWord(FOS2Data,SizeOf(TOS2Data) div 2,0);
   // -18, so version 1 will not overflow
   AStream.ReadBuffer(FOS2Data,SizeOf(TOS2Data)-18);
-  if Not isNativeData then
-    With FOS2Data do
-      begin
-      version:=BeToN(version);
-      xAvgCharWidth:=BeToN(xAvgCharWidth);
-      usWeightClass:=BeToN(usWeightClass);
-      usWidthClass:=BeToN(usWidthClass);
-      fsType:=BeToN(fsType);
-      ySubscriptXSize:=BeToN(ySubscriptXSize);
-      ySubscriptYSize:=BeToN(ySubscriptYSize);
-      ySubscriptXOffset:=BeToN(ySubscriptXOffset);
-      ySubscriptYOffset:=BeToN(ySubscriptYOffset);
-      ySuperscriptXSize:=BeToN(ySuperscriptXSize);
-      ySuperscriptYSize:=BeToN(ySuperscriptYSize);
-      ySuperscriptXOffset:=BeToN(ySuperscriptXOffset);
-      ySuperscriptYOffset:=BeToN(ySuperscriptYOffset);
-      yStrikeoutSize:=BeToN(yStrikeoutSize);
-      yStrikeoutPosition:=BeToN(yStrikeoutPosition);
-      sFamilyClass:=BeToN(sFamilyClass);
-      ulUnicodeRange1:=BeToN(ulUnicodeRange1);
-      ulUnicodeRange2:=BeToN(ulUnicodeRange2);
-      ulUnicodeRange3:=BeToN(ulUnicodeRange3);
-      ulUnicodeRange4:=BeToN(ulUnicodeRange4);
-      fsSelection:=BeToN(fsSelection);
-      usFirstCharIndex:=BeToN(usFirstCharIndex);
-      usLastCharIndex:=BeToN(usLastCharIndex);
-      sTypoAscender:=BeToN(sTypoAscender);
-      sTypoDescender:=BeToN(sTypoDescender);
-      sTypoLineGap:=BeToN(sTypoLineGap);
-      usWinAscent:=BeToN(usWinAscent);
-      usWinDescent:=BeToN(usWinDescent);
-      // We miss 7 fields
-      end;
   With FOS2Data do
-    begin
+  begin
+    version:=BeToN(version);
+    xAvgCharWidth:=BeToN(xAvgCharWidth);
+    usWeightClass:=BeToN(usWeightClass);
+    usWidthClass:=BeToN(usWidthClass);
+    fsType:=BeToN(fsType);
+    ySubscriptXSize:=BeToN(ySubscriptXSize);
+    ySubscriptYSize:=BeToN(ySubscriptYSize);
+    ySubscriptXOffset:=BeToN(ySubscriptXOffset);
+    ySubscriptYOffset:=BeToN(ySubscriptYOffset);
+    ySuperscriptXSize:=BeToN(ySuperscriptXSize);
+    ySuperscriptYSize:=BeToN(ySuperscriptYSize);
+    ySuperscriptXOffset:=BeToN(ySuperscriptXOffset);
+    ySuperscriptYOffset:=BeToN(ySuperscriptYOffset);
+    yStrikeoutSize:=BeToN(yStrikeoutSize);
+    yStrikeoutPosition:=BeToN(yStrikeoutPosition);
+    sFamilyClass:=BeToN(sFamilyClass);
+    ulUnicodeRange1:=BeToN(ulUnicodeRange1);
+    ulUnicodeRange2:=BeToN(ulUnicodeRange2);
+    ulUnicodeRange3:=BeToN(ulUnicodeRange3);
+    ulUnicodeRange4:=BeToN(ulUnicodeRange4);
+    fsSelection:=BeToN(fsSelection);
+    usFirstCharIndex:=BeToN(usFirstCharIndex);
+    usLastCharIndex:=BeToN(usLastCharIndex);
+    sTypoAscender:=BeToN(sTypoAscender);
+    sTypoDescender:=BeToN(sTypoDescender);
+    sTypoLineGap:=BeToN(sTypoLineGap);
+    usWinAscent:=BeToN(usWinAscent);
+    usWinDescent:=BeToN(usWinDescent);
+    // We miss 7 fields
+  end;
+  With FOS2Data do
+  begin
     // Read remaining 7 fields' data depending on version
     if Version>=1 then
-      begin
-      ulCodePageRange1:=ReadULong(AStream);
-      ulCodePageRange2:=ReadULong(AStream);
-      end;
+    begin
+      ulCodePageRange1:=ReadUInt32(AStream);
+      ulCodePageRange2:=ReadUInt32(AStream);
+    end;
     if Version>=2 then
-      begin
-      sxHeight:=ReadShort(AStream);
-      sCapHeight:=ReadShort(AStream);
-      usDefaultChar:=ReadUShort(AStream);
-      usBreakChar:=ReadUShort(AStream);
-      usMaxContext:=ReadUShort(AStream);
-      end;
+    begin
+      sxHeight:=ReadInt16(AStream);
+      sCapHeight:=ReadInt16(AStream);
+      usDefaultChar:=ReadUInt16(AStream);
+      usBreakChar:=ReadUInt16(AStream);
+      usMaxContext:=ReadUInt16(AStream);
     end;
+  end;
 end;
 
 procedure TTFFileInfo.ParsePost(AStream : TStream);
-
 begin
   AStream.ReadBuffer(FPostScript,SizeOf(TPostScript));
-  if not IsNativeData then
-    With FPostScript do
-      begin
-      Format.Version := BEtoN(Format.Version);
-      Format.Minor := FixMinorVersion(Format.Minor);
-      ItalicAngle:=BeToN(ItalicAngle);
-      UnderlinePosition:=BeToN(UnderlinePosition);
-      underlineThickness:=BeToN(underlineThickness);
-      isFixedPitch:=BeToN(isFixedPitch);
-      minMemType42:=BeToN(minMemType42);
-      maxMemType42:=BeToN(maxMemType42);
-      minMemType1:=BeToN(minMemType1);
-      maxMemType1:=BeToN(maxMemType1);
-      end;
+  With FPostScript do
+  begin
+    Format.Version := BEtoN(Format.Version);
+    Format.Minor := FixMinorVersion(Format.Minor);
+    ItalicAngle:=BeToN(ItalicAngle);
+    UnderlinePosition:=BeToN(UnderlinePosition);
+    underlineThickness:=BeToN(underlineThickness);
+    isFixedPitch:=BeToN(isFixedPitch);
+    minMemType42:=BeToN(minMemType42);
+    maxMemType42:=BeToN(maxMemType42);
+    minMemType1:=BeToN(minMemType1);
+    maxMemType1:=BeToN(maxMemType1);
+  end;
 end;
 
 procedure TTFFileInfo.LoadFromFile(const AFileName: String);
-
 Var
   AStream: TFileStream;
 begin
@@ -756,31 +776,30 @@ var
 begin
   FOriginalSize:= AStream.Size;
   AStream.ReadBuffer(FTableDir,Sizeof(TTableDirectory));
-  if not isNativeData then
-    With FTableDir do
-      begin
-      FontVersion.Version := BEtoN(FontVersion.Version);
-      FontVersion.Minor := FixMinorVersion(FontVersion.Minor);
-      Numtables:=BeToN(Numtables);
-      SearchRange:=BeToN(SearchRange);
-      EntrySelector:=BeToN(EntrySelector);
-      RangeShift:=BeToN(RangeShift);
-      end;
+  With FTableDir do
+  begin
+    FontVersion.Version := BEtoN(FontVersion.Version);
+    FontVersion.Minor := FixMinorVersion(FontVersion.Minor);
+    Numtables:=BeToN(Numtables);
+    SearchRange:=BeToN(SearchRange);
+    EntrySelector:=BeToN(EntrySelector);
+    RangeShift:=BeToN(RangeShift);
+  end;
   SetLength(FTables,FTableDir.Numtables);
   AStream.ReadBuffer(FTables[0],FTableDir.NumTables*Sizeof(TTableDirectoryEntry));
-  if Not IsNativeData then
-    For I:=0 to Length(FTables)-1 do
-      With FTables[I] do
-        begin
-        checkSum:=BeToN(checkSum);
-        offset:=BeToN(offset);
-        Length:=BeToN(Length);
-        end;
-  for I:=0 to FTableDir.NumTables-1 do
+  For I:=0 to Length(FTables)-1 do
+    With FTables[I] do
     begin
+      // note: Tag field doesn't require BEtoN processing.
+      checkSum:=BeToN(checkSum);
+      offset:=BeToN(offset);
+      Length:=BeToN(Length);
+    end;
+  for I:=0 to FTableDir.NumTables-1 do
+  begin
     TT:=GetTableType(FTables[I].Tag);
     if (TT<>ttUnknown) then
-      begin
+    begin
       AStream.Position:=FTables[i].Offset;
       Case TT of
         tthead: ParseHead(AStream);
@@ -792,8 +811,8 @@ begin
         ttos2 : ParseOS2(AStream);
         ttPost: ParsePost(AStream);
       end;
-      end;
     end;
+  end;
 end;
 
 procedure TTFFileInfo.PrepareFontDefinition(const Encoding: string; Embed: Boolean);
@@ -806,13 +825,13 @@ begin
 //  MissingWidth:=ToNatural(Widths[Chars[CharCodes^[32]]].AdvanceWidth);  // Char(32) - Space character
   FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
   for I:=0 to 255 do
-    begin
+  begin
     if (CharCodes^[i]>=0) and (CharCodes^[i]<=High(Chars))
     and (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
       CharWidth[I]:= ToNatural(Widths[Chars[CharCodes^[I]]].AdvanceWidth)
     else
       CharWidth[I]:= FMissingWidth;
-    end;
+  end;
 end;
 
 procedure TTFFileInfo.PrepareEncoding(const AEncoding: String);
@@ -835,12 +854,12 @@ begin
   L:= 0;
   for i:=32 to 255 do
     if CharNames^[i]<>CharBase^[i]  then
-      begin
+    begin
       if (i<>l+1) then
         Result:= Result+IntToStr(i)+' ';
       l:=i;
       Result:= Result+'/'+CharNames^[i]+' ';
-      end;
+    end;
 end;
 
 function TTFFileInfo.Bold: Boolean;
@@ -893,14 +912,31 @@ begin
   result := Chars[AValue];
 end;
 
+function TTFFileInfo.GetTableDirEntry(const ATableName: string; var AEntry: TTableDirectoryEntry): boolean;
+var
+  i: integer;
+begin
+  FillMem(@AEntry, SizeOf(TTableDirectoryEntry), 0);
+  Result := False;
+  for i := Low(Tables) to High(Tables) do
+  begin
+    if CompareStr(Tables[i].Tag, ATableName) = 0 then
+    begin
+      Result := True;
+      AEntry := Tables[i];
+      Exit;
+    end;
+  end;
+end;
+
 function TTFFileInfo.GetAdvanceWidth(AIndex: word): word;
 begin
   Result := Widths[AIndex].AdvanceWidth;
 end;
 
-function TTFFileInfo.ItalicAngle: LongWord;
+function TTFFileInfo.ItalicAngle: single;
 begin
-  Result := FPostScript.ItalicAngle;
+  Result := FPostScript.ItalicAngle / 65536.0;
 end;
 
 function TTFFileInfo.BBox: string;
@@ -936,16 +972,11 @@ function TTFFileInfo.GetMissingWidth: integer;
 begin
   if FMissingWidth = 0 then
   begin
-    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // Char(32) - Space character
+    FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth;  // 32 is in reference to the Space character
   end;
   Result := FMissingWidth;
 end;
 
-function TTFFileInfo.IsNativeData: Boolean;
-begin
-  Result:=False;
-end;
-
 function TTFFileInfo.ToNatural(AUnit: Smallint): Smallint;
 begin
   if FHead.UnitsPerEm=0 then
diff --git a/packages/fcl-pdf/src/fppdf.pp b/packages/fcl-pdf/src/fppdf.pp
index efede1ccc2..acfcd1170d 100644
--- a/packages/fcl-pdf/src/fppdf.pp
+++ b/packages/fcl-pdf/src/fppdf.pp
@@ -13,6 +13,12 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
+
+    LOCALISATION NOTICE:
+       Most of the string constants in this unit should NOT be localised,
+       as they are specific constants used in the PDF Specification document.
+       If you do localise anything, make sure you know what you are doing.
+
  **********************************************************************}
 unit fpPDF;
 
@@ -28,15 +34,32 @@ uses
   SysUtils,
   StrUtils,
   contnrs,
-  fpImage, FPReadJPEG,
+  fpImage,
+  FPReadJPEG, FPReadPNG, FPReadBMP, // these are required for auto image-handler functionality
   zstream,
-  fpparsettf;
+  fpparsettf,
+  fpTTFSubsetter,
+  FPFontTextMapping;
 
 Const
-  clBlack = $000000;
-  clBlue  = $0000FF;
-  clGreen = $00FF00;
-  clRed   = $FF0000;
+  { Some popular predefined colors. Channel format is: RRGGBB }
+  clBlack   = $000000;
+  clWhite   = $FFFFFF;
+  clBlue    = $0000FF;
+  clGreen   = $008000;
+  clRed     = $FF0000;
+  clAqua    = $00FFFF;
+  clMagenta = $FF00FF;
+  clYellow  = $FFFF00;
+  clLtGray  = $C0C0C0;
+  clMaroon  = $800000;
+  clOlive   = $808000;
+  clDkGray  = $808080;
+  clTeal    = $008080;
+  clNavy    = $000080;
+  clPurple  = $800080;
+  clLime    = $00FF00;
+  clWaterMark = $F0F0F0;
 
 type
   TPDFPaperType = (ptCustom, ptA4, ptA5, ptLetter, ptLegal, ptExecutive, ptComm10, ptMonarch, ptDL, ptC5, ptB5);
@@ -45,11 +68,17 @@ type
   TPDFPageLayout = (lSingle, lTwo, lContinuous);
   TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels);
 
-  TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG);
+  TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts, poPageOriginAtTop, poSubsetFont);
   TPDFOptions = set of TPDFOption;
 
   EPDF = Class(Exception);
-  TPDFDocument = Class;
+
+  // forward declarations
+  TPDFDocument = class;
+  TPDFAnnotList = class;
+  TPDFLineStyleDef = class;
+  TPDFPage = class;
+
   TARGBColor = Cardinal;
   TPDFFloat = Single;
 
@@ -97,6 +126,9 @@ type
     procedure SetYTranslation(const AValue: TPDFFloat);
   end;
 
+  // CharWidth array of standard PDF fonts
+  TPDFFontWidthArray = array[0..255] of integer;
+
 
   TPDFObject = class(TObject)
   Protected
@@ -118,7 +150,7 @@ type
   end;
 
 
-  TPDFBoolean = class(TPDFObject)
+  TPDFBoolean = class(TPDFDocumentObject)
   private
     FValue: Boolean;
   protected
@@ -128,7 +160,7 @@ type
   end;
 
 
-  TPDFMoveTo = class(TPDFObject)
+  TPDFMoveTo = class(TPDFDocumentObject)
   private
     FPos : TPDFCoord;
   protected
@@ -141,7 +173,47 @@ type
   end;
 
 
-  TPDFInteger = class(TPDFObject)
+  TPDFResetPath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFClosePath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFStrokePath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFPushGraphicsStack = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFPopGraphicsStack = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
+
+  TPDFInteger = class(TPDFDocumentObject)
   private
     FInt: integer;
   protected
@@ -153,7 +225,7 @@ type
   end;
 
 
-  TPDFReference = class(TPDFObject)
+  TPDFReference = class(TPDFDocumentObject)
   private
     FValue: integer;
   protected
@@ -164,7 +236,7 @@ type
   end;
 
 
-  TPDFName = class(TPDFObject)
+  TPDFName = class(TPDFDocumentObject)
   private
     FName : string;
     FMustEscape: boolean;
@@ -190,11 +262,12 @@ type
 
   TPDFString = class(TPDFAbstractString)
   private
-    FValue: string;
+    FValue: AnsiString;
   protected
     procedure Write(const AStream: TStream); override;
   public
-    constructor Create(Const ADocument : TPDFDocument; const AValue: string); overload;
+    constructor Create(Const ADocument : TPDFDocument; const AValue: AnsiString); overload;
+    property    Value: AnsiString read FValue;
   end;
 
 
@@ -207,6 +280,20 @@ type
     procedure Write(const AStream: TStream); override;
   public
     constructor Create(Const ADocument : TPDFDocument; const AValue: UTF8String; const AFontIndex: integer); overload;
+    property    Value: UTF8String read FValue;
+  end;
+
+  { Is useful to populate an array with free-form space separated values. This
+    class is similar to TPDFString, except it doesn't wrap the string content with
+    '(' and ')' symbols and doesn't escape the content. }
+  TPDFFreeFormString = class(TPDFAbstractString)
+  private
+    FValue: string;
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    constructor Create(Const ADocument: TPDFDocument; const AValue: string); overload;
+    property    Value: string read FValue;
   end;
 
 
@@ -218,13 +305,14 @@ type
     procedure AddItem(const AValue: TPDFObject);
     // Add integers in S as TPDFInteger elements to the array
     Procedure AddIntArray(S : String);
+    procedure AddFreeFormArrayValues(S: string);
   public
     constructor Create(Const ADocument : TPDFDocument); override;
     destructor Destroy; override;
   end;
 
 
-  TPDFStream = class(TPDFObject)
+  TPDFStream = class(TPDFDocumentObject)
   private
     FItems: TFPObjectList;
   protected
@@ -236,64 +324,83 @@ type
   end;
 
 
-  TPDFEmbeddedFont = class(TPDFObject)
+  TPDFEmbeddedFont = class(TPDFDocumentObject)
   private
     FTxtFont: integer;
     FTxtSize: string;
+    FPage: TPDFPage;
+    function    GetPointSize: integer;
   protected
     procedure Write(const AStream: TStream); override;
-    Class function WriteEmbeddedFont(const ADocument: TPDFDocument; const Src: TMemoryStream; const AStream: TStream): int64;
+    class function WriteEmbeddedFont(const ADocument: TPDFDocument; const Src: TMemoryStream; const AStream: TStream): int64;
+    class function WriteEmbeddedSubsetFont(const ADocument: TPDFDocument; const AFontNum: integer; const AOutStream: TStream): int64;
   public
-    constructor Create(Const ADocument : TPDFDocument;const AFont: integer; const ASize: string); overload;
+    constructor Create(const ADocument: TPDFDocument;const APage: TPDFPage; const AFont: integer; const ASize: string); overload;
+    property    FontIndex: integer read FTxtFont;
+    property    PointSize: integer read GetPointSize;
+    property    Page: TPDFPage read FPage;
   end;
 
 
-  TPDFText = class(TPDFObject)
+  TPDFBaseText = class(TPDFDocumentObject)
   private
     FX: TPDFFloat;
     FY: TPDFFloat;
+    FFont: TPDFEmbeddedFont;
+    FDegrees: single;
+    FUnderline: boolean;
+    FColor: TARGBColor;
+    FStrikeThrough: boolean;
+  public
+    constructor Create(const ADocument: TPDFDocument); override;
+    property    X: TPDFFloat read FX write FX;
+    property    Y: TPDFFloat read FY write FY;
+    property    Font: TPDFEmbeddedFont read FFont write FFont;
+    property    Degrees: single read FDegrees write FDegrees;
+    property    Underline: boolean read FUnderline write FUnderline;
+    property    Color: TARGBColor read FColor write FColor;
+    property    StrikeThrough: boolean read FStrikeThrough write FStrikeThrough;
+  end;
+
+
+  TPDFText = class(TPDFBaseText)
+  private
     FString: TPDFString;
-    FFontIndex: integer;
+    function    GetTextWidth: single;
+    function    GetTextHeight: single;
   protected
-    procedure Write(const AStream: TStream); override;
+    procedure   Write(const AStream: TStream); override;
   public
-    constructor Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString; const AFontIndex: integer); overload;
-    destructor Destroy; override;
-    Property X : TPDFFloat Read FX Write FX;
-    Property Y : TPDFFloat Read FY Write FY;
-    Property Text : TPDFString Read FString;
-    property FontIndex: integer read FFontIndex;
+    constructor Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); overload;
+    destructor  Destroy; override;
+    property    Text: TPDFString read FString;
   end;
 
 
-  TPDFUTF8Text = class(TPDFObject)
+  TPDFUTF8Text = class(TPDFBaseText)
   private
-    FX: TPDFFloat;
-    FY: TPDFFloat;
     FString: TPDFUTF8String;
-    FFontIndex: integer;
   protected
-    procedure Write(const AStream: TStream); override;
+    procedure   Write(const AStream: TStream); override;
   public
-    constructor Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String; const AFontIndex: integer); overload;
-    destructor Destroy; override;
-    Property X : TPDFFloat Read FX Write FX;
-    Property Y : TPDFFloat Read FY Write FY;
-    Property Text : TPDFUTF8String Read FString;
-    property FontIndex: integer read FFontIndex;
+    constructor Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); overload;
+    destructor  Destroy; override;
+    property    Text: TPDFUTF8String read FString;
   end;
 
 
   TPDFLineSegment = class(TPDFDocumentObject)
   private
     FWidth: TPDFFloat;
+    FStroke: boolean;
     P1, p2: TPDFCoord;
   protected
     procedure Write(const AStream: TStream); override;
   public
-    Class Function Command(APos : TPDFCoord) : String;
-    Class Function Command(APos1,APos2 : TPDFCoord) : String;
-    constructor Create(Const ADocument : TPDFDocument; const AWidth, X1,Y1, X2,Y2: TPDFFloat);overload;
+    Class Function Command(APos : TPDFCoord) : String; overload;
+    Class Function Command(x1, y1 : TPDFFloat) : String; overload;
+    Class Function Command(APos1, APos2 : TPDFCoord) : String; overload;
+    constructor Create(Const ADocument : TPDFDocument; const AWidth, X1,Y1, X2,Y2: TPDFFloat; const AStroke: Boolean = True); overload;
   end;
 
 
@@ -311,18 +418,33 @@ type
   end;
 
 
+  TPDFRoundedRectangle = class(TPDFDocumentObject)
+  private
+    FWidth: TPDFFloat;
+    FBottomLeft: TPDFCoord;
+    FDimensions: TPDFCoord;
+    FFill: Boolean;
+    FStroke: Boolean;
+    FRadius: TPDFFloat;
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; const APosX, APosY, AWidth, AHeight, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);overload;
+  end;
+
+
   TPDFCurveC = class(TPDFDocumentObject)
   private
-    FP1,FP2,FP3: TPDFCoord;
+    FCtrl1, FCtrl2, FTo: TPDFCoord;
     FWidth: TPDFFloat;
     FStroke: Boolean;
   protected
-    Class Function Command(Const X1,Y1,X2,Y2,X3,Y3 : TPDFFloat) : String; overload;
-    Class Function Command(Const AP1,AP2,AP3: TPDFCoord) : String; overload;
     procedure Write(const AStream: TStream); override;
   public
-    constructor Create(Const ADocument : TPDFDocument; const X1,Y1,X2,Y2,X3,Y3,AWidth : TPDFFloat;AStroke: Boolean = True);overload;
-    constructor Create(Const ADocument : TPDFDocument; const AP1,AP2,AP3 : TPDFCoord; AWidth: TPDFFloat; AStroke: Boolean = True);overload;
+    Class Function Command(Const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo: TPDFFloat): String; overload;
+    Class Function Command(Const ACtrl1, ACtrl2, ATo3: TPDFCoord): String; overload;
+    constructor Create(Const ADocument : TPDFDocument; const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo, AWidth: TPDFFloat; AStroke: Boolean = True);overload;
+    constructor Create(Const ADocument : TPDFDocument; const ACtrl1, ACtrl2, ATo3: TPDFCoord; AWidth: TPDFFloat; AStroke: Boolean = True);overload;
   end;
 
 
@@ -366,7 +488,7 @@ type
   end;
 
 
-  TPDFSurface = class(TPDFObject)
+  TPDFSurface = class(TPDFDocumentObject)
   private
     FPoints: TPDFCoordArray;
     FFill : Boolean;
@@ -390,14 +512,15 @@ type
   end;
 
 
-  TPDFLineStyle = class(TPDFObject)
+  TPDFLineStyle = class(TPDFDocumentObject)
   private
     FStyle: TPDFPenStyle;
     FPhase: integer;
+    FLineWidth: TPDFFloat;
   protected
     procedure Write(const AStream: TStream);override;
   public
-    constructor Create(Const ADocument : TPDFDocument; AStyle: TPDFPenStyle; APhase: integer); overload;
+    constructor Create(Const ADocument : TPDFDocument; AStyle: TPDFPenStyle; APhase: integer; ALineWidth: TPDFFloat); overload;
   end;
 
 
@@ -407,14 +530,17 @@ type
     FGreen: string;
     FBlue: string;
     FStroke: Boolean;
+    FColor: TARGBColor;
   protected
     procedure Write(const AStream: TStream);override;
   public
+    class function Command(const AStroke: boolean; const AColor: TARGBColor): string;
     constructor Create(Const ADocument : TPDFDocument; const AStroke: Boolean; AColor: TARGBColor); overload;
+    property    Color: TARGBColor read FColor;
   end;
 
 
-  TPDFDictionaryItem = class(TPDFObject)
+  TPDFDictionaryItem = class(TPDFDocumentObject)
   private
     FKey: TPDFName;
     FObj: TPDFObject;
@@ -457,7 +583,7 @@ type
   end;
 
 
-  TPDFXRef = class(TPDFObject)
+  TPDFXRef = class(TPDFDocumentObject)
   private
     FOffset: integer;
     FDict: TPDFDictionary;
@@ -497,21 +623,24 @@ type
     FOrientation: TPDFPaperOrientation;
     FPaper: TPDFPaper;
     FPaperType: TPDFPaperType;
-    FFontIndex: integer;
     FUnitOfMeasure: TPDFUnitOfMeasure;
     FMatrix: TPDFMatrix;
+    FAnnots: TPDFAnnotList;
+    FLastFont: TPDFEmbeddedFont;
+    FLastFontColor: TARGBColor;
     procedure CalcPaperSize;
     function GetO(AIndex : Integer): TPDFObject;
     function GetObjectCount: Integer;
+    function CreateAnnotList: TPDFAnnotList; virtual;
     procedure SetOrientation(AValue: TPDFPaperOrientation);
     procedure SetPaperType(AValue: TPDFPaperType);
     procedure AddTextToLookupLists(AText: UTF8String);
     procedure SetUnitOfMeasure(AValue: TPDFUnitOfMeasure);
-    procedure AdjustMatrix;
   protected
+    procedure AdjustMatrix; virtual;
     procedure DoUnitConversion(var APoint: TPDFCoord); virtual;
-    procedure CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; AFontIndex: integer); virtual;
-    procedure CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; AFontIndex: integer); virtual;
+    procedure CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); virtual;
+    procedure CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); virtual;
   Public
     Constructor Create(Const ADocument : TPDFDocument); override;
     Destructor Destroy; override;
@@ -520,47 +649,92 @@ type
     Procedure SetFont(AFontIndex : Integer; AFontSize : Integer); virtual;
     // used for stroking and nonstroking colors - purpose determined by the AStroke parameter
     Procedure SetColor(AColor : TARGBColor; AStroke : Boolean = True); virtual;
-    Procedure SetPenStyle(AStyle : TPDFPenStyle); virtual;
+    Procedure SetPenStyle(AStyle : TPDFPenStyle; const ALineWidth: TPDFFloat = 1.0); virtual;
+    // Set color and pen style from line style
+    Procedure SetLineStyle(AIndex : Integer; AStroke : Boolean = True); overload;
+    Procedure SetLineStyle(S : TPDFLineStyleDef; AStroke : Boolean = True); overload;
     { output coordinate is the font baseline. }
-    Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String); overload;
-    Procedure WriteText(APos: TPDFCoord; AText : UTF8String); overload;
-    procedure DrawLine(X1, Y1, X2, Y2, ALineWidth : TPDFFloat); overload;
-    procedure DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat); overload;
+    Procedure WriteText(X, Y: TPDFFloat; AText : UTF8String; const ADegrees: single = 0.0; const AUnderline: boolean = false; const AStrikethrough: boolean = false); overload;
+    Procedure WriteText(APos: TPDFCoord; AText : UTF8String; const ADegrees: single = 0.0; const AUnderline: boolean = false; const AStrikethrough: boolean = false); overload;
+    procedure DrawLine(X1, Y1, X2, Y2, ALineWidth : TPDFFloat; const AStroke: Boolean = True); overload;
+    procedure DrawLine(APos1, APos2: TPDFCoord; ALineWidth: TPDFFloat; const AStroke: Boolean = True); overload;
     Procedure DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer); overload;
-    Procedure DrawLineStyle(APos1: TPDFCoord; APos2: TPDFCoord; AStyle: Integer); overload;
+    Procedure DrawLineStyle(APos1, APos2: TPDFCoord; AStyle: Integer); overload;
+    { X, Y coordinates are the bottom-left coordinate of the rectangle. The W and H parameters are in the UnitOfMeasure units. }
+    Procedure DrawRect(const X, Y, W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean; const ADegrees: single = 0.0); overload;
+    Procedure DrawRect(const APos: TPDFCoord; const W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean; const ADegrees: single = 0.0); overload;
     { X, Y coordinates are the bottom-left coordinate of the rectangle. The W and H parameters are in the UnitOfMeasure units. }
-    Procedure DrawRect(const X, Y, W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean); overload;
-    Procedure DrawRect(const APos: TPDFCoord; const W, H, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean); overload;
+    procedure DrawRoundedRect(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke : Boolean; const ADegrees: single = 0.0);
     { X, Y coordinates are the bottom-left coordinate of the image. AWidth and AHeight are in image pixels. }
-    Procedure DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer); overload;
-    Procedure DrawImageRawSize(const APos: TPDFCoord; const APixelWidth, APixelHeight, ANumber: integer); overload;
+    Procedure DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer; const ADegrees: single = 0.0); overload;
+    Procedure DrawImageRawSize(const APos: TPDFCoord; const APixelWidth, APixelHeight, ANumber: integer; const ADegrees: single = 0.0); overload;
     { X, Y coordinates are the bottom-left coordinate of the image. AWidth and AHeight are in UnitOfMeasure units. }
-    Procedure DrawImage(const X, Y: TPDFFloat; const AWidth, AHeight: TPDFFloat; const ANumber: integer); overload;
-    Procedure DrawImage(const APos: TPDFCoord; const AWidth, AHeight: TPDFFloat; const ANumber: integer); overload;
+    Procedure DrawImage(const X, Y: TPDFFloat; const AWidth, AHeight: TPDFFloat; const ANumber: integer; const ADegrees: single = 0.0); overload;
+    Procedure DrawImage(const APos: TPDFCoord; const AWidth, AHeight: TPDFFloat; const ANumber: integer; const ADegrees: single = 0.0); overload;
     { X, Y coordinates are the bottom-left coordinate of the boundry rectangle.
       The W and H parameters are in the UnitOfMeasure units. A negative AWidth will
       cause the ellpise to draw to the left of the origin point. }
-    Procedure DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
-    Procedure DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True); overload;
+    Procedure DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True; const ADegrees: single = 0.0); overload;
+    Procedure DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean = True; AStroke: Boolean = True; const ADegrees: single = 0.0); overload;
+    procedure DrawPolygon(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
+    procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
+    { start a new subpath }
+    procedure ResetPath;
+    { Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
+    procedure ClosePath;
+    procedure ClosePathStroke;
+    { render the actual path }
+    procedure StrokePath;
+    { Fill using the nonzero winding number rule. }
+    procedure FillStrokePath;
+    { Fill using the Even-Odd rule. }
+    procedure FillEvenOddStrokePath;
+    { Move the current drawing position to (x, y) }
+    procedure MoveTo(x, y: TPDFFloat); overload;
+    procedure MoveTo(APos: TPDFCoord); overload;
+    { Append a cubic Bezier curve to the current path
+      - The curve extends from the current point to the point (xTo, yTo),
+        using (xCtrl1, yCtrl1) and (xCtrl2, yCtrl2) as the Bezier control points
+      - The new current point is (xTo, yTo) }
+    procedure CubicCurveTo(const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo, ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    procedure CubicCurveTo(ACtrl1, ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    { Append a cubic Bezier curve to the current path
+      - The curve extends from the current point to the point (xTo, yTo),
+        using the current point and (xCtrl2, yCtrl2) as the Bezier control points
+      - The new current point is (xTo, yTo) }
+    procedure CubicCurveToV(xCtrl2, yCtrl2, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    procedure CubicCurveToV(ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    { Append a cubic Bezier curve to the current path
+      - The curve extends from the current point to the point (xTo, yTo),
+        using (xCtrl1, yCtrl1) and (xTo, yTo) as the Bezier control points
+      - The new current point is (xTo, yTo) }
+    procedure CubicCurveToY(xCtrl1, yCtrl1, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    procedure CubicCurveToY(ACtrl1, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean = True); overload;
+    { Define a rectangle that becomes a clickable hotspot, referencing the URI argument. }
+    Procedure AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat; const AURI: string; ABorder: boolean = false);
     { This returns the paper height, converted to whatever UnitOfMeasure is set too }
     function GetPaperHeight: TPDFFloat;
     Function HasImages : Boolean;
     // Quick settings for Paper.
     Property PaperType : TPDFPaperType Read FPaperType Write SetPaperType default ptA4;
     Property Orientation : TPDFPaperOrientation Read FOrientation Write SetOrientation;
-    // Set this if you want custom paper size.
+    // Set this if you want custom paper size. You must set this before setting PaperType = ptCustom.
     Property Paper : TPDFPaper Read FPaper Write FPaper;
     // Unit of Measure - how the PDF Page should convert the coordinates and dimensions
     property UnitOfMeasure: TPDFUnitOfMeasure read FUnitOfMeasure write SetUnitOfMeasure default uomMillimeters;
     Property ObjectCount: Integer Read GetObjectCount;
     Property Objects[AIndex : Integer] : TPDFObject Read GetO; default;
-    // returns the last used FontIndex used in SetFont()
-    property FontIndex: integer read FFontIndex;
+    // returns the last font object created by SetFont()
+    property LastFont: TPDFEmbeddedFont read FLastFont;
     { A 3x3 matrix used to translate the PDF Cartesian coordinate system to an Image coordinate system. }
     property Matrix: TPDFMatrix read FMatrix write FMatrix;
+    property Annots: TPDFAnnotList read FAnnots;
   end;
 
 
+  TPDFPageClass = class of TPDFPage;
+
+
   TPDFSection = Class(TCollectionItem)
   private
     FTitle: String;
@@ -585,59 +759,29 @@ type
   end;
 
 
-  // forward declarations
-  TTextMapping = class;
-
-
-  TTextMappingList = class(TObject)
+  TPDFFont = class(TCollectionItem)
   private
-    FList: TFPObjectList;
-    function    GetCount: Integer;
-  protected
-    function    GetItem(AIndex: Integer): TTextMapping; reintroduce;
-    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); reintroduce;
-  public
-    constructor Create;
-    destructor  Destroy; override;
-    function    Add(AObject: TTextMapping): Integer; overload;
-    function    Add(const ACharID, AGlyphID: uint16): Integer; overload;
-    property    Count: Integer read GetCount;
-    property    Items[Index: Integer]: TTextMapping read GetItem write SetItem; default;
-  end;
-
-
-  TTextMapping = class(TObject)
-  private
-    FCharID: uint16;
-    FGlyphID: uint16;
-  public
-    class function NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
-    property    CharID: uint16 read FCharID write FCharID;
-    property    GlyphID: uint16 read FGlyphID write FGlyphID;
-  end;
-
-
-  TPDFFont = CLass(TCollectionItem)
-  private
-    FColor: TARGBColor;
     FIsStdFont: boolean;
     FName: String;
     FFontFilename: String;
     FTrueTypeFile: TTFFileInfo;
     { stores mapping of Char IDs to font Glyph IDs }
     FTextMappingList: TTextMappingList;
+    FSubsetFont: TStream;
     procedure   PrepareTextMapping;
     procedure   SetFontFilename(AValue: string);
+    procedure   GenerateSubsetFont;
   public
+    constructor Create(ACollection: TCollection); override;
     destructor  Destroy; override;
     { Returns a string where each character is replaced with a glyph index value instead. }
     function    GetGlyphIndices(const AText: UnicodeString): AnsiString;
     procedure   AddTextToMappingList(const AText: UnicodeString);
     Property    FontFile: string read FFontFilename write SetFontFilename;
     Property    Name: String Read FName Write FName;
-    Property    Color: TARGBColor Read FColor Write FColor;
     property    TextMapping: TTextMappingList read FTextMappingList;
     property    IsStdFont: boolean read FIsStdFont write FIsStdFont;
+    property    SubsetFont: TStream read FSubsetFont;
   end;
 
 
@@ -665,17 +809,52 @@ type
 
   TPDFPages = Class(TPDFDocumentObject)
   private
-    FList : TFPObjectList;
-    function GetP(AIndex : Integer): TPDFPage;
+    FList: TFPObjectList;
+    FPageClass: TPDFPageClass;
+    function    GetP(AIndex: Integer): TPDFPage;
+    function    GetPageCount: integer;
   public
-    Destructor Destroy; override;
-    Function AddPage : TPDFPage;
-    procedure Add(APage: TPDFPage);
-    Property Pages[AIndex : Integer] : TPDFPage Read GetP; Default;
+    constructor Create(const ADocument: TPDFDocument); override; overload;
+    destructor  Destroy; override;
+    function    AddPage: TPDFPage;
+    procedure   Add(APage: TPDFPage);
+    property    Count: integer read GetPageCount;
+    property    Pages[AIndex: Integer]: TPDFPage read GetP; default;
+    property    PageClass: TPDFPageClass read FPageClass write FPageClass;
+  end;
+
+
+  TPDFAnnot = class(TPDFObject)
+  private
+    FLeft: TPDFFloat;
+    FBottom: TPDFFloat;
+    FWidth: TPDFFloat;
+    FHeight: TPDFFloat;
+    FURI: string;
+    FBorder: boolean;
+  public
+    constructor Create(const ADocument: TPDFDocument); override; overload;
+    constructor Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat; const AURI: String; const ABorder: Boolean = false); overload;
+  end;
+
+
+  TPDFAnnotList = class(TPDFDocumentObject)
+  private
+    FList: TFPObjectList;
+    procedure   CheckList;
+    function    GetAnnot(AIndex: integer): TPDFAnnot;
+  public
+    destructor  Destroy; override;
+    function    AddAnnot: TPDFAnnot;
+    function    Count: integer;
+    procedure   Add(AAnnot: TPDFAnnot);
+    property    Annots[AIndex: integer]: TPDFAnnot read GetAnnot; default;
   end;
 
+
   TPDFImageCompression = (icNone, icDeflate, icJPEG);
 
+
   TPDFImageItem = Class(TCollectionItem)
   private
     FImage: TFPCustomImage;
@@ -701,8 +880,6 @@ type
   end;
 
 
-  { TPDFImages }
-
   TPDFImages = Class(TCollection)
   Private
     FOwner: TPDFDocument;
@@ -721,14 +898,30 @@ type
   end;
 
 
-  TPDFToUnicode = class(TPDFDocumentObject)
-  private
-    FEmbeddedFontNum: integer;
+  TPDFFontNumBaseObject = class(TPDFDocumentObject)
   protected
-    procedure Write(const AStream: TStream);override;
+    FFontNum: integer;
   public
-    constructor Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer); overload;
-    property EmbeddedFontNum: integer read FEmbeddedFontNum;
+    constructor Create(const ADocument: TPDFDocument; const AFontNum: integer); overload;
+    property FontNum: integer read FFontNum;
+  end;
+
+
+  TPDFToUnicode = class(TPDFFontNumBaseObject)
+  protected
+    procedure Write(const AStream: TStream); override;
+  end;
+
+
+  TCIDToGIDMap = class(TPDFFontNumBaseObject)
+  protected
+    procedure Write(const AStream: TStream); override;
+  end;
+
+
+  TPDFCIDSet = class(TPDFFontNumBaseObject)
+  protected
+    procedure Write(const AStream: TStream); override;
   end;
 
 
@@ -737,6 +930,8 @@ type
     FColor: TARGBColor;
     FLineWidth: TPDFFloat;
     FPenStyle: TPDFPenStyle;
+  Public
+    Procedure Assign(Source : TPersistent); override;
   Published
     Property LineWidth : TPDFFloat Read FLineWidth Write FLineWidth;
     Property Color : TARGBColor Read FColor Write FColor Default clBlack;
@@ -753,15 +948,13 @@ type
   end;
 
 
-  { TPDFDocument }
-
   TPDFDocument = class(TComponent)
   private
     FCatalogue: integer;
     FCurrentColor: string;
     FCurrentWidth: string;
     FDefaultOrientation: TPDFPaperOrientation;
-    FDefaultPaperType: TPDFPaperTYpe;
+    FDefaultPaperType: TPDFPaperType;
     FFontDirectory: string;
     FFontFiles: TStrings;
     FFonts: TPDFFontDefs;
@@ -777,8 +970,12 @@ type
     FTrailer: TPDFDictionary;
     FZoomValue: string;
     FGlobalXRefs: TFPObjectList; // list of TPDFXRef
+    FUnitOfMeasure: TPDFUnitOfMeasure;
+    function GetStdFontCharWidthsArray(const AFontName: string): TPDFFontWidthArray;
     function GetX(AIndex : Integer): TPDFXRef;
     function GetXC: Integer;
+    function GetTotalAnnotsCount: integer;
+    function GetFontNamePrefix(const AFontNum: Integer): string;
     procedure SetFontFiles(AValue: TStrings);
     procedure SetFonts(AValue: TPDFFontDefs);
     procedure SetInfos(AValue: TPDFInfos);
@@ -802,7 +999,8 @@ type
     procedure CreateTrailer;virtual;
     procedure CreateFontEntries; virtual;
     procedure CreateImageEntries; virtual;
-    function CreateContentsEntry: integer;virtual;
+    procedure CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary); virtual;
+    function CreateContentsEntry(const APageNum: integer): integer;virtual;
     function CreateCatalogEntry: integer;virtual;
     procedure CreateInfoEntry;virtual;
     procedure CreatePreferencesEntry;virtual;
@@ -817,9 +1015,12 @@ type
     procedure CreateTTFCIDSystemInfo;virtual;
     procedure CreateTp1Font(const EmbeddedFontNum: integer);virtual;
     procedure CreateFontDescriptor(const EmbeddedFontNum: integer);virtual;
-    procedure CreateToUnicode(const EmbeddedFontNum: integer);virtual;
-    procedure CreateFontFileEntry(const EmbeddedFontNum: integer);virtual;
+    procedure CreateToUnicode(const AFontNum: integer);virtual;
+    procedure CreateFontFileEntry(const AFontNum: integer);virtual;
+    procedure CreateCIDSet(const AFontNum: integer); virtual;
     procedure CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);virtual;
+    function CreateAnnotEntry(const APageNum, AnnotNum: integer): integer; virtual;
+    function CreateCIDToGIDMap(const AFontNum: integer): integer; virtual;
     procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
     Function CreateString(Const AValue : String) : TPDFString;
     Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
@@ -834,33 +1035,33 @@ type
     Property CurrentWidth: string Read FCurrentWidth Write FCurrentWidth;
   public
     constructor Create(AOwner : TComponent); override;
-    procedure StartDocument;
     destructor Destroy; override;
-    procedure SaveToStream(const AStream: TStream);
+    procedure StartDocument;
+    procedure Reset;
+    procedure SaveToStream(const AStream: TStream); virtual;
+    Procedure SaveToFile(Const AFileName : String);
+    function  IsStandardPDFFont(AFontName: string): boolean;
     // Create objects, owned by this document.
-    Function CreateEmbeddedFont(AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
-    Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFontIndex: integer) : TPDFText; overload;
-    Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFontIndex: integer) : TPDFUTF8Text; overload;
+    Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
+    Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFText; overload;
+    Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF8Text; overload;
     Function CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean) : TPDFRectangle;
+    function CreateRoundedRectangle(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRoundedRectangle;
     Function CreateColor(AColor : TARGBColor; AStroke : Boolean) : TPDFColor;
     Function CreateBoolean(AValue : Boolean) : TPDFBoolean;
     Function CreateInteger(AValue : Integer) : TPDFInteger;
     Function CreateReference(AValue : Integer) : TPDFReference;
-    Function CreateLineStyle(APenStyle: TPDFPenStyle) : TPDFLineStyle;
+    Function CreateLineStyle(APenStyle: TPDFPenStyle; const ALineWidth: TPDFFloat) : TPDFLineStyle;
     Function CreateName(AValue : String; const AMustEscape: boolean = True) : TPDFName;
     Function CreateStream(OwnsObjects : Boolean = True) : TPDFStream;
     Function CreateDictionary : TPDFDictionary;
     Function CreateXRef : TPDFXRef;
     Function CreateArray : TPDFArray;
     Function CreateImage(const ALeft, ABottom, AWidth, AHeight: TPDFFloat; ANumber: integer) : TPDFImage;
-    Function AddFont(AName : String; AColor : TARGBColor = clBlack) : Integer; overload;
-    Function AddFont(AFontFile: String; AName : String; AColor : TARGBColor = clBlack) : Integer; overload;
+    Function AddFont(AName : String) : Integer; overload;
+    Function AddFont(AFontFile: String; AName : String) : Integer; overload;
     Function AddLineStyleDef(ALineWidth : TPDFFloat; AColor : TARGBColor = clBlack; APenStyle : TPDFPenStyle = ppsSolid) : Integer;
-    Property Options : TPDFOptions Read FOptions Write FOPtions;
-    property PageLayout: TPDFPageLayout read FPageLayout write FPageLayout default lSingle;
-    Property Infos : TPDFInfos Read FInfos Write SetInfos;
     Property Fonts : TPDFFontDefs Read FFonts Write SetFonts;
-    Property LineStyles : TPDFLineStyleDefs Read FLineStyleDefs Write SetLineStyles;
     Property Pages : TPDFPages Read FPages;
     Property Images : TPDFImages Read FImages;
     Property Catalogue: integer Read FCatalogue;
@@ -868,9 +1069,16 @@ type
     Property FontFiles : TStrings Read FFontFiles Write SetFontFiles;
     Property FontDirectory: string Read FFontDirectory Write FFontDirectory;
     Property Sections : TPDFSectionList Read FSections;
+    Property ObjectCount : Integer Read FObjectCount;
+  Published
+    Property Options : TPDFOptions Read FOptions Write FOPtions;
+    Property LineStyles : TPDFLineStyleDefs Read FLineStyleDefs Write SetLineStyles;
+    property PageLayout: TPDFPageLayout read FPageLayout write FPageLayout default lSingle;
+    Property Infos : TPDFInfos Read FInfos Write SetInfos;
     Property DefaultPaperType : TPDFPaperTYpe Read FDefaultPaperType Write FDefaultPaperType;
     Property DefaultOrientation : TPDFPaperOrientation Read FDefaultOrientation Write FDefaultOrientation;
-    Property ObjectCount : Integer Read FObjectCount;
+    property DefaultUnitOfMeasure: TPDFUnitOfMeasure read FUnitOfMeasure write FUnitOfMeasure default uomMillimeters;
+
   end;
 
 
@@ -924,46 +1132,54 @@ procedure CompressString(const AFrom: string; var ATo: string);
 procedure DecompressStream(AFrom: TStream; ATo: TStream);
 
 function mmToPDF(mm: single): TPDFFloat;
+function PDFTomm(APixels : TPDFFloat) : Single;
 function cmToPDF(cm: single): TPDFFloat;
+function PDFtoCM(APixels: TPDFFloat): single;
 function InchesToPDF(Inches: single): TPDFFloat;
+function PDFtoInches(APixels: TPDFFloat): single;
 
 function PDFCoord(x, y: TPDFFloat): TPDFCoord;
 
 implementation
 
+uses
+  math,
+  fpttf;
+
 
-Resourcestring
+resourcestring
   rsErrReportFontFileMissing = 'Font File "%s" does not exist.';
-  SErrDictElementNotFound = 'Error: Dictionary element "%s" not found.';
-  SerrInvalidSectionPage = 'Error: Invalid section page index.';
-  SErrNoGlobalDict = 'Error: no global XRef named "%s".';
-  SErrInvalidPageIndex = 'Invalid page index: %d';
-  SErrNoFontIndex = 'No FontIndex was set - please use SetFont() first.';
+  rsErrDictElementNotFound = 'Error: Dictionary element "%s" not found.';
+  rsErrInvalidSectionPage = 'Error: Invalid section page index.';
+  rsErrNoGlobalDict = 'Error: no global XRef named "%s".';
+  rsErrInvalidPageIndex = 'Invalid page index: %d';
+  rsErrInvalidAnnotIndex = 'Invalid annot index: %d';
+  rsErrNoFontDefined = 'No Font was set - please use SetFont() first.';
+  rsErrNoImageReader = 'Unsupported image format - no image reader available.';
+  rsErrUnknownStdFont = 'Unknown standard PDF font name <%s>.';
+
+{ Includes font metrics constant arrays for the standard PDF fonts. They are
+  not used at the moment, but in future we might want to do something with
+  them. }
+{$I fontmetrics_stdpdf.inc }
 
 type
   // to get access to protected methods
   TTTFFriendClass = class(TTFFileInfo)
   end;
 
-Const
-  // TODO: we should improve this to take into account the line width
-  cPenStyleBitmasks: array[TPDFPenStyle] of string = (
-    '',               // ppsSolid
-    '5 3',            // ppsDash (dash space ...)
-    '1 3',            // ppsDot (dot space ...)
-    '5 3 1 3',        // ppsDashDot (dash space dot space ...)
-    '5 3 1 3 1 3'     // ppsDashDotDot (dash space dot space dot space ...)
-    );
 
 const
   cInchToMM = 25.4;
   cInchToCM = 2.54;
   cDefaultDPI = 72;
-
   // mm = (pixels * 25.4) / dpi
   // pixels = (mm * dpi) / 25.4
   // cm = ((pixels * 25.4) / dpi) / 10
 
+  // see http://paste.lisp.org/display/1105
+  BEZIER: single = 0.5522847498; // = 4/3 * (sqrt(2) - 1);
+
 
 function DateToPdfDate(const ADate: TDateTime): string;
 begin
@@ -1076,7 +1292,7 @@ begin
   Result := mm * (cDefaultDPI / cInchToMM);
 end;
 
-function PDFtoMM(APixels: TPDFFloat): single;
+function PDFTomm(APixels: TPDFFloat): Single;
 begin
   Result := (APixels * cInchToMM) / cDefaultDPI;
 end;
@@ -1107,14 +1323,6 @@ begin
   Result := APixels / cDefaultDPI;
 end;
 
-{ TPDFInfos }
-
-constructor TPDFInfos.Create;
-begin
-  inherited Create;
-  FProducer := 'fpGUI Toolkit 0.8';
-end;
-
 { TPDFMatrix }
 
 function TPDFMatrix.Transform(APoint: TPDFCoord): TPDFCoord;
@@ -1155,68 +1363,6 @@ begin
   _21 := AValue;
 end;
 
-{ TTextMappingList }
-
-function TTextMappingList.GetCount: Integer;
-begin
-  Result := FList.Count;
-end;
-
-function TTextMappingList.GetItem(AIndex: Integer): TTextMapping;
-begin
-  Result := TTextMapping(FList.Items[AIndex]);
-end;
-
-procedure TTextMappingList.SetItem(AIndex: Integer; AValue: TTextMapping);
-begin
-  FList.Items[AIndex] := AValue;
-end;
-
-constructor TTextMappingList.Create;
-begin
-  FList := TFPObjectList.Create;
-end;
-
-destructor TTextMappingList.Destroy;
-begin
-  FList.Free;
-  inherited Destroy;
-end;
-
-function TTextMappingList.Add(AObject: TTextMapping): Integer;
-var
-  i: integer;
-begin
-  Result := -1;
-  for i := 0 to FList.Count-1 do
-  begin
-    if TTextMapping(FList.Items[i]).CharID = AObject.CharID then
-      Exit; // mapping already exists
-  end;
-  Result := FList.Add(AObject);
-end;
-
-function TTextMappingList.Add(const ACharID, AGlyphID: uint16): Integer;
-var
-  o: TTextMapping;
-begin
-  o := TTextMapping.Create;
-  o.CharID := ACharID;
-  o.GlyphID := AGlyphID;
-  Result := Add(o);
-  if Result = -1 then
-    o.Free;
-end;
-
-{ TTextMapping }
-
-class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
-begin
-  Result := TTextMapping.Create;
-  Result.CharID := ACharID;
-  Result.GlyphID := AGlyphID;
-end;
-
 { TPDFFont }
 
 procedure TPDFFont.PrepareTextMapping;
@@ -1239,10 +1385,41 @@ begin
   PrepareTextMapping;
 end;
 
+procedure TPDFFont.GenerateSubsetFont;
+var
+  f: TFontSubsetter;
+  {$ifdef gdebug}
+  fs: TFileStream;
+  {$endif}
+begin
+  if Assigned(FSubsetFont) then
+    FreeAndNil(FSubSetFont);
+  f := TFontSubsetter.Create(FTrueTypeFile, FTextMappingList);
+  try
+    FSubSetFont := TMemoryStream.Create;
+    f.SaveToStream(FSubsetFont);
+    {$ifdef gdebug}
+    fs := TFileStream.Create(FTrueTypeFile.PostScriptName + '-subset.ttf', fmCreate);
+    FSubSetFont.Position := 0;
+    TMemoryStream(FSubsetFont).SaveToStream(fs);
+    fs.Free;
+    {$endif}
+  finally
+    f.Free;
+  end;
+end;
+
+constructor TPDFFont.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FSubsetFont := nil;
+end;
+
 destructor TPDFFont.Destroy;
 begin
   FTextMappingList.Free;
   FTrueTypeFile.Free;
+  FSubSetFont.Free;
   inherited Destroy;
 end;
 
@@ -1250,6 +1427,7 @@ function TPDFFont.GetGlyphIndices(const AText: UnicodeString): AnsiString;
 var
   i: integer;
   c: word;
+  n: integer;
 begin
   Result := '';
   if Length(AText) = 0 then
@@ -1257,7 +1435,14 @@ begin
   for i := 1 to Length(AText) do
   begin
     c := Word(AText[i]);
-    Result := Result + IntToHex(FTrueTypeFile.GetGlyphIndex(c), 4);
+    for n := 0 to FTextMappingList.Count-1 do
+    begin
+      if FTextMappingList[n].CharID = c then
+      begin
+        result := Result + IntToHex(FTextMappingList[n].GlyphID, 4);
+        break;
+      end;
+    end;
   end;
 end;
 
@@ -1265,18 +1450,22 @@ procedure TPDFFont.AddTextToMappingList(const AText: UnicodeString);
 var
   i: integer;
   c: uint16; // Unicode codepoint
+  gid: uint16;
 begin
   if AText = '' then
     Exit;
   for i := 1 to Length(AText) do
   begin
     c := uint16(AText[i]);
-    FTextMappingList.Add(c, FTrueTypeFile.GetGlyphIndex(c));
+    gid := FTrueTypeFile.GetGlyphIndex(c);
+    FTextMappingList.Add(c, gid);
   end;
 end;
 
 { TPDFTrueTypeCharWidths }
 
+// TODO: (optional improvement) CID -> Unicode mappings, use ranges to generate a smaller CMap
+//       See pdfbox's writeTo() method in ToUnicodeWriter.java
 procedure TPDFTrueTypeCharWidths.Write(const AStream: TStream);
 var
   i: integer;
@@ -1286,7 +1475,9 @@ var
 begin
   s := '';
   lst := Document.Fonts[EmbeddedFontNum].TextMapping;
+  lst.Sort;
   lFont := Document.Fonts[EmbeddedFontNum].FTrueTypeFile;
+  // use decimal values for the output
   for i := 0 to lst.Count-1 do
     s :=  s + Format(' %d [%d]', [ lst[i].GlyphID, TTTFFriendClass(lFont).ToNatural(lFont.Widths[lst[i].GlyphID].AdvanceWidth)]);
   WriteString(s, AStream);
@@ -1331,6 +1522,66 @@ begin
   FPos:=APos;
 end;
 
+{ TPDFResetPath }
+
+procedure TPDFResetPath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFResetPath.Command: string;
+begin
+  Result := 'n' + CRLF;
+end;
+
+{ TPDFClosePath }
+
+procedure TPDFClosePath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFClosePath.Command: string;
+begin
+  Result := 'h' + CRLF;
+end;
+
+{ TPDFStrokePath }
+
+procedure TPDFStrokePath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFStrokePath.Command: string;
+begin
+  Result := 'S' + CRLF;
+end;
+
+{ TPDFPushGraphicsStack }
+
+procedure TPDFPushGraphicsStack.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFPushGraphicsStack.Command: string;
+begin
+  Result := 'q'+CRLF;
+end;
+
+{ TPDFPopGraphicsStack }
+
+procedure TPDFPopGraphicsStack.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFPopGraphicsStack.Command: string;
+begin
+  Result := 'Q' + CRLF;
+end;
+
 { TPDFEllipse }
 
 procedure TPDFEllipse.Write(const AStream: TStream);
@@ -1344,8 +1595,8 @@ begin
   Y:=FCenter.Y;
   W2:=FDimensions.X/2;
   H2:=FDimensions.Y/2;
-  WS:=W2*11/20;
-  HS:=H2*11/20;
+  WS:=W2*BEZIER;
+  HS:=H2*BEZIER;
   // Starting point
   WriteString(TPDFMoveTo.Command(X,Y+H2),AStream);
   WriteString(TPDFCurveC.Command(X, Y+H2-HS, X+W2-WS, Y, X+W2, Y),AStream);
@@ -1452,51 +1703,72 @@ end;
 
 { TPDFCurveC }
 
-class function TPDFCurveC.Command(const X1, Y1, X2, Y2, X3, Y3: TPDFFloat
-  ): String;
+class function TPDFCurveC.Command(const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo: TPDFFloat): String;
 begin
-  Result:=FloatStr(X1)+' '+FloatStr(Y1)+' '+
-          FloatStr(X2)+' '+FloatStr(Y2)+' '+
-          FloatStr(X3)+' '+FloatStr(Y3)+' c'+CRLF
+  Result:=FloatStr(xCtrl1)+' '+FloatStr(yCtrl1)+' '+
+          FloatStr(xCtrl2)+' '+FloatStr(yCtrl2)+' '+
+          FloatStr(xTo)+' '+FloatStr(yTo)+' c'+CRLF
 end;
 
-class function TPDFCurveC.Command(const AP1, AP2, AP3: TPDFCoord): String;
+class function TPDFCurveC.Command(const ACtrl1, ACtrl2, ATo3: TPDFCoord): String;
 begin
-  Result:=Command(AP1.X,AP1.Y,AP2.X,AP2.Y,AP3.X,AP3.Y);
+  Result := Command(ACtrl1.X, ACtrl1.Y, ACtrl2.X, ACtrl2.Y, ATo3.X, ATo3.Y);
 end;
 
 procedure TPDFCurveC.Write(const AStream: TStream);
 begin
   if FStroke then
-    SetWidth(FWidth,AStream);
-  WriteString(Command(FP1,FP2,FP3),AStream);
+    SetWidth(FWidth, AStream);
+  WriteString(Command(FCtrl1, FCtrl2, FTo), AStream);
   if FStroke then
     WriteString('S'+CRLF, AStream);
 end;
 
-constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const X1, Y1, X2, Y2, X3, Y3,AWidth: TPDFFloat;AStroke: Boolean = True);
+constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo,
+  AWidth: TPDFFloat; AStroke: Boolean);
 begin
   Inherited Create(ADocument);
-  FP1.X:=X1;
-  FP1.Y:=Y1;
-  FP2.X:=X2;
-  FP2.Y:=Y2;
-  FP3.X:=X3;
-  FP3.Y:=Y3;
-  FWidth:=AWidth;
-  FStroke:=AStroke;
+  FCtrl1.X := xCtrl1;
+  FCtrl1.Y := yCtrl1;
+  FCtrl2.X := xCtrl2;
+  FCtrl2.Y := yCtrl2;
+  FTo.X := xTo;
+  FTo.Y := yTo;
+  FWidth := AWidth;
+  FStroke := AStroke;
 end;
 
-constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const AP1, AP2, AP3: TPDFCoord; AWidth: TPDFFloat;AStroke: Boolean = True);
+constructor TPDFCurveC.Create(const ADocument: TPDFDocument; const ACtrl1, ACtrl2, ATo3: TPDFCoord;
+    AWidth: TPDFFloat; AStroke: Boolean);
 begin
   Inherited Create(ADocument);
-  FP1:=AP1;
-  FP2:=AP2;
-  FP3:=AP3;
-  FWidth:=AWidth;
-  FStroke:=AStroke;
+  FCtrl1 := ACtrl1;
+  FCtrl2 := ACtrl2;
+  FTo := ATo3;
+  FWidth := AWidth;
+  FStroke := AStroke;
 end;
 
+{ TPDFLineStyleDef }
+
+Procedure TPDFLineStyleDef.Assign(Source : TPersistent);
+
+Var
+ L : TPDFLineStyleDef;
+
+begin
+  if Source is TPDFLineStyleDef then
+    begin
+    L:=Source as TPDFLineStyleDef;
+    LineWidth:=L.LineWidth;
+    Color:=L.Color;
+    PenStyle:=L.PenStyle;
+    end
+  else
+    Inherited;
+end;
+
+
 { TPDFLineStyleDefs }
 
 function TPDFLineStyleDefs.GetI(AIndex : Integer): TPDFLineStyleDef;
@@ -1516,7 +1788,18 @@ begin
   if Assigned(Flist) then
     Result:=TPDFPage(FList[Aindex])
   else
-    Raise EListError.CreateFmt(SErrInvalidPageIndex,[AIndex]);
+    Raise EListError.CreateFmt(rsErrInvalidPageIndex,[AIndex]);
+end;
+
+function TPDFPages.GetPageCount: integer;
+begin
+  result := FList.Count;
+end;
+
+constructor TPDFPages.Create(const ADocument: TPDFDocument);
+begin
+  inherited Create(ADocument);
+  FPageClass := TPDFPage;
 end;
 
 destructor TPDFPages.Destroy;
@@ -1529,7 +1812,7 @@ function TPDFPages.AddPage: TPDFPage;
 begin
   if (FList=Nil) then
     FList:=TFPObjectList.Create;
-  Result:=TPDFPage.Create(Document);
+  Result := PageClass.Create(Document);
   FList.Add(Result);
 end;
 
@@ -1540,6 +1823,69 @@ begin
   FList.Add(APage);
 end;
 
+{ TPDFAnnot }
+
+constructor TPDFAnnot.Create(const ADocument: TPDFDocument);
+begin
+  inherited Create(ADocument);
+end;
+
+constructor TPDFAnnot.Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat;
+  const AURI: String; const ABorder: Boolean);
+begin
+  Create(ADocument);
+  FLeft := ALeft;
+  FBottom := ABottom;
+  FWidth := AWidth;
+  FHeight := AHeight;
+  FURI := AURI;
+  FBorder := ABorder;
+end;
+
+{ TPDFAnnotList }
+
+procedure TPDFAnnotList.CheckList;
+begin
+  if (FList = nil) then
+    FList := TFPObjectList.Create;
+end;
+
+function TPDFAnnotList.GetAnnot(AIndex: integer): TPDFAnnot;
+begin
+  if Assigned(FList) then
+    Result := TPDFAnnot(FList[AIndex])
+  else
+    raise EListError.CreateFmt(rsErrInvalidAnnotIndex, [AIndex]);
+end;
+
+destructor TPDFAnnotList.Destroy;
+begin
+  FreeAndNil(FList);
+  inherited Destroy;
+end;
+
+function TPDFAnnotList.AddAnnot: TPDFAnnot;
+begin
+  CheckList;
+  Result := TPDFAnnot.Create(Document);
+  FList.Add(Result);
+end;
+
+function TPDFAnnotList.Count: integer;
+begin
+  if Assigned(FList) then
+    result := FList.Count
+  else
+    result := 0;
+end;
+
+procedure TPDFAnnotList.Add(AAnnot: TPDFAnnot);
+begin
+  CheckList;
+  FList.Add(AAnnot);
+end;
+
+
 { TPDFPage }
 
 function TPDFPage.GetO(AIndex : Integer): TPDFObject;
@@ -1555,6 +1901,11 @@ begin
     Result:=FObjects.Count;
 end;
 
+function TPDFPage.CreateAnnotList: TPDFAnnotList;
+begin
+  result := TPDFAnnotList.Create(Document);
+end;
+
 procedure TPDFPage.SetOrientation(AValue: TPDFPaperOrientation);
 begin
   if FOrientation=AValue then Exit;
@@ -1601,7 +1952,7 @@ begin
   if AText = '' then
     Exit;
   str := UTF8Decode(AText);
-  Document.Fonts[FFontIndex].AddTextToMappingList(str);
+  Document.Fonts[FLastFont.FontIndex].AddTextToMappingList(str);
 end;
 
 procedure TPDFPage.DoUnitConversion(var APoint: TPDFCoord);
@@ -1625,20 +1976,22 @@ begin
   end;
 end;
 
-procedure TPDFPage.CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; AFontIndex: integer);
+procedure TPDFPage.CreateStdFontText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont;
+  const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
 var
   T: TPDFText;
 begin
-  T := Document.CreateText(X, Y, AText, AFontIndex);
+  T := Document.CreateText(X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
   AddObject(T);
 end;
 
-procedure TPDFPage.CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; AFontIndex: integer);
+procedure TPDFPage.CreateTTFFontText(X, Y: TPDFFloat; AText: UTF8String; const AFont: TPDFEmbeddedFont;
+  const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
 var
   T: TPDFUTF8Text;
 begin
   AddTextToLookupLists(AText);
-  T := Document.CreateText(X, Y, AText, FFontIndex);
+  T := Document.CreateText(X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
   AddObject(T);
 end;
 
@@ -1652,13 +2005,23 @@ end;
 
 procedure TPDFPage.AdjustMatrix;
 begin
-  FMatrix._21 := GetPaperHeight;
+  if poPageOriginAtTop in Document.Options then
+  begin
+    FMatrix._11 := -1;
+    FMatrix._21 := GetPaperHeight;
+  end
+  else
+  begin
+    FMatrix._11 := 1;
+    FMatrix._21 := 0;
+  end;
 end;
 
 constructor TPDFPage.Create(const ADocument: TPDFDocument);
 begin
   inherited Create(ADocument);
-  FFontIndex := -1;
+  FLastFont := nil;
+  FLastFontColor := clBlack;
   FPaperType := ptA4;
   FUnitOfMeasure := uomMillimeters;
   CalcPaperSize;
@@ -1666,17 +2029,20 @@ begin
   begin
     PaperType := ADocument.DefaultPaperType;
     Orientation := ADocument.DefaultOrientation;
+    FUnitOfMeasure:=ADocument.DefaultUnitOfMeasure;
   end;
 
   FMatrix._00 := 1;
   FMatrix._20 := 0;
-  FMatrix._11 := -1;  // flip coordinates
-  AdjustMatrix;       // sets FMatrix._21 value
+  AdjustMatrix;
+
+  FAnnots := CreateAnnotList;
 end;
 
 destructor TPDFPage.Destroy;
 begin
   FreeAndNil(FObjects);
+  FreeAndNil(FAnnots);
   inherited Destroy;
 end;
 
@@ -1688,56 +2054,65 @@ begin
 end;
 
 procedure TPDFPage.SetFont(AFontIndex: Integer; AFontSize: Integer);
-
 Var
   F : TPDFEmbeddedFont;
-
 begin
-  F:=Document.CreateEmbeddedFont(AFontIndex,AFontSize);
+  F:=Document.CreateEmbeddedFont(self, AFontIndex, AFontSize);
   AddObject(F);
-  FFontIndex := AFontIndex;
+  FLastFont := F;
 end;
 
 procedure TPDFPage.SetColor(AColor: TARGBColor; AStroke : Boolean = True);
-
 Var
   C : TPDFColor;
-
 begin
   C:=Document.CreateColor(AColor,AStroke);
+  if not AStroke then
+    FLastFontColor := AColor;
   AddObject(C);
 end;
 
-procedure TPDFPage.SetPenStyle(AStyle: TPDFPenStyle);
-
+procedure TPDFPage.SetPenStyle(AStyle: TPDFPenStyle; const ALineWidth: TPDFFloat);
 Var
   L : TPDFLineStyle;
-
 begin
-  L:=Document.CreateLineStyle(AStyle);
+  L:=Document.CreateLineStyle(AStyle, ALineWidth);
   AddObject(L);
 end;
 
-procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String);
+procedure TPDFPage.SetLineStyle(AIndex: Integer; AStroke : Boolean = True);
+begin
+  SetLineStyle(Document.LineStyles[Aindex],AStroke);
+end;
+
+procedure TPDFPage.SetLineStyle(S: TPDFLineStyleDef; AStroke: Boolean = True);
+begin
+  SetColor(S.Color,AStroke);
+  SetPenStyle(S.PenStyle,S.LineWidth);
+end;
+
+procedure TPDFPage.WriteText(X, Y: TPDFFloat; AText: UTF8String; const ADegrees: single;
+    const AUnderline: boolean; const AStrikethrough: boolean);
 var
   p: TPDFCoord;
 begin
-  if FFontIndex = -1 then
-    raise EPDF.Create(SErrNoFontIndex);
+  if not Assigned(FLastFont) then
+    raise EPDF.Create(rsErrNoFontDefined);
   p := Matrix.Transform(X, Y);
   DoUnitConversion(p);
-  if Document.Fonts[FFontIndex].IsStdFont then
-    CreateStdFontText(p.X, p.Y, AText, FFontIndex)
+  if Document.Fonts[FLastFont.FontIndex].IsStdFont then
+    CreateStdFontText(p.X, p.Y, AText, FLastFont, ADegrees, AUnderline, AStrikeThrough)
   else
-    CreateTTFFontText(p.X, p.Y, AText, FFontIndex);
+    CreateTTFFontText(p.X, p.Y, AText, FLastFont, ADegrees, AUnderline, AStrikeThrough);
 end;
 
-procedure TPDFPage.WriteText(APos: TPDFCoord; AText: UTF8String);
+procedure TPDFPage.WriteText(APos: TPDFCoord; AText: UTF8String; const ADegrees: single;
+    const AUnderline: boolean; const AStrikethrough: boolean);
 begin
-  WriteText(APos.X, APos.Y, AText);
+  WriteText(APos.X, APos.Y, AText, ADegrees, AUnderline, AStrikeThrough);
 end;
 
-procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat);
+procedure TPDFPage.DrawLine(X1, Y1, X2, Y2, ALineWidth: TPDFFloat; const AStroke: Boolean = True);
 var
   L : TPDFLineSegment;
   p1, p2: TPDFCoord;
@@ -1746,13 +2121,14 @@ begin
   p2 := Matrix.Transform(X2, Y2);
   DoUnitConversion(p1);
   DoUnitConversion(p2);
-  L := TPDFLineSegment.Create(Document, ALineWidth, p1.X, p1.Y, p2.X, p2.Y);
+  L := TPDFLineSegment.Create(Document, ALineWidth, p1.X, p1.Y, p2.X, p2.Y, AStroke);
   AddObject(L);
 end;
 
-procedure TPDFPage.DrawLine(APos1: TPDFCoord; APos2: TPDFCoord; ALineWidth: TPDFFloat);
+procedure TPDFPage.DrawLine(APos1, APos2: TPDFCoord; ALineWidth: TPDFFloat;
+  const AStroke: Boolean);
 begin
-  DrawLine(APos1.X, APos1.Y, APos2.X, APos2.Y, ALineWidth);
+  DrawLine(APos1.X, APos1.Y, APos2.X, APos2.Y, ALineWidth, AStroke);
 end;
 
 procedure TPDFPage.DrawLineStyle(X1, Y1, X2, Y2: TPDFFloat; AStyle: Integer);
@@ -1760,83 +2136,327 @@ var
   S: TPDFLineStyleDef;
 begin
   S := Document.LineStyles[AStyle];
-  SetColor(S.Color, True);
-  SetPenStyle(S.PenStyle);
+  SetLineStyle(S);
   DrawLine(X1, Y1, X2, Y2, S.LineWidth);
 end;
 
-procedure TPDFPage.DrawLineStyle(APos1: TPDFCoord; APos2: TPDFCoord; AStyle: Integer);
+procedure TPDFPage.DrawLineStyle(APos1, APos2: TPDFCoord; AStyle: Integer);
 begin
   DrawLineStyle(APos1.X, APos1.Y, APos2.X, APos2.Y, AStyle);
 end;
 
-procedure TPDFPage.DrawRect(const X, Y, W, H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);
+procedure TPDFPage.DrawRect(const X, Y, W, H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean;
+  const ADegrees: single);
 var
   R: TPDFRectangle;
   p1, p2: TPDFCoord;
+  t1, t2, t3: string;
+  rad: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
   p2.X := W;
   p2.Y := H;
   DoUnitConversion(p2);
-  R := Document.CreateRectangle(p1.X, p1.Y, p2.X, p2.Y, ALineWidth, AFill, AStroke);
+
+  if ADegrees <> 0.0 then
+  begin
+    rad := DegToRad(-ADegrees);
+    t1 := FormatFloat('0.###;;0', Cos(rad));
+    t2 := FormatFloat('0.###;;0', -Sin(rad));
+    t3 := FormatFloat('0.###;;0', Sin(rad));
+    AddObject(TPDFPushGraphicsStack.Create(Document));
+    // PDF v1.3 page 132 & 143
+    AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm', [t1, t2, t3, t1, p1.X, p1.Y]) + CRLF));
+    // co-ordinates are now based on the newly transformed matrix co-ordinates.
+    R := Document.CreateRectangle(0, 0, p2.X, p2.Y, ALineWidth, AFill, AStroke);
+  end
+  else
+    R := Document.CreateRectangle(p1.X, p1.Y, p2.X, p2.Y, ALineWidth, AFill, AStroke);
+
   AddObject(R);
+
+  if ADegrees <> 0.0 then
+    AddObject(TPDFPopGraphicsStack.Create(Document));
 end;
 
-procedure TPDFPage.DrawRect(const APos: TPDFCoord; const W, H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);
+procedure TPDFPage.DrawRect(const APos: TPDFCoord; const W, H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean;
+  const ADegrees: single);
 begin
-  DrawRect(APos.X, APos.Y, W, H, ALineWidth, AFill, AStroke);
+  DrawRect(APos.X, APos.Y, W, H, ALineWidth, AFill, AStroke, ADegrees);
 end;
 
-procedure TPDFPage.DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer);
+procedure TPDFPage.DrawRoundedRect(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean;
+  const ADegrees: single);
+var
+  R: TPDFRoundedRectangle;
+  p1, p2, p3: TPDFCoord;
+  t1, t2, t3: string;
+  rad: single;
+begin
+  p1 := Matrix.Transform(X, Y);
+  DoUnitConversion(p1);
+  p2.X := W;
+  p2.Y := H;
+  DoUnitConversion(p2);
+  p3.X := ARadius;
+  p3.Y := 0;
+  DoUnitConversion(p3);
+  if ADegrees <> 0.0 then
+  begin
+    rad := DegToRad(-ADegrees);
+    t1 := FormatFloat('0.###;;0', Cos(rad));
+    t2 := FormatFloat('0.###;;0', -Sin(rad));
+    t3 := FormatFloat('0.###;;0', Sin(rad));
+    AddObject(TPDFPushGraphicsStack.Create(Document));
+    // PDF v1.3 page 132 & 143
+    AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm', [t1, t2, t3, t1, p1.X, p1.Y]) + CRLF));
+    // co-ordinates are now based on the newly transformed matrix co-ordinates.
+    R := Document.CreateRoundedRectangle(0, 0, p2.X, p2.Y, p3.X, ALineWidth, AFill, AStroke);
+  end
+  else
+    R := Document.CreateRoundedRectangle(p1.X, p1.Y, p2.X, p2.Y, p3.X, ALineWidth, AFill, AStroke);
+
+  AddObject(R);
+
+  if ADegrees <> 0.0 then
+    AddObject(TPDFPopGraphicsStack.Create(Document));
+end;
+
+procedure TPDFPage.DrawImageRawSize(const X, Y: TPDFFloat; const APixelWidth, APixelHeight, ANumber: integer;
+  const ADegrees: single);
 var
   p1: TPDFCoord;
+  t1, t2, t3: string;
+  rad: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
-  AddObject(Document.CreateImage(p1.X, p1.Y, APixelWidth, APixelHeight, ANumber));
+  if ADegrees <> 0.0 then
+  begin
+    rad := DegToRad(-ADegrees);
+    t1 := FormatFloat('0.###;;0', Cos(rad));
+    t2 := FormatFloat('0.###;;0', -Sin(rad));
+    t3 := FormatFloat('0.###;;0', Sin(rad));
+    AddObject(TPDFPushGraphicsStack.Create(Document));
+    // PDF v1.3 page 132 & 143
+    AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm', [t1, t2, t3, t1, p1.X, p1.Y]) + CRLF));
+    // co-ordinates are now based on the newly transformed matrix co-ordinates.
+    AddObject(Document.CreateImage(0, 0, APixelWidth, APixelHeight, ANumber));
+  end
+  else
+    AddObject(Document.CreateImage(p1.X, p1.Y, APixelWidth, APixelHeight, ANumber));
+
+  if ADegrees <> 0.0 then
+    AddObject(TPDFPopGraphicsStack.Create(Document));
 end;
 
-procedure TPDFPage.DrawImageRawSize(const APos: TPDFCoord; const APixelWidth, APixelHeight, ANumber: integer);
+procedure TPDFPage.DrawImageRawSize(const APos: TPDFCoord; const APixelWidth, APixelHeight, ANumber: integer;
+  const ADegrees: single);
 begin
-  DrawImage(APos.X, APos.Y, APixelWidth, APixelHeight, ANumber);
+  DrawImage(APos.X, APos.Y, APixelWidth, APixelHeight, ANumber, ADegrees);
 end;
 
-procedure TPDFPage.DrawImage(const X, Y: TPDFFloat; const AWidth, AHeight: TPDFFloat; const ANumber: integer);
+procedure TPDFPage.DrawImage(const X, Y: TPDFFloat; const AWidth, AHeight: TPDFFloat; const ANumber: integer;
+  const ADegrees: single);
 var
   p1, p2: TPDFCoord;
+  t1, t2, t3: string;
+  rad: single;
 begin
   p1 := Matrix.Transform(X, Y);
   DoUnitConversion(p1);
   p2.X := AWidth;
   p2.Y := AHeight;
   DoUnitConversion(p2);
-  AddObject(Document.CreateImage(p1.X, p1.Y, p2.X, p2.Y, ANumber));
+
+  if ADegrees <> 0.0 then
+  begin
+    rad := DegToRad(-ADegrees);
+    t1 := FormatFloat('0.###;;0', Cos(rad));
+    t2 := FormatFloat('0.###;;0', -Sin(rad));
+    t3 := FormatFloat('0.###;;0', Sin(rad));
+    AddObject(TPDFPushGraphicsStack.Create(Document));
+    // PDF v1.3 page 132 & 143
+    AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm', [t1, t2, t3, t1, p1.X, p1.Y]) + CRLF));
+    // co-ordinates are now based on the newly transformed matrix co-ordinates.
+    AddObject(Document.CreateImage(0, 0, p2.X, p2.Y, ANumber));
+  end
+  else
+    AddObject(Document.CreateImage(p1.X, p1.Y, p2.X, p2.Y, ANumber));
+
+  if ADegrees <> 0.0 then
+    AddObject(TPDFPopGraphicsStack.Create(Document));
 end;
 
-procedure TPDFPage.DrawImage(const APos: TPDFCoord; const AWidth, AHeight: TPDFFloat; const ANumber: integer);
+procedure TPDFPage.DrawImage(const APos: TPDFCoord; const AWidth, AHeight: TPDFFloat; const ANumber: integer;
+  const ADegrees: single);
 begin
-  DrawImage(APos.X, APos.Y, AWidth, AHeight, ANumber);
+  DrawImage(APos.X, APos.Y, AWidth, AHeight, ANumber, ADegrees);
 end;
 
-procedure TPDFPage.DrawEllipse(const APosX, APosY, AWidth, AHeight,
-    ALineWidth: TPDFFloat; const AFill: Boolean; AStroke: Boolean);
+procedure TPDFPage.DrawEllipse(const APosX, APosY, AWidth, AHeight, ALineWidth: TPDFFloat; const AFill: Boolean;
+  AStroke: Boolean; const ADegrees: single);
 var
   p1, p2: TPDFCoord;
+  t1, t2, t3: string;
+  rad: single;
 begin
   p1 := Matrix.Transform(APosX, APosY);
   DoUnitConversion(p1);
   p2.X := AWidth;
   p2.Y := AHeight;
   DoUnitConversion(p2);
-  AddObject(TPDFEllipse.Create(Document, p1.X, p1.Y, p2.X, p2.Y, ALineWidth, AFill, AStroke));
+
+  if ADegrees <> 0.0 then
+  begin
+    rad := DegToRad(-ADegrees);
+    t1 := FormatFloat('0.###;;0', Cos(rad));
+    t2 := FormatFloat('0.###;;0', -Sin(rad));
+    t3 := FormatFloat('0.###;;0', Sin(rad));
+    AddObject(TPDFPushGraphicsStack.Create(Document));
+    // PDF v1.3 page 132 & 143
+    AddObject(TPDFFreeFormString.Create(Document, Format('%s %s %s %s %.4f %.4f cm', [t1, t2, t3, t1, p1.X, p1.Y]) + CRLF));
+    // co-ordinates are now based on the newly transformed matrix co-ordinates.
+    AddObject(TPDFEllipse.Create(Document, 0, 0, p2.X, p2.Y, ALineWidth, AFill, AStroke));
+  end
+  else
+    AddObject(TPDFEllipse.Create(Document, p1.X, p1.Y, p2.X, p2.Y, ALineWidth, AFill, AStroke));
+
+  if ADegrees <> 0.0 then
+    AddObject(TPDFPopGraphicsStack.Create(Document));
 end;
 
 procedure TPDFPage.DrawEllipse(const APos: TPDFCoord; const AWidth, AHeight, ALineWidth: TPDFFloat;
-    const AFill: Boolean; AStroke: Boolean);
+  const AFill: Boolean; AStroke: Boolean; const ADegrees: single);
+begin
+  DrawEllipse(APos.X, APos.Y, AWidth, AHeight, ALineWidth, AFill, AStroke, ADegrees);
+end;
+
+procedure TPDFPage.DrawPolygon(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
+begin
+  DrawPolyLine(APoints, ALineWidth);
+  ClosePath;
+end;
+
+procedure TPDFPage.DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
+var
+  i: integer;
 begin
-  DrawEllipse(APos.X, APos.Y, AWidth, AHeight, ALineWidth, AFill, AStroke);
+  if Length(APoints) < 2 then
+    Exit; { not enough points to draw a line. Should this raise an exception? }
+  MoveTo(APoints[0].X, APoints[0].Y);
+  for i := Low(APoints)+1 to High(APoints) do
+    DrawLine(APoints[i-1].X, APoints[i-1].Y, APoints[i].X, APoints[i].Y, ALineWidth, False);
+end;
+
+procedure TPDFPage.ResetPath;
+begin
+  AddObject(TPDFResetPath.Create(Document));
+end;
+
+procedure TPDFPage.ClosePath;
+begin
+  AddObject(TPDFClosePath.Create(Document));
+end;
+
+procedure TPDFPage.ClosePathStroke;
+begin
+  AddObject(TPDFFreeFormString.Create(Document, 's'+CRLF));
+end;
+
+procedure TPDFPage.StrokePath;
+begin
+  AddObject(TPDFStrokePath.Create(Document));
+end;
+
+procedure TPDFPage.FillStrokePath;
+begin
+  AddObject(TPDFFreeFormString.Create(Document, 'B'+CRLF));
+end;
+
+procedure TPDFPage.FillEvenOddStrokePath;
+begin
+  AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF));
+end;
+
+procedure TPDFPage.MoveTo(x, y: TPDFFloat);
+var
+  p1: TPDFCoord;
+begin
+  p1 := Matrix.Transform(x, y);
+  DoUnitConversion(p1);
+  AddObject(TPDFMoveTo.Create(Document, p1.x, p1.y));
+end;
+
+procedure TPDFPage.MoveTo(APos: TPDFCoord);
+begin
+  MoveTo(APos.X, APos.Y);
+end;
+
+procedure TPDFPage.CubicCurveTo(const xCtrl1, yCtrl1, xCtrl2, yCtrl2, xTo, yTo, ALineWidth: TPDFFloat; AStroke: Boolean);
+var
+  p1, p2, p3: TPDFCoord;
+begin
+  p1 := Matrix.Transform(xCtrl1, yCtrl1);
+  DoUnitConversion(p1);
+  p2 := Matrix.Transform(xCtrl2, yCtrl2);
+  DoUnitConversion(p2);
+  p3 := Matrix.Transform(xTo, yTo);
+  DoUnitConversion(p3);
+  AddObject(TPDFCurveC.Create(Document, p1.x, p1.y, p2.x, p2.y, p3.x, p3.y, ALineWidth, AStroke));
+end;
+
+procedure TPDFPage.CubicCurveTo(ACtrl1, ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean);
+begin
+  CubicCurveTo(ACtrl1.X, ACtrl1.Y, ACtrl2.X, ACtrl2.Y, ATo.X, ATo.Y, ALineWidth, AStroke);
+end;
+
+procedure TPDFPage.CubicCurveToV(xCtrl2, yCtrl2, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean);
+var
+  p2, p3: TPDFCoord;
+begin
+  p2 := Matrix.Transform(xCtrl2, yCtrl2);
+  DoUnitConversion(p2);
+  p3 := Matrix.Transform(xTo, yTo);
+  DoUnitConversion(p3);
+  AddObject(TPDFCurveV.Create(Document, p2.x, p2.y, p3.x, p3.y, ALineWidth, AStroke));
+end;
+
+procedure TPDFPage.CubicCurveToV(ACtrl2, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean);
+begin
+  CubicCurveToV(ACtrl2.X, ACtrl2.Y, ATo.X, ATo.Y, ALineWidth, AStroke);
+end;
+
+procedure TPDFPage.CubicCurveToY(xCtrl1, yCtrl1, xTo, yTo: TPDFFloat; const ALineWidth: TPDFFloat; AStroke: Boolean);
+var
+  p1, p3: TPDFCoord;
+begin
+  p1 := Matrix.Transform(xCtrl1, yCtrl1);
+  DoUnitConversion(p1);
+  p3 := Matrix.Transform(xTo, yTo);
+  DoUnitConversion(p3);
+  AddObject(TPDFCurveY.Create(Document, p1.x, p1.y, p3.x, p3.y, ALineWidth, AStroke));
+end;
+
+procedure TPDFPage.CubicCurveToY(ACtrl1, ATo: TPDFCoord; const ALineWidth: TPDFFloat; AStroke: Boolean);
+begin
+  CubicCurveToY(ACtrl1.X, ACtrl1.Y, ATo.X, ATo.Y, ALineWidth, AStroke);
+end;
+
+procedure TPDFPage.AddExternalLink(const APosX, APosY, AWidth, AHeight: TPDFFloat;
+    const AURI: string; ABorder: boolean);
+var
+  an: TPDFAnnot;
+  p1, p2: TPDFCoord;
+begin
+  p1 := Matrix.Transform(APosX, APosY);
+  DoUnitConversion(p1);
+  p2.X := AWidth;
+  p2.Y := AHeight;
+  DoUnitConversion(p2);
+  an := TPDFAnnot.Create(Document, p1.X, p1.Y, p2.X, p2.Y, AURI, ABorder);
+  Annots.Add(an);
 end;
 
 function TPDFPage.GetPaperHeight: TPDFFloat;
@@ -1895,7 +2515,7 @@ begin
   If Assigned(FPages) then
     Result:=TPDFPage(FPages[Aindex])
   else
-    Raise EPDF.CreateFmt(SerrInvalidSectionPage,[AIndex]);
+    Raise EPDF.CreateFmt(rsErrInvalidSectionPage,[AIndex]);
 end;
 
 function TPDFSection.GetP: INteger;
@@ -2049,7 +2669,6 @@ begin
 end;
 
 procedure TPDFImageItem.CreateStreamedData(AUseCompression: Boolean);
-
 Var
   X,Y : Integer;
   C : TFPColor;
@@ -2082,7 +2701,7 @@ begin
 
         Str.WriteByte(C.Red shr 8);
         Str.WriteByte(C.Green shr 8);
-        Str.WriteByte(C.blue shr 8);
+        Str.WriteByte(C.Blue shr 8);
         end;
     if Str<>MS then
       Str.Free;
@@ -2098,10 +2717,8 @@ begin
 end;
 
 function TPDFImageItem.WriteImageStream(AStream: TStream): int64;
-
 var
   Img : TBytes;
-
 begin
   TPDFObject.WriteString(CRLF+'stream'+CRLF,AStream);
   Img:=StreamedData;
@@ -2120,18 +2737,21 @@ begin
     Result := False;
     exit;
   end;
-  Result := True;
+
+  { if dimensions don't match, we know we can exit early }
+  Result := (Image.Width = AImage.Width) and (Image.Height = AImage.Height);
+  if not Result then
+    Exit;
+
   for x := 0 to Image.Width-1 do
     for y := 0 to Image.Height-1 do
-      if Image.Pixels[x, y] <> AImage.Pixels[x, y] then
+      if Image.Colors[x, y] <> AImage.Colors[x, y] then
       begin
         Result := False;
         Exit;
       end;
 end;
 
-
-
 { TPDFImages }
 
 function TPDFImages.GetI(AIndex : Integer): TPDFImageItem;
@@ -2176,8 +2796,9 @@ function TPDFImages.AddFromFile(const AFileName: String; KeepImage: Boolean): In
 
   {$IF NOT (FPC_FULLVERSION >= 30101)}
   function FindReaderFromExtension(extension: String): TFPCustomImageReaderClass;
-  var s : string;
-      r : integer;
+  var
+    s: string;
+    r: integer;
   begin
     extension := lowercase (extension);
     if (extension <> '') and (extension[1] = '.') then
@@ -2196,8 +2817,8 @@ function TPDFImages.AddFromFile(const AFileName: String; KeepImage: Boolean): In
       end;
     Result := nil;
   end;
-  function FindReaderFromFileName(const filename: String
-    ): TFPCustomImageReaderClass;
+
+  function FindReaderFromFileName(const filename: String): TFPCustomImageReaderClass;
   begin
     Result := FindReaderFromExtension(ExtractFileExt(filename));
   end;
@@ -2256,6 +2877,8 @@ begin
   begin
     IP:=AddImageItem;
     I:=TFPMemoryImage.Create(0,0);
+    if not Assigned(Handler) then
+      raise EPDF.Create(rsErrNoImageReader);
     Reader := Handler.Create;
     try
       I.LoadFromStream(AStream, Reader);
@@ -2290,6 +2913,7 @@ begin
     Str(F:4:0,Result)
   else
     Str(F:4:2,Result);
+  result := trim(Result);
 end;
 
 procedure TPDFObject.Write(const AStream: TStream);
@@ -2402,13 +3026,7 @@ var
   s: AnsiString;
 begin
   s := Utf8ToAnsi(FValue);
-  if poCompressText in Document.Options then
-  begin
-    // TODO: Implement text compression
-    WriteString('('+s+')', AStream);
-  end
-  else
-    WriteString('('+s+')', AStream);
+  WriteString('('+s+')', AStream);
 end;
 
 constructor TPDFString.Create(Const ADocument : TPDFDocument; const AValue: string);
@@ -2431,13 +3049,7 @@ end;
 
 procedure TPDFUTF8String.Write(const AStream: TStream);
 begin
-  if poCompressText in Document.Options then
-  begin
-    // TODO: Implement text compression
-    WriteString('<'+RemapedText+'>', AStream)
-  end
-  else
-    WriteString('<'+RemapedText+'>', AStream);
+  WriteString('<'+RemapedText+'>', AStream);
 end;
 
 constructor TPDFUTF8String.Create(const ADocument: TPDFDocument; const AValue: UTF8String; const AFontIndex: integer);
@@ -2447,6 +3059,23 @@ begin
   FFontIndex := AFontIndex;
 end;
 
+{ TPDFFreeFormString }
+
+procedure TPDFFreeFormString.Write(const AStream: TStream);
+var
+  s: AnsiString;
+begin
+  s := Utf8ToAnsi(FValue);
+  WriteString(s, AStream);
+end;
+
+constructor TPDFFreeFormString.Create(const ADocument: TPDFDocument; const AValue: string);
+begin
+  inherited Create(ADocument);
+  FValue := AValue;
+end;
+
+
 { TPDFArray }
 
 procedure TPDFArray.Write(const AStream: TStream);
@@ -2485,6 +3114,11 @@ begin
     AddItem(Document.CreateInteger(StrToInt(S)));
 end;
 
+procedure TPDFArray.AddFreeFormArrayValues(S: string);
+begin
+  AddItem(TPDFFreeFormString.Create(nil, S));
+end;
+
 constructor TPDFArray.Create(const ADocument: TPDFDocument);
 begin
   inherited Create(ADocument);
@@ -2524,6 +3158,11 @@ begin
   inherited;
 end;
 
+function TPDFEmbeddedFont.GetPointSize: integer;
+begin
+  Result := StrToInt(FTxtSize);
+end;
+
 procedure TPDFEmbeddedFont.Write(const AStream: TStream);
 begin
   WriteString('/F'+IntToStr(FTxtFont)+' '+FTxtSize+' Tf'+CRLF, AStream);
@@ -2554,31 +3193,177 @@ begin
   WriteString('endstream', AStream);
 end;
 
-constructor TPDFEmbeddedFont.Create(Const ADocument : TPDFDocument;const AFont: integer; const ASize: string);
+class function TPDFEmbeddedFont.WriteEmbeddedSubsetFont(const ADocument: TPDFDocument;
+    const AFontNum: integer; const AOutStream: TStream): int64;
+var
+  PS: int64;
+  CompressedStream: TMemoryStream;
+begin
+  if ADocument.Fonts[AFontNum].SubsetFont = nil then
+    raise Exception.Create('WriteEmbeddedSubsetFont: SubsetFont stream was not initialised.');
+  WriteString(CRLF+'stream'+CRLF, AOutStream);
+  PS := AOutStream.Position;
+  if poCompressFonts in ADocument.Options then
+  begin
+    CompressedStream := TMemoryStream.Create;
+    CompressStream(ADocument.Fonts[AFontNum].SubsetFont, CompressedStream);
+    CompressedStream.Position := 0;
+    CompressedStream.SaveToStream(AOutStream);
+    CompressedStream.Free;
+  end
+  else
+  begin
+    ADocument.Fonts[AFontNum].SubsetFont.Position := 0;
+    TMemoryStream(ADocument.Fonts[AFontNum].SubsetFont).SaveToStream(AOutStream);
+  end;
+  Result := AOutStream.Position-PS;
+
+  WriteString(CRLF, AOutStream);
+  WriteString('endstream', AOutStream);
+end;
+
+constructor TPDFEmbeddedFont.Create(const ADocument: TPDFDocument; const APage: TPDFPage; const AFont: integer;
+  const ASize: string);
 begin
   inherited Create(ADocument);
-  FTxtFont:=AFont;
-  FTxtSize:=ASize;
+  FTxtFont := AFont;
+  FTxtSize := ASize;
+  FPage := APage;
 end;
 
+{ TPDFBaseText }
 
-procedure TPDFText.Write(const AStream: TStream);
+constructor TPDFBaseText.Create(const ADocument: TPDFDocument);
 begin
+  inherited Create(ADocument);
+  FX := 0.0;
+  FY := 0.0;
+  FFont := nil;
+  FDegrees := 0.0;
+  FUnderline := False;
+  FColor := clBlack;
+  FStrikeThrough := False;
+end;
+
+{ TPDFText }
+
+function TPDFText.GetTextWidth: single;
+var
+  i: integer;
+  lWidth: double;
+  lFontName: string;
+begin
+  lFontName := Document.Fonts[Font.FontIndex].Name;
+  if not Document.IsStandardPDFFont(lFontName) then
+    raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
+
+  lWidth := 0;
+  for i := 1 to Length(FString.Value) do
+    lWidth := lWidth + Document.GetStdFontCharWidthsArray(lFontName)[Ord(FString.Value[i])];
+  Result := lWidth * Font.PointSize / 1540;
+end;
+
+function TPDFText.GetTextHeight: single;
+var
+  lFontName: string;
+begin
+  lFontName := Document.Fonts[Font.FontIndex].Name;
+  Result := 0;
+  case lFontName of
+    'Courier':                 result := FONT_TIMES_COURIER_CAPHEIGHT;
+    'Courier-Bold':            result := FONT_TIMES_COURIER_CAPHEIGHT;
+    'Courier-Oblique':         result := FONT_TIMES_COURIER_CAPHEIGHT;
+    'Courier-BoldOblique':     result := FONT_TIMES_COURIER_CAPHEIGHT;
+    'Helvetica':               result := FONT_HELVETICA_ARIAL_CAPHEIGHT;
+    'Helvetica-Bold':          result := FONT_HELVETICA_ARIAL_BOLD_CAPHEIGHT;
+    'Helvetica-Oblique':       result := FONT_HELVETICA_ARIAL_ITALIC_CAPHEIGHT;
+    'Helvetica-BoldOblique':   result := FONT_HELVETICA_ARIAL_BOLD_ITALIC_CAPHEIGHT;
+    'Times-Roman':             result := FONT_TIMES_CAPHEIGHT;
+    'Times-Bold':              result := FONT_TIMES_BOLD_CAPHEIGHT;
+    'Times-Italic':            result := FONT_TIMES_ITALIC_CAPHEIGHT;
+    'Times-BoldItalic':        result := FONT_TIMES_BOLD_ITALIC_CAPHEIGHT;
+    'Symbol':                  result := 300;
+    'ZapfDingbats':            result := 300;
+    else
+      raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
+  end;
+  Result := Result * Font.PointSize / 1540;
+end;
+
+procedure TPDFText.Write(const AStream: TStream);
+var
+  t1, t2, t3: string;
+  rad: single;
+  lWidth: single;
+  lTextWidthInMM: single;
+  lHeight: single;
+  lTextHeightInMM: single;
+  lColor: string;
+  lLineWidth: string;
+begin
+  inherited Write(AStream);
   WriteString('BT'+CRLF, AStream);
-  WriteString(FloatStr(FX)+' '+FloatStr(FY)+' TD'+CRLF, AStream);
+  if Degrees <> 0.0 then
+  begin
+    rad := DegToRad(-Degrees);
+    t1 := FloatStr(Cos(rad));
+    t2 := FloatStr(-Sin(rad));
+    t3 := FloatStr(Sin(rad));
+    WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+  end
+  else
+  begin
+    WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
+  end;
   FString.Write(AStream);
   WriteString(' Tj'+CRLF, AStream);
   WriteString('ET'+CRLF, AStream);
+
+  if (not Underline) and (not StrikeThrough) then
+    Exit;
+
+  // result is in Font Units
+  lWidth := GetTextWidth;
+  lHeight := GetTextHeight;
+  { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+  lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+  lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+  if Degrees <> 0.0 then
+    // angled text
+    WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+  else
+    // horizontal text
+    WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+  { set up a pen width and stroke color }
+  lColor := TPDFColor.Command(True, Color);
+  lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
+  WriteString(lLineWidth + lColor + CRLF, AStream);
+
+  { line segment is relative to matrix translation coordinate, set above }
+  if Underline then
+    WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream)
+  else
+    WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+
+  { restore graphics state to before the translation matrix adjustment }
+  WriteString('Q' + CRLF, AStream);
 end;
 
-constructor TPDFText.Create(Const ADocument : TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString;
-    const AFontIndex: integer);
+constructor TPDFText.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: AnsiString;
+  const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
 begin
   inherited Create(ADocument);
-  FX:=AX;
-  FY:=AY;
-  FFontIndex := AFontIndex;
-  FString:=ADocument.CreateString(AText);
+  X := AX;
+  Y := AY;
+  Font := AFont;
+  Degrees := ADegrees;
+  Underline := AUnderline;
+  StrikeThrough := AStrikeThrough;
+  if Assigned(AFont) and Assigned(AFont.Page) then
+    Color := AFont.Page.FLastFontColor;
+  FString := ADocument.CreateString(AText);
 end;
 
 destructor TPDFText.Destroy;
@@ -2590,22 +3375,87 @@ end;
 { TPDFUTF8Text }
 
 procedure TPDFUTF8Text.Write(const AStream: TStream);
-begin
+var
+  t1, t2, t3: string;
+  rad: single;
+  lFC: TFPFontCacheItem;
+  lWidth: single;
+  lTextWidthInMM: single;
+  lHeight: single;
+  lTextHeightInMM: single;
+  lColor: string;
+  lLineWidth: string;
+  lDescender: single;
+begin
+  inherited Write(AStream);
   WriteString('BT'+CRLF, AStream);
-  WriteString(FloatStr(FX)+' '+FloatStr(FY)+' TD'+CRLF, AStream);
+  if Degrees <> 0.0 then
+  begin
+    rad := DegToRad(-Degrees);
+    t1 := FloatStr(Cos(rad));
+    t2 := FloatStr(-Sin(rad));
+    t3 := FloatStr(Sin(rad));
+    WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+  end
+  else
+  begin
+    WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
+  end;
   FString.Write(AStream);
   WriteString(' Tj'+CRLF, AStream);
   WriteString('ET'+CRLF, AStream);
+
+  if (not Underline) and (not StrikeThrough) then
+    Exit;
+
+  // implement Underline and Strikethrough here
+  lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
+  if not Assigned(lFC) then
+    Exit;  // we can't do anything further
+
+  // result is in Font Units
+  lWidth := lFC.TextWidth(FString.Value, Font.PointSize);
+  lHeight := lFC.TextHeight(FString.Value, Font.PointSize, lDescender);
+  { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+  lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+  lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+  if Degrees <> 0.0 then
+    // angled text
+    WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+  else
+    // horizontal text
+    WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+  { set up a pen width and stroke color }
+  lColor := TPDFColor.Command(True, Color);
+  lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
+  WriteString(lLineWidth + lColor + CRLF, AStream);
+
+  { line segment is relative to matrix translation coordinate, set above }
+  if Underline then
+    WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream)
+  else
+    WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+
+  { restore graphics state to before the translation matrix adjustment }
+  WriteString('Q' + CRLF, AStream);
+
 end;
 
 constructor TPDFUTF8Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UTF8String;
-    const AFontIndex: integer);
+  const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
 begin
   inherited Create(ADocument);
-  FX := AX;
-  FY := AY;
-  FFontIndex := AFontIndex;
-  FString := ADocument.CreateUTF8String(AText, AFontIndex);
+  X := AX;
+  Y := AY;
+  Font := AFont;
+  Degrees := ADegrees;
+  Underline := AUnderline;
+  if Assigned(AFont) and Assigned(AFont.Page) then
+    Color := AFont.Page.FLastFontColor;
+  StrikeThrough := AStrikeThrough;
+  FString := ADocument.CreateUTF8String(AText, AFont.FontIndex);
 end;
 
 destructor TPDFUTF8Text.Destroy;
@@ -2620,9 +3470,11 @@ procedure TPDFLineSegment.Write(const AStream: TStream);
 
 begin
   SetWidth(FWidth,AStream);
-  WriteString(TPDFMoveTo.Command(P1), AStream);
+  if FStroke then
+    WriteString(TPDFMoveTo.Command(P1), AStream);
   WriteString(Command(P2),AStream);
-  WriteString('S'+CRLF, AStream);
+  if FStroke then
+    WriteString('S'+CRLF, AStream);
 end;
 
 class function TPDFLineSegment.Command(APos: TPDFCoord): String;
@@ -2630,13 +3482,18 @@ begin
   Result:=FloatStr(APos.X)+' '+FloatStr(APos.Y)+' l'+CRLF
 end;
 
+class function TPDFLineSegment.Command(x1, y1: TPDFFloat): String;
+begin
+  Result := FloatStr(x1)+' '+FloatStr(y1)+' l'+CRLF
+end;
+
 class function TPDFLineSegment.Command(APos1, APos2: TPDFCoord): String;
 begin
   Result:=TPDFMoveTo.Command(APos1)+Command(APos2);
 end;
 
-constructor TPDFLineSegment.Create(const ADocument: TPDFDocument; const AWidth,
-  X1, Y1, X2, Y2: TPDFFloat);
+constructor TPDFLineSegment.Create(const ADocument: TPDFDocument; const AWidth, X1, Y1, X2, Y2: TPDFFloat;
+  const AStroke: Boolean);
 begin
   inherited Create(ADocument);
   FWidth:=AWidth;
@@ -2644,8 +3501,11 @@ begin
   P1.Y:=Y1;
   P2.X:=X2;
   P2.Y:=Y2;
+  FStroke := AStroke;
 end;
 
+{ TPDFRectangle }
+
 procedure TPDFRectangle.Write(const AStream: TStream);
 begin
   if FStroke then
@@ -2677,6 +3537,67 @@ begin
   FStroke := AStroke;
 end;
 
+{ TPDFRoundedRectangle }
+
+procedure TPDFRoundedRectangle.Write(const AStream: TStream);
+var
+  c: TPDFFloat;
+  x1, y1, x2, y2: TPDFFloat;
+begin
+  if FStroke then
+    SetWidth(FWidth, AStream);
+
+  // bottom left
+  x1 := FBottomLeft.X;
+  y1 := FBottomLeft.Y;
+
+  // top right
+  x2 := FBottomLeft.X + FDimensions.X;
+  y2 := FBottomLeft.Y + FDimensions.Y;
+
+  // radius
+  c := FRadius;
+
+  // Starting point is bottom left, then drawing anti-clockwise
+  WriteString(TPDFMoveTo.Command(x1+c, y1), AStream);
+  WriteString(TPDFLineSegment.Command(x2-c, y1), AStream);
+
+  WriteString(TPDFCurveC.Command(x2-c+BEZIER*c, y1,   x2, y1+c-BEZIER*c,   x2, y1+c), AStream);
+  WriteString(TPDFLineSegment.Command(x2, y2-c), AStream);
+
+  WriteString(TPDFCurveC.Command(x2, y2-c+BEZIER*c, x2-c+BEZIER*c, y2, x2-c, y2), AStream);
+  WriteString(TPDFLineSegment.Command(x1+c, y2), AStream);
+
+  WriteString(TPDFCurveC.Command(x1+c-BEZIER*c, y2, x1, y2-c+BEZIER*c, x1, y2-c), AStream);
+  WriteString(TPDFLineSegment.Command(x1, y1+c), AStream);
+
+  WriteString(TPDFCurveC.Command(x1, y1+c-BEZIER*c, x1+c-BEZIER*c, y1, x1+c, y1), AStream);
+  WriteString('h'+CRLF, AStream);
+
+  if FStroke and FFill then
+    WriteString('b'+CRLF, AStream)
+  else if FFill then
+    WriteString('f'+CRLF, AStream)
+  else if FStroke then
+    WriteString('S'+CRLF, AStream);
+end;
+
+constructor TPDFRoundedRectangle.Create(const ADocument: TPDFDocument; const APosX, APosY, AWidth, AHeight, ARadius,
+  ALineWidth: TPDFFloat; const AFill, AStroke: Boolean);
+begin
+  inherited Create(ADocument);
+  FBottomLeft.X := APosX;
+  FBottomLeft.Y := APosY;
+  FDimensions.X := AWidth;
+  FDimensions.Y := AHeight;
+  FWidth := ALineWidth;
+  FFill := AFill;
+  FStroke := AStroke;
+  FRadius := ARadius;
+end;
+
+{ TPDFSurface }
+
 procedure TPDFSurface.Write(const AStream: TStream);
 var
   i: integer;
@@ -2700,10 +3621,10 @@ end;
 
 procedure TPDFImage.Write(const AStream: TStream);
 begin
-  WriteString('q'+CRLF, AStream);   // save graphics state
+  WriteString(TPDFPushGraphicsStack.Command, AStream);   // save graphics state
   WriteString(FloatStr(FSize.X)+' 0 0 '+FloatStr(FSize.Y)+' '+FloatStr( FPos.X)+' '+FloatStr( FPos.Y)+' cm'+CRLF, AStream);
   WriteString('/I'+IntToStr(FNumber)+' Do'+CRLF, AStream);
-  WriteString('Q'+CRLF, AStream);   // restore graphics state
+  WriteString(TPDFPopGraphicsStack.Command, AStream);   // restore graphics state
 end;
 
 constructor TPDFImage.Create(const ADocument: TPDFDocument; const ALeft, ABottom, AWidth, AHeight: TPDFFloat; ANumber: integer);
@@ -2716,33 +3637,45 @@ begin
   FSize.Y:=AHeight;
 end;
 
+// Dot = linewidth; Dash = (5 x linewidth); Gap = (3 x linewidth);
 procedure TPDFLineStyle.Write(const AStream: TStream);
+var
+  lMask: string;
+  w: TPDFFloat;
 begin
-  WriteString(Format('[%s] %d d'+CRLF,[cPenStyleBitmasks[FStyle],FPhase]), AStream);
+  w := FLineWidth;
+  case FStyle of
+    ppsSolid:
+      begin
+        lMask := '';
+      end;
+    ppsDash:
+      begin
+        lMask := FloatStr(5*w) + ' ' + FloatStr(5*w);
+      end;
+    ppsDot:
+      begin
+        lMask := FloatStr(0.8*w) + ' ' + FloatStr(4*w)
+      end;
+    ppsDashDot:
+      begin
+        lMask := FloatStr(5*w) + ' ' + FloatStr(3*w) + ' ' + FloatStr(0.8*w) + ' ' + FloatStr(3*w)
+      end;
+    ppsDashDotDot:
+      begin
+        lMask := FloatStr(5*w) + ' ' + FloatStr(3*w) + ' ' + FloatStr(0.8*w) + ' ' + FloatStr(3*w) + ' ' + FloatStr(0.8*w) + ' ' + FloatStr(3*w)
+      end;
+  end;
+  WriteString(Format('[%s] %d d'+CRLF,[lMask, FPhase]), AStream);
 end;
 
-constructor TPDFLineStyle.Create(Const ADocument : TPDFDocument; AStyle: TPDFPenStyle; APhase: integer);
+constructor TPDFLineStyle.Create(const ADocument: TPDFDocument; AStyle: TPDFPenStyle; APhase: integer;
+  ALineWidth: TPDFFloat);
 begin
   inherited Create(ADocument);
-  FStyle:=AStyle;
-  FPhase:=APhase;
-end;
-
-procedure TPDFColor.Write(const AStream: TStream);
-
-Var
-  S : String;
-begin
-  S:=FRed+' '+FGreen+' '+FBlue;
-  if FStroke then
-    S:=S+' RG'
-  else
-    S:=S+' rg';
-  if (S<>Document.CurrentColor) then
-    begin
-    WriteString(S+CRLF, AStream);
-    Document.CurrentColor:=S;
-    end;
+  FStyle := AStyle;
+  FPhase := APhase;
+  FLineWidth := ALineWidth;
 end;
 
 Function ARGBGetRed(AColor : TARGBColor) : Byte;
@@ -2769,9 +3702,40 @@ begin
   Result:=((AColor shr 24) and $FF)
 end;
 
+procedure TPDFColor.Write(const AStream: TStream);
+var
+  S : String;
+begin
+  S:=FRed+' '+FGreen+' '+FBlue;
+  if FStroke then
+    S:=S+' RG'
+  else
+    S:=S+' rg';
+  if (S<>Document.CurrentColor) then
+  begin
+    WriteString(S+CRLF, AStream);
+    Document.CurrentColor:=S;
+  end;
+end;
+
+class function TPDFColor.Command(const AStroke: boolean; const AColor: TARGBColor): string;
+var
+  lR, lG, lB: string;
+begin
+  lR := FloatStr(ARGBGetRed(AColor)/256);
+  lG := FloatStr(ARGBGetGreen(AColor)/256);
+  lB := FloatStr(ARGBGetBlue(AColor)/256);
+  result := lR+' '+lG+' '+lB+' ';
+  if AStroke then
+    result := result + 'RG'
+  else
+    result := result + 'rg'
+end;
+
 constructor TPDFColor.Create(Const ADocument : TPDFDocument; const AStroke: Boolean; AColor: TARGBColor);
 begin
   inherited Create(ADocument);
+  FColor := AColor;
   FRed:=FloatStr( ARGBGetRed(AColor)/256);
   FGreen:=FloatStr( ARGBGetGreen(AColor)/256);
   FBlue:=FloatStr( ARGBGetBlue(AColor)/256);
@@ -2906,15 +3870,15 @@ begin
           end;
           if Pos('Length1', E.FKey.Name) > 0 then
           begin
-            M:=TMemoryStream.Create;
-            try
-              Value:=E.FKey.Name;
-              NumFnt:=StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value)));
-              m.LoadFromFile(Document.FontFiles[NumFnt]);
-              Buf := TMemoryStream.Create;
+            Value:=E.FKey.Name;
+            NumFnt:=StrToInt(Copy(Value, Succ(Pos(' ', Value)), Length(Value) - Pos(' ', Value)));
+            if poSubsetFont in Document.Options then
+            begin
+
+              buf := TMemoryStream.Create;
               try
                 // write fontfile stream (could be compressed or not) to a temporary buffer so we can get the size
-                BufSize := TPDFEmbeddedFont.WriteEmbeddedFont(Document, M, Buf);
+                BufSize := TPDFEmbeddedFont.WriteEmbeddedSubsetFont(Document, NumFnt, Buf);
                 Buf.Position := 0;
                 // write fontfile stream length in xobject dictionary
                 D := Document.GlobalXRefs[AObject].Dict;
@@ -2926,8 +3890,31 @@ begin
               finally
                 Buf.Free;
               end;
-            finally
-              M.Free;
+
+            end
+            else
+            begin
+              M:=TMemoryStream.Create;
+              try
+                m.LoadFromFile(Document.FontFiles[NumFnt]);
+                Buf := TMemoryStream.Create;
+                try
+                  // write fontfile stream (could be compressed or not) to a temporary buffer so we can get the size
+                  BufSize := TPDFEmbeddedFont.WriteEmbeddedFont(Document, M, Buf);
+                  Buf.Position := 0;
+                  // write fontfile stream length in xobject dictionary
+                  D := Document.GlobalXRefs[AObject].Dict;
+                  D.AddInteger('Length', BufSize);
+                  LastElement.Write(AStream);
+                  WriteString('>>', AStream);
+                  // write fontfile buffer stream in xobject dictionary
+                  Buf.SaveToStream(AStream);
+                finally
+                  Buf.Free;
+                end;
+              finally
+                M.Free;
+              end;
             end;
           end;
         end;
@@ -2987,7 +3974,7 @@ function TPDFDictionary.ElementByName(const AKey: String): TPDFDictionaryItem;
 begin
   Result:=FindElement(AKey);
   If (Result=Nil) then
-    Raise EPDF.CreateFmt(SErrDictElementNotFound,[AKey]);
+    Raise EPDF.CreateFmt(rsErrDictElementNotFound,[AKey]);
 end;
 
 function TPDFDictionary.ValueByName(const AKey: String): TPDFObject;
@@ -3028,6 +4015,22 @@ begin
   inherited;
 end;
 
+{ TPDFInfos }
+
+constructor TPDFInfos.Create;
+begin
+  inherited Create;
+  FProducer := 'fpGUI Toolkit 1.4';
+end;
+
+{ TPDFFontNumBaseObject }
+
+constructor TPDFFontNumBaseObject.Create(const ADocument: TPDFDocument; const AFontNum: integer);
+begin
+  inherited Create(ADocument);
+  FFontNum := AFontNum;
+end;
+
 { TPDFToUnicode }
 
 procedure TPDFToUnicode.Write(const AStream: TStream);
@@ -3035,35 +4038,125 @@ var
   lst: TTextMappingList;
   i: integer;
 begin
-  lst := Document.Fonts[EmbeddedFontNum].TextMapping;
+  lst := Document.Fonts[FontNum].TextMapping;
 
   WriteString('/CIDInit /ProcSet findresource begin'+CRLF, AStream);
   WriteString('12 dict begin'+CRLF, AStream);
   WriteString('begincmap'+CRLF, AStream);
   WriteString('/CIDSystemInfo'+CRLF, AStream);
   WriteString('<</Registry (Adobe)'+CRLF, AStream);
-  WriteString('/Ordering (Identity)'+CRLF, AStream);
+
+  if poSubsetFont in Document.Options then
+    WriteString('/Ordering (UCS)'+CRLF, AStream)
+  else
+    WriteString('/Ordering (Identity)'+CRLF, AStream);
+
   WriteString('/Supplement 0'+CRLF, AStream);
   WriteString('>> def'+CRLF, AStream);
-  WriteString(Format('/CMapName /%s def', [Document.Fonts[EmbeddedFontNum].FTrueTypeFile.PostScriptName])+CRLF, AStream);
-  WriteString('/CMapType 2 def'+CRLF, AStream);
+
+  if poSubsetFont in Document.Options then
+    WriteString('/CMapName /Adobe-Identity-UCS def'+CRLF, AStream)
+  else
+    WriteString(Format('/CMapName /%s def', [Document.Fonts[FontNum].FTrueTypeFile.PostScriptName])+CRLF, AStream);
+
+  WriteString('/CMapType 2 def'+CRLF, AStream);  // 2 = ToUnicode
+
+  // ToUnicode always uses 16-bit CIDs
   WriteString('1 begincodespacerange'+CRLF, AStream);
   WriteString('<0000> <FFFF>'+CRLF, AStream);
   WriteString('endcodespacerange'+CRLF, AStream);
-  WriteString(Format('%d beginbfchar', [lst.Count])+CRLF, AStream);
-  for i := 0 to lst.Count-1 do
-    WriteString(Format('<%s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream);
-  WriteString('endbfchar'+CRLF, AStream);
+
+  if poSubsetFont in Document.Options then
+  begin
+    { TODO: Future Improvement - We can reduce the entries in the beginbfrange
+            by actually using ranges for consecutive numbers.
+            eg:
+                 <0051> <0053> <006E>
+              vs
+                 <0051> <0051> <006E>
+                 <0052> <0052> <006F>
+                 <0053> <0053> <0070>
+    }
+    // use hex values in the output
+    WriteString(Format('%d beginbfrange', [lst.Count-1])+CRLF, AStream);
+    for i := 1 to lst.Count-1 do
+      WriteString(Format('<%s> <%0:s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream);
+    WriteString('endbfrange'+CRLF, AStream);
+  end
+  else
+  begin
+    WriteString(Format('%d beginbfchar', [lst.Count])+CRLF, AStream);
+    for i := 0 to lst.Count-1 do
+      WriteString(Format('<%s> <%s>', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)])+CRLF, AStream);
+    WriteString('endbfchar'+CRLF, AStream);
+  end;
   WriteString('endcmap'+CRLF, AStream);
   WriteString('CMapName currentdict /CMap defineresource pop'+CRLF, AStream);
   WriteString('end'+CRLF, AStream);
   WriteString('end'+CRLF, AStream);
 end;
 
-constructor TPDFToUnicode.Create(const ADocument: TPDFDocument; const AEmbeddedFontNum: integer);
-begin
-  inherited Create(ADocument);
-  FEmbeddedFontNum := AEmbeddedFontNum;
+
+{ TCIDToGIDMap }
+
+procedure TCIDToGIDMap.Write(const AStream: TStream);
+var
+  lst: TTextMappingList;
+  i: integer;
+  cid, gid: uint16;
+  ba: TBytes;
+  lMaxCharID: integer;
+begin
+  lst := Document.Fonts[FontNum].TextMapping;
+  lst.Sort;
+  lMaxCharID := lst.GetMaxCharID;
+  SetLength(ba, (lMaxCharID * 2)+1);
+  // initialize array to 0's
+  for i := 0 to Length(ba)-1 do
+    ba[i] := 0;
+  for i := 0 to lst.Count-1 do
+  begin
+    cid := lst[i].GlyphID;
+    gid := lst[i].NewGlyphID;
+
+    ba[2*cid] := Hi(gid); // Byte((gid shr 8) and $FF); //Hi(gid);
+    ba[(2*cid)+1] := Lo(gid); //Byte(gid and $FF); //Lo(gid);
+  end;
+
+  AStream.WriteBuffer(ba[0], Length(ba));
+  WriteString(CRLF, AStream);
+  SetLength(ba, 0);
+end;
+
+{ TPDFCIDSet }
+
+{ CIDSet uses the bits of each byte for optimised storage. }
+procedure TPDFCIDSet.Write(const AStream: TStream);
+var
+  lst: TTextMappingList;
+  i: integer;
+  cid, gid: uint16;
+  ba: TBytes;
+  mask: uint8;
+  lSize: integer;
+begin
+  lst := Document.Fonts[FontNum].TextMapping;
+  lst.Sort;
+  lSize := (lst.GetMaxCharID div 8) + 1;
+  SetLength(ba, lSize);
+  for i := 0 to lst.Count-1 do
+  begin
+    cid := lst[i].CharID;
+    mask := 1 shl (7 - (cid mod 8));
+    if cid = 0 then
+      gid := 0
+    else
+      gid := cid div 8;
+    ba[gid] := ba[gid] or mask;
+  end;
+  AStream.WriteBuffer(ba[0], Length(ba));
+  WriteString(CRLF, AStream);
+  SetLength(ba, 0);
 end;
 
 { TPDFDocument }
@@ -3092,6 +4185,28 @@ begin
   FFontFiles.Assign(AValue);
 end;
 
+function TPDFDocument.GetStdFontCharWidthsArray(const AFontName: string): TPDFFontWidthArray;
+begin
+  case AFontName of
+    'Courier':                 result := FONT_COURIER_FULL;
+    'Courier-Bold':            result := FONT_COURIER_FULL;
+    'Courier-Oblique':         result := FONT_COURIER_FULL;
+    'Courier-BoldOblique':     result := FONT_COURIER_FULL;
+    'Helvetica':               result := FONT_HELVETICA_ARIAL;
+    'Helvetica-Bold':          result := FONT_HELVETICA_ARIAL_BOLD;
+    'Helvetica-Oblique':       result := FONT_HELVETICA_ARIAL_ITALIC;
+    'Helvetica-BoldOblique':   result := FONT_HELVETICA_ARIAL_BOLD_ITALIC;
+    'Times-Roman':             result := FONT_TIMES;
+    'Times-Bold':              result := FONT_TIMES_BOLD;
+    'Times-Italic':            result := FONT_TIMES_ITALIC;
+    'Times-BoldItalic':        result := FONT_TIMES_BOLD_ITALIC;
+    'Symbol':                  result := FONT_SYMBOL;
+    'ZapfDingbats':            result := FONT_ZAPFDINGBATS;
+    else
+      raise EPDF.CreateFmt(rsErrUnknownStdFont, [AFontName]);
+  end;
+end;
+
 function TPDFDocument.GetX(AIndex : Integer): TPDFXRef;
 begin
   Result:=FGlobalXRefs[Aindex] as TPDFXRef;
@@ -3102,6 +4217,21 @@ begin
   Result:=FGlobalXRefs.Count;
 end;
 
+function TPDFDocument.GetTotalAnnotsCount: integer;
+var
+  i: integer;
+begin
+  Result := 0;
+  for i := 0 to Pages.Count-1 do
+    Result := Result + Pages[i].Annots.Count;
+end;
+
+function TPDFDocument.GetFontNamePrefix(const AFontNum: Integer): string;
+begin
+  // TODO: it must be 6 uppercase characters - no numbers!
+  Result := 'GRAEA' + Char(65+AFontNum) + '+';
+end;
+
 function TPDFDocument.IndexOfGlobalXRef(const AValue: string): integer;
 var
   i: integer;
@@ -3143,31 +4273,54 @@ end;
 procedure TPDFDocument.WriteObject(const AObject: integer; const AStream: TStream);
 var
   M : TMemoryStream;
+  MCompressed: TMemoryStream;
   X : TPDFXRef;
+  d: integer;
 begin
   TPDFObject.WriteString(IntToStr(AObject)+' 0 obj'+CRLF, AStream);
   X:=GlobalXRefs[AObject];
   if X.FStream = nil then
     X.Dict.WriteDictionary(AObject, AStream)
   else
+  begin
+    CurrentColor := '';
+    CurrentWidth := '';
+
+    M := TMemoryStream.Create;
+    X.FStream.Write(M);
+    d := M.Size;
+    X.Dict.AddInteger('Length', M.Size);
+
+    if poCompressText in Options then
     begin
-    M:=TMemoryStream.Create;
-    try
-      CurrentColor:='';
-      CurrentWidth:='';
-      X.FStream.Write(M);
-      X.Dict.AddInteger('Length',M.Size);
-    finally
-      M.Free;
+      MCompressed := TMemoryStream.Create;
+      CompressStream(M, MCompressed);
+      X.Dict.AddName('Filter', 'FlateDecode');
+      X.Dict.AddInteger('Length1', MCompressed.Size);
     end;
+
     X.Dict.Write(AStream);
+
     // write stream in contents dictionary
     CurrentColor:='';
     CurrentWidth:='';
     TPDFObject.WriteString(CRLF+'stream'+CRLF, AStream);
-    X.FStream.Write(AStream);
-    TPDFObject.WriteString('endstream', AStream);
+    if poCompressText in Options then
+    begin
+      MCompressed.Position := 0;
+      MCompressed.SaveToStream(AStream);
+      MCompressed.Free;
+    end
+    else
+    begin
+      M.Position := 0;
+      m.SaveToStream(AStream);
+//      X.FStream.Write(AStream);
     end;
+
+    M.Free;
+    TPDFObject.WriteString('endstream', AStream);
+  end;
   TPDFObject.WriteString(CRLF+'endobj'+CRLF+CRLF, AStream);
 end;
 
@@ -3207,9 +4360,12 @@ begin
   IDict:=CreateGlobalXRef.Dict;
   Trailer.AddReference('Info', GLobalXRefCount-1);
   (Trailer.ValueByName('Size') as TPDFInteger).Value:=GLobalXRefCount;
-  IDict.AddString('Title',Infos.Title);
-  IDict.AddString('Author',Infos.Author);
-  IDict.AddString('Creator',Infos.ApplicationName);
+  if Infos.Title <> '' then
+    IDict.AddString('Title',Infos.Title);
+  if Infos.Author <> '' then
+    IDict.AddString('Author',Infos.Author);
+  if Infos.ApplicationName <> '' then
+    IDict.AddString('Creator',Infos.ApplicationName);
   IDict.AddString('Producer',Infos.Producer);
   IDict.AddString('CreationDate',DateToPdfDate(Infos.CreationDate));
 end;
@@ -3251,26 +4407,26 @@ end;
 
 function TPDFDocument.CreatePageEntry(Parent, PageNum: integer): integer;
 var
-
   PDict,ADict: TPDFDictionary;
   Arr : TPDFArray;
   PP : TPDFPage;
-
 begin
   // add xref entry
   PP:=Pages[PageNum];
   PDict:=CreateGlobalXRef.Dict;
+
   PDict.AddName('Type','Page');
   PDict.AddReference('Parent',Parent);
   ADict:=GlobalXRefs[Parent].Dict;
   (ADict.ValueByName('Count') as TPDFInteger).Inc;
-  (ADict.ValueByName('Kids') as TPDFArray).AddItem(CreateReference(GLobalXRefCount-1));
+  (ADict.ValueByName('Kids') as TPDFArray).AddItem(CreateReference(GlobalXRefCount-1));
   Arr:=CreateArray;
   Arr.AddItem(CreateInteger(0));
   Arr.AddItem(CreateInteger(0));
   Arr.AddItem(CreateInteger(PP.Paper.W));
   Arr.AddItem(CreateInteger(PP.Paper.H));
   PDict.AddElement('MediaBox',Arr);
+  CreateAnnotEntries(PageNum, PDict);
   ADict:=CreateDictionary;
   PDict.AddElement('Resources',ADict);
   Arr:=CreateArray; // procset
@@ -3282,7 +4438,8 @@ begin
     ADict.AddElement('Font',CreateDictionary);
   if PP.HasImages then
     ADict.AddElement('XObject', CreateDictionary);
-  Result:=GLobalXRefCount-1;
+
+  Result:=GlobalXRefCount-1;
 end;
 
 function TPDFDocument.CreateOutlines: integer;
@@ -3339,7 +4496,9 @@ procedure TPDFDocument.CreateStdFont(EmbeddedFontName: string; EmbeddedFontNum:
 var
   FDict: TPDFDictionary;
   N: TPDFName;
+  lFontXRef: integer;
 begin
+  lFontXRef := GlobalXRefCount; // will be used a few lines down in AddFontNameToPages()
   // add xref entry
   FDict := CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'Font');
@@ -3350,8 +4509,9 @@ begin
   FDict.AddName('BaseFont', EmbeddedFontName);
   N := CreateName('F'+IntToStr(EmbeddedFontNum));
   FDict.AddElement('Name',N);
-  AddFontNameToPages(N.Name,GLobalXRefCount-1);
   // add font reference to global page dictionary
+  AddFontNameToPages(N.Name, lFontXRef);
+
   FontFiles.Add('');
 end;
 
@@ -3382,23 +4542,37 @@ var
   FDict: TPDFDictionary;
   N: TPDFName;
   Arr: TPDFArray;
+  lFontXRef: integer;
 begin
+  lFontXRef := GlobalXRefCount; // will be used a few lines down in AddFontNameToPages()
+
   // add xref entry
   FDict := CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'Font');
   FDict.AddName('Subtype', 'Type0');
-  FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+
+  if poSubsetFont in Options then
+    FDict.AddName('BaseFont', GetFontNamePrefix(EmbeddedFontNum) + Fonts[EmbeddedFontNum].Name)
+  else
+    FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+
   FDict.AddName('Encoding', 'Identity-H');
+
   // add name element to font dictionary
   N:=CreateName('F'+IntToStr(EmbeddedFontNum));
   FDict.AddElement('Name',N);
-  AddFontNameToPages(N.Name,GlobalXRefCount-1);
-  CreateTTFDescendantFont(EmbeddedFontNum);
+  AddFontNameToPages(N.Name, lFontXRef);
+
   Arr := CreateArray;
+  Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount));
   FDict.AddElement('DescendantFonts', Arr);
-  Arr.AddItem(TPDFReference.Create(self, GlobalXRefCount-4));
-  CreateToUnicode(EmbeddedFontNum);
-  FDict.AddReference('ToUnicode', GlobalXRefCount-1);
+  CreateTTFDescendantFont(EmbeddedFontNum);
+
+  if not (poNoEmbeddedFonts in Options) then
+  begin
+    FDict.AddReference('ToUnicode', GlobalXRefCount);
+    CreateToUnicode(EmbeddedFontNum);
+  end;
   FontFiles.Add(Fonts[EmbeddedFontNum].FTrueTypeFile.Filename);
 end;
 
@@ -3411,18 +4585,31 @@ begin
   FDict := CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'Font');
   FDict.AddName('Subtype', 'CIDFontType2');
-  FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
+  if poSubsetFont in Options then
+    FDict.AddName('BaseFont', GetFontNamePrefix(EmbeddedFontNum) + Fonts[EmbeddedFontNum].Name)
+  else
+    FDict.AddName('BaseFont', Fonts[EmbeddedFontNum].Name);
 
+  FDict.AddReference('CIDSystemInfo', GlobalXRefCount);
   CreateTTFCIDSystemInfo;
-  FDict.AddReference('CIDSystemInfo', GlobalXRefCount-1);
 
   // add fontdescriptor reference to font dictionary
+  FDict.AddReference('FontDescriptor',GlobalXRefCount);
   CreateFontDescriptor(EmbeddedFontNum);
-  FDict.AddReference('FontDescriptor',GlobalXRefCount-2);
 
   Arr := CreateArray;
   FDict.AddElement('W',Arr);
   Arr.AddItem(TPDFTrueTypeCharWidths.Create(self, EmbeddedFontNum));
+
+  // TODO: Implement CIDToGIDMap here
+  { It's an array of 256*256*2, loop through the CID values (from <xxx> Tj) and if
+    CID matches the loop variable, then populate the 2-byte data, otherwise write
+    $0 to the two bytes. Then stream the array as a PDF Reference Object and
+    use compression (if defined in PDFDocument.Options. }
+  if (poSubsetFont in Options) then
+  begin
+    FDict.AddReference('CIDToGIDMap', CreateCIDToGIDMap(EmbeddedFontNum));
+  end;
 end;
 
 procedure TPDFDocument.CreateTTFCIDSystemInfo;
@@ -3447,49 +4634,79 @@ var
 begin
   FDict:=CreateGlobalXRef.Dict;
   FDict.AddName('Type', 'FontDescriptor');
-  FDict.AddName('FontName', Fonts[EmbeddedFontNum].Name);
-  FDict.AddName('FontFamily', Fonts[EmbeddedFontNum].FTrueTypeFile.FamilyName);
+
+  if poSubsetFont in Options then
+  begin
+    FDict.AddName('FontName', GetFontNamePrefix(EmbeddedFontNum) + Fonts[EmbeddedFontNum].Name);
+    FDict.AddInteger('Flags', 4);
+  end
+  else
+  begin
+    FDict.AddName('FontName', Fonts[EmbeddedFontNum].Name);
+    FDict.AddName('FontFamily', Fonts[EmbeddedFontNum].FTrueTypeFile.FamilyName);
+    FDict.AddInteger('Flags', 32);
+  end;
+
   FDict.AddInteger('Ascent', Fonts[EmbeddedFontNum].FTrueTypeFile.Ascender);
   FDict.AddInteger('Descent', Fonts[EmbeddedFontNum].FTrueTypeFile.Descender);
   FDict.AddInteger('CapHeight', Fonts[EmbeddedFontNum].FTrueTypeFile.CapHeight);
-  FDict.AddInteger('Flags', 32);
   Arr:=CreateArray;
   FDict.AddElement('FontBBox',Arr);
   Arr.AddIntArray(Fonts[EmbeddedFontNum].FTrueTypeFile.BBox);
-  FDict.AddInteger('ItalicAngle',Fonts[EmbeddedFontNum].FTrueTypeFile.ItalicAngle);
+  FDict.AddInteger('ItalicAngle', trunc(Fonts[EmbeddedFontNum].FTrueTypeFile.ItalicAngle));
   FDict.AddInteger('StemV', Fonts[EmbeddedFontNum].FTrueTypeFile.StemV);
   FDict.AddInteger('MissingWidth', Fonts[EmbeddedFontNum].FTrueTypeFile.MissingWidth);
-  CreateFontFileEntry(EmbeddedFontNum);
-  FDict.AddReference('FontFile2',GlobalXRefCount-1);
+  if not (poNoEmbeddedFonts in Options) then
+  begin
+    FDict.AddReference('FontFile2', GlobalXRefCount);
+    CreateFontFileEntry(EmbeddedFontNum);
+
+    if poSubsetFont in Options then
+    begin
+      // todo /CIDSet reference
+      FDict.AddReference('CIDSet', GlobalXRefCount);
+      CreateCIDSet(EmbeddedFontNum);
+    end;
+  end;
 end;
 
-procedure TPDFDocument.CreateToUnicode(const EmbeddedFontNum: integer);
+procedure TPDFDocument.CreateToUnicode(const AFontNum: integer);
 var
   lXRef: TPDFXRef;
 begin
   lXRef := CreateGlobalXRef;
   lXRef.FStream := CreateStream(True);
-  lXRef.FStream.AddItem(TPDFToUnicode.Create(self, EmbeddedFontNum));
+  lXRef.FStream.AddItem(TPDFToUnicode.Create(self, AFontNum));
 end;
 
-procedure TPDFDocument.CreateFontFileEntry(const EmbeddedFontNum: integer);
+procedure TPDFDocument.CreateFontFileEntry(const AFontNum: integer);
 var
   FDict: TPDFDictionary;
 begin
   FDict:=CreateGlobalXRef.Dict;
   if poCompressFonts in Options then
     FDict.AddName('Filter','FlateDecode');
-  FDict.AddInteger('Length1 '+IntToStr(EmbeddedFontNum), Fonts[EmbeddedFontNum].FTrueTypeFile.OriginalSize);
+  FDict.AddInteger('Length1 '+IntToStr(AFontNum), Fonts[AFontNum].FTrueTypeFile.OriginalSize);
 end;
 
-procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);
+procedure TPDFDocument.CreateCIDSet(const AFontNum: integer);
+var
+  lXRef: TPDFXRef;
+begin
+  lXRef := CreateGlobalXRef;
+  lXRef.FStream := CreateStream(True);
+  lXRef.FStream.AddItem(TPDFCIDSet.Create(self, AFontNum));
+end;
 
+procedure TPDFDocument.CreateImageEntry(ImgWidth, ImgHeight, NumImg: integer);
 var
   N: TPDFName;
   IDict,ADict: TPDFDictionary;
   i: integer;
-
+  lXRef: integer;
 begin
+  lXRef := GlobalXRefCount; // reference to be used later
+
   IDict:=CreateGlobalXRef.Dict;
   IDict.AddName('Type','XObject');
   IDict.AddName('Subtype','Image');
@@ -3499,33 +4716,95 @@ begin
   IDict.AddInteger('BitsPerComponent',8);
   N:=CreateName('I'+IntToStr(NumImg)); // Needed later
   IDict.AddElement('Name',N);
-  for i:=1 to GLobalXRefCount-1 do
-    begin
+
+  // now find where we must add the image xref - we are looking for "Resources"
+  for i := 1 to GlobalXRefCount-1 do
+  begin
     ADict:=GlobalXRefs[i].Dict;
     if ADict.ElementCount > 0 then
-      begin
+    begin
       if (ADict.Values[0] is TPDFName) and ((ADict.Values[0] as TPDFName).Name='Page') then
-        begin
+      begin
         ADict:=ADict.ValueByName('Resources') as TPDFDictionary;
         ADict:=TPDFDictionary(ADict.FindValue('XObject'));
         if Assigned(ADict) then
-          begin
-          ADict.AddReference(N.Name,GLobalXRefCount-1);
-          end;
+        begin
+          ADict.AddReference(N.Name, lXRef);
         end;
       end;
     end;
+  end;
 end;
 
-function TPDFDocument.CreateContentsEntry: integer;
+function TPDFDocument.CreateAnnotEntry(const APageNum, AnnotNum: integer): integer;
 var
-  Contents: TPDFXRef;
+  lDict, ADict: TPDFDictionary;
+  an: TPDFAnnot;
+  ar: TPDFArray;
+  lXRef: TPDFXRef;
+  s: string;
+begin
+  an := Pages[APageNum].Annots[AnnotNum];
+  lXRef := CreateGlobalXRef;
+  lDict := lXRef.Dict;
+  lDict.AddName('Type', 'Annot');
+  lDict.AddName('Subtype', 'Link');
+  { Invert link on click - PDF 1.3 spec pg.410. It is the default value, but
+    some PDF viewers don't apply that if not explicity specified. }
+  lDict.AddName('H', 'I');
+
+  { Border array consists of 3 or 4 values. The first three elements describe
+    the horizontal corner radius, the vertical corner radius and the border
+    width. A 0 border width means no border is drawn. The optional 4th element
+    is an array defining a dash pattern. For example:  /Border [16 16 2 [2 1]] }
+  ar := CreateArray;
+  lDict.AddElement('Border', ar);
+  if an.FBorder then
+    s := '1'
+  else
+    s := '0';
+  ar.AddFreeFormArrayValues('0 0 ' + s);
+
+  ar := CreateArray;
+  lDict.AddElement('Rect', ar);
+  s := ar.FloatStr(an.FLeft);
+  s := s + ' ' + ar.FloatStr(an.FBottom);
+  s := s + ' ' + ar.FloatStr(an.FLeft + an.FWidth);
+  s := s + ' ' + ar.FloatStr(an.FBottom + an.FHeight);
+  ar.AddFreeFormArrayValues(s);
+
+  ADict := CreateDictionary;
+  lDict.AddElement('A', ADict);
+  ADict.AddName('Type', 'Action');
+  ADict.AddName('S', 'URI');
+  ADict.AddString('URI', an.FURI);
+
+  result := GlobalXRefCount-1;
+end;
+
+function TPDFDocument.CreateCIDToGIDMap(const AFontNum: integer): integer;
+var
+  lXRef: TPDFXRef;
+begin
+  lXRef := CreateGlobalXRef;
+  result := GlobalXRefCount-1;
+
+  lXRef.FStream := CreateStream(True);
+  lXRef.FStream.AddItem(TCIDToGIDMap.Create(self, AFontNum));
+end;
 
+function TPDFDocument.CreateContentsEntry(const APageNum: integer): integer;
+var
+  Contents: TPDFXRef;
+  i: integer;
 begin
   Contents:=CreateGlobalXRef;
   Contents.FStream:=CreateStream(False);
   Result:=GlobalXRefCount-1;
-  GlobalXrefs[GlobalXRefCount-2].Dict.AddReference('Contents',Result);
+  { TODO: This is terrible code. See if we can make a better plan getting hold
+          of the reference to the Page dictionary. }
+  i := 2 + Pages[APageNum].Annots.Count; // + GetTotalAnnotsCount;
+  GlobalXrefs[GlobalXRefCount-i].Dict.AddReference('Contents',Result);
 end;
 
 procedure TPDFDocument.CreatePageStream(APage : TPDFPage; PageNum: integer);
@@ -3553,46 +4832,39 @@ begin
   Result:=FGlobalXRefs.Add(AXRef);
 end;
 
-
 function TPDFDocument.GlobalXRefByName(const AName: String): TPDFXRef;
 begin
   Result:=FindGlobalXRef(AName);
   if Result=Nil then
-    Raise EPDF.CreateFmt(SErrNoGlobalDict,[AName]);
+    Raise EPDF.CreateFmt(rsErrNoGlobalDict,[AName]);
 end;
 
-Function TPDFDocument.CreateLineStyles : TPDFLineStyleDefs;
-
+function TPDFDocument.CreateLineStyles: TPDFLineStyleDefs;
 begin
   Result:=TPDFLineStyleDefs.Create(TPDFLineStyleDef);
 end;
 
-Function TPDFDocument.CreateSectionList : TPDFSectionList;
-
+function TPDFDocument.CreateSectionList: TPDFSectionList;
 begin
   Result:=TPDFSectionList.Create(TPDFSection)
 end;
 
-Function TPDFDocument.CreateFontDefs : TPDFFontDefs;
-
+function TPDFDocument.CreateFontDefs: TPDFFontDefs;
 begin
   Result := TPDFFontDefs.Create(TPDFFont);
 end;
 
-Function TPDFDocument.CreatePDFInfos : TPDFInfos;
-
+function TPDFDocument.CreatePDFInfos: TPDFInfos;
 begin
   Result:=TPDFInfos.Create;
 end;
 
-Function TPDFDocument.CreatePDFImages : TPDFImages;
-
+function TPDFDocument.CreatePDFImages: TPDFImages;
 begin
   Result:=TPDFImages.Create(Self,TPDFImageItem);
 end;
 
-Function TPDFDocument.CreatePDFPages : TPDFPages;
-
+function TPDFDocument.CreatePDFPages: TPDFPages;
 begin
   Result:=TPDFPages.Create(Self);
 end;
@@ -3613,11 +4885,13 @@ begin
   FDefaultOrientation:=ppoPortrait;
   FZoomValue:='100';
   FOptions := [poCompressFonts, poCompressImages];
+  FUnitOfMeasure:=uomMillimeters;
 end;
 
 procedure TPDFDocument.StartDocument;
 
 begin
+  Reset;
   CreateRefTable;
   CreateTrailer;
   FCatalogue:=CreateCatalogEntry;
@@ -3627,6 +4901,18 @@ begin
     FontDirectory:=ExtractFilePath(ParamStr(0));
 end;
 
+procedure TPDFDocument.Reset;
+begin
+  FLineStyleDefs.Clear;
+  FFonts.Clear;
+  FImages.Clear;
+  FFontFiles.Clear;
+  FreeAndNil(FPages);
+  FPages:=CreatePDFPages;
+  FreeAndNil(FSections);
+  FSections:=CreateSectionList;
+end;
+
 destructor TPDFDocument.Destroy;
 
 begin
@@ -3764,7 +5050,7 @@ begin
         Arr.AddItem(CreateReference(GLobalXRefCount-1));
         Arr.AddItem(CreateName('XYZ null null '+TPDFObject.FloatStr(StrToInt(FZoomValue) / 100), False));
         end;
-      PageNum:=CreateContentsEntry; // pagenum = object number in the pdf file
+      PageNum:=CreateContentsEntry(k); // pagenum = object number in the pdf file
       CreatePageStream(S.Pages[k],PageNum);
       if (Sections.Count>1) and (poOutline in Options) then
         begin
@@ -3791,40 +5077,52 @@ begin
   // select the font type
   NumFont:=0;
   for i:=0 to Fonts.Count-1 do
-    begin
+  begin
     FontName := Fonts[i].Name;
-    { Acrobat Reader expects us to be case sensitive. Other PDF viewers are case-insensitive. }
-    if (FontName='Courier') or (FontName='Courier-Bold') or (FontName='Courier-Oblique') or (FontName='Courier-BoldOblique')
-        or (FontName='Helvetica') or (FontName='Helvetica-Bold') or (FontName='Helvetica-Oblique') or (FontName='Helvetica-BoldOblique')
-        or (FontName='Times-Roman') or (FontName='Times-Bold') or (FontName='Times-Italic') or (FontName='Times-BoldItalic')
-        or (FontName='Symbol')
-        or (FontName='Zapf Dingbats') then
+
+    if IsStandardPDFFont(FontName) then
+      CreateStdFont(FontName, NumFont)
+    else if LoadFont(Fonts[i]) then
     begin
-      CreateStdFont(FontName, NumFont);
+      if poSubsetFont in Options then
+        Fonts[i].GenerateSubsetFont;
+      CreateTtfFont(NumFont);
     end
-    else if LoadFont(Fonts[i]) then
-      CreateTtfFont(NumFont)
     else
       CreateTp1Font(NumFont);  // not implemented yet
+
     Inc(NumFont);
-    end;
+  end;
 end;
 
 procedure TPDFDocument.CreateImageEntries;
-
 Var
   I : Integer;
-
 begin
   for i:=0 to Images.Count-1 do
     CreateImageEntry(Images[i].Width,Images[i].Height,i);
 end;
 
-procedure TPDFDocument.SaveToStream(const AStream: TStream);
+procedure TPDFDocument.CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary);
+var
+  i: integer;
+  refnum: integer;
+  ar: TPDFArray;
+begin
+  if GetTotalAnnotsCount = 0 then
+    Exit;
+  ar := CreateArray;
+  APageDict.AddElement('Annots', ar);
+  for i := 0 to Pages[APageNum].Annots.Count-1 do
+  begin
+    refnum := CreateAnnotEntry(APageNum, i);
+    ar.AddItem(CreateReference(refnum));
+  end;
+end;
 
+procedure TPDFDocument.SaveToStream(const AStream: TStream);
 var
   i, XRefPos: integer;
-
 begin
   CreateSectionsOutLine;
   CreateFontEntries;
@@ -3854,25 +5152,48 @@ begin
   TPDFObject.WriteString(PDF_FILE_END, AStream);
 end;
 
-function TPDFDocument.CreateEmbeddedFont(AFontIndex, AFontSize : Integer): TPDFEmbeddedFont;
+procedure TPDFDocument.SaveToFile(const AFileName: String);
+
+Var
+  F : TFileStream;
+
 begin
-  Result:=TPDFEmbeddedFont.Create(Self,AFontIndex,IntToStr(AFontSize))
+  F:=TFileStream.Create(AFileName,fmCreate);
+  try
+    SaveToStream(F);
+  finally
+    F.Free;
+  end;
 end;
 
-function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFontIndex: integer): TPDFText;
+function TPDFDocument.IsStandardPDFFont(AFontName: string): boolean;
 begin
-  {$ifdef gdebug}
-  writeln('TPDFDocument.CreateText( AnsiString ) ', AFontIndex);
-  {$endif}
-  Result:=TPDFText.Create(Self,X,Y,AText,AFontIndex);
+  { Acrobat Reader expects us to be case sensitive. Other PDF viewers are case-insensitive. }
+  if (AFontName='Courier') or (AFontName='Courier-Bold') or (AFontName='Courier-Oblique') or (AFontName='Courier-BoldOblique')
+      or (AFontName='Helvetica') or (AFontName='Helvetica-Bold') or (AFontName='Helvetica-Oblique') or (AFontName='Helvetica-BoldOblique')
+      or (AFontName='Times-Roman') or (AFontName='Times-Bold') or (AFontName='Times-Italic') or (AFontName='Times-BoldItalic')
+      or (AFontName='Symbol')
+      or (AFontName='ZapfDingbats') then
+    Result := True
+  else
+    Result := False;
 end;
 
-function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UTF8String; const AFontIndex: integer): TPDFUTF8Text;
+function TPDFDocument.CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize: Integer): TPDFEmbeddedFont;
 begin
-  {$ifdef gdebug}
-  writeln('TPDFDocument.CreateText( UTF8String ) ', AFontIndex);
-  {$endif}
-  Result := TPDFUTF8Text.Create(Self,X,Y,AText,AFontIndex);
+  Result:=TPDFEmbeddedFont.Create(Self, APage, AFontIndex, IntToStr(AFontSize))
+end;
+
+function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: AnsiString; const AFont: TPDFEmbeddedFont;
+  const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean): TPDFText;
+begin
+  Result:=TPDFText.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
+end;
+
+function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UTF8String; const AFont: TPDFEmbeddedFont;
+  const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean): TPDFUTF8Text;
+begin
+  Result := TPDFUTF8Text.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
 end;
 
 function TPDFDocument.CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRectangle;
@@ -3880,6 +5201,12 @@ begin
   Result:=TPDFRectangle.Create(Self,X,Y,W,H,ALineWidth,AFill, AStroke);
 end;
 
+function TPDFDocument.CreateRoundedRectangle(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat;
+    const AFill, AStroke: Boolean): TPDFRoundedRectangle;
+begin
+  Result := TPDFRoundedRectangle.Create(Self, X, Y, W, H, ARadius, ALineWidth, AFill, AStroke);
+end;
+
 function TPDFDocument.CreateColor(AColor: TARGBColor; AStroke: Boolean): TPDFColor;
 begin
   Result:=TPDFColor.Create(Self,AStroke,AColor);
@@ -3910,9 +5237,9 @@ begin
   Result := TPDFUTF8String.Create(self, AValue, AFontIndex);
 end;
 
-function TPDFDocument.CreateLineStyle(APenStyle: TPDFPenStyle): TPDFLineStyle;
+function TPDFDocument.CreateLineStyle(APenStyle: TPDFPenStyle; const ALineWidth: TPDFFloat): TPDFLineStyle;
 begin
-  Result:=TPDFLineStyle.Create(Self,APenStyle,0)
+  Result := TPDFLineStyle.Create(Self, APenStyle, 0, ALineWidth);
 end;
 
 function TPDFDocument.CreateName(AValue: String; const AMustEscape: boolean = True): TPDFName;
@@ -3946,7 +5273,7 @@ begin
   Result:=TPDFImage.Create(Self,ALeft,ABottom,AWidth,AHeight,ANumber);
 end;
 
-function TPDFDocument.AddFont(AName: String; AColor : TARGBColor = clBlack): Integer;
+function TPDFDocument.AddFont(AName: String): Integer;
 var
   F: TPDFFont;
   i: integer;
@@ -3962,12 +5289,11 @@ begin
   end;
   F := Fonts.AddFontDef;
   F.Name := AName;
-  F.Color := AColor;
   F.IsStdFont := True;
   Result := Fonts.Count-1;
 end;
 
-function TPDFDocument.AddFont(AFontFile: String; AName: String; AColor: TARGBColor): Integer;
+function TPDFDocument.AddFont(AFontFile: String; AName: String): Integer;
 var
   F: TPDFFont;
   i: integer;
@@ -3991,7 +5317,6 @@ begin
     lFName := IncludeTrailingPathDelimiter(FontDirectory)+AFontFile;
   F.FontFile := lFName;
   F.Name := AName;
-  F.Color := AColor;
   F.IsStdFont := False;
   Result := Fonts.Count-1;
 end;
@@ -4011,5 +5336,6 @@ begin
 end;
 
 
+
 end.
 
diff --git a/packages/fcl-pdf/src/fpttf.pp b/packages/fcl-pdf/src/fpttf.pp
index ba2bee7677..418de79732 100644
--- a/packages/fcl-pdf/src/fpttf.pp
+++ b/packages/fcl-pdf/src/fpttf.pp
@@ -1,11 +1,22 @@
 {
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 by Graeme Geldenhuys
+
     Description:
       This is a homegrown font cache. The fpReport reports can reference
       a font by its name. The job of the font cache is to look through
       its cached fonts to match the font name, and which *.ttf file it
       relates too. The reporting code can then extract font details
       correctly (eg: font width, height etc).
-}
+
+    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 fpTTF;
 
 {$mode objfpc}{$H+}
@@ -38,12 +49,19 @@ type
     FFileInfo: TTFFileInfo;
     FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
     FPostScriptName: string;
+    FHumanFriendlyName: string; // aka FullName
+    procedure   DoLoadFileInfo;
+    procedure   LoadFileInfo;
     procedure   BuildFontCacheItem;
     procedure   SetStyleIfExists(var AText: string; var AStyleFlags: TTrueTypeFontStyles; const AStyleName: String; const AStyle: TTrueTypeFontStyle);
     function    GetIsBold: boolean;
     function    GetIsFixedWidth: boolean;
     function    GetIsItalic: boolean;
     function    GetIsRegular: boolean;
+    function    GetFamilyName: String;
+    function    GetPostScriptName: string;
+    function    GetHumanFriendlyName: string;
+    function    GetFileInfo: TTFFileInfo;
   public
     constructor Create(const AFilename: String);
     destructor  Destroy; override;
@@ -52,9 +70,10 @@ type
     { Result is in pixels }
     function    TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
     property    FileName: String read FFileName;
-    property    FamilyName: String read FFamilyName;
-    property    PostScriptName: string read FPostScriptName;
-    property    FontData: TTFFileInfo read FFileInfo;
+    property    FamilyName: String read GetFamilyName;
+    property    PostScriptName: string read GetPostScriptName;
+    property    HumanFriendlyName: string read GetHumanFriendlyName;
+    property    FontData: TTFFileInfo read GetFileInfo;
     { A bitmasked value describing the full font style }
     property    StyleFlags: TTrueTypeFontStyles read FStyleFlags;
     { IsXXX properties are convenience properties, internally querying StyleFlags. }
@@ -67,6 +86,7 @@ type
 
   TFPFontCacheList = class(TObject)
   private
+    FBuildFontCacheIgnoresErrors: Boolean;
     FList: TObjectList;
     FSearchPath: TStringList;
     FDPI: integer;
@@ -85,6 +105,8 @@ type
     function    Add(const AObject: TFPFontCacheItem): integer;
     procedure   AssignFontList(const AStrings: TStrings);
     procedure   Clear;
+    procedure   LoadFromFile(const AFilename: string);
+    procedure   ReadStandardFonts;
     property    Count: integer read GetCount;
     function    IndexOf(const AObject: TFPFontCacheItem): integer;
     function    Find(const AFontCacheItem: TFPFontCacheItem): integer; overload;
@@ -95,6 +117,7 @@ type
     property    Items[AIndex: Integer]: TFPFontCacheItem read GetItem write SetItem; default;
     property    SearchPath: TStringList read FSearchPath;
     property    DPI: integer read FDPI write SetDPI;
+    Property    BuildFontCacheIgnoresErrors : Boolean Read FBuildFontCacheIgnoresErrors Write FBuildFontCacheIgnoresErrors;
   end;
 
 
@@ -102,10 +125,18 @@ function gTTFontCache: TFPFontCacheList;
 
 implementation
 
+uses
+  DOM
+  ,XMLRead
+  {$ifdef mswindows}
+  ,Windows  // for SHGetFolderPath API call used by gTTFontCache.ReadStandardFonts() method
+  {$endif}
+  ;
+
 resourcestring
   rsNoSearchPathDefined = 'No search path was defined';
   rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
-  rsCharAboveWord = 'TextWidth doesn''t support characters higher then High(Word) - %d.';
+  rsMissingFontFile = 'The font file <%s> can''t be found.';
 
 var
   uFontCacheList: TFPFontCacheList;
@@ -121,26 +152,72 @@ end;
 
 { TFPFontCacheItem }
 
+procedure TFPFontCacheItem.DoLoadFileInfo;
+begin
+  if not Assigned(FFileInfo) then
+    LoadFileInfo;
+end;
+
+procedure TFPFontCacheItem.LoadFileInfo;
+begin
+  if FileExists(FFilename) then
+  begin
+    FFileInfo := TTFFileInfo.Create;
+    FFileInfo.LoadFromFile(FFilename);
+    BuildFontCacheItem;
+  end
+  else
+    raise ETTF.CreateFmt(rsMissingFontFile, [FFilename]);
+end;
+
 function TFPFontCacheItem.GetIsBold: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsBold in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsFixedWidth: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsFixedWidth in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsItalic: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsItalic in FStyleFlags;
 end;
 
 function TFPFontCacheItem.GetIsRegular: boolean;
 begin
+  DoLoadFileInfo;
   Result := fsRegular in FStyleFlags;
 end;
 
+function TFPFontCacheItem.GetFamilyName: String;
+begin
+  DoLoadFileInfo;
+  Result := FFamilyName;
+end;
+
+function TFPFontCacheItem.GetPostScriptName: string;
+begin
+  DoLoadFileInfo;
+  Result := FPostScriptName;
+end;
+
+function TFPFontCacheItem.GetHumanFriendlyName: string;
+begin
+  DoLoadFileInfo;
+  Result := FHumanFriendlyName;
+end;
+
+function TFPFontCacheItem.GetFileInfo: TTFFileInfo;
+begin
+  DoLoadFileInfo;
+  Result := FFileInfo;
+end;
+
 procedure TFPFontCacheItem.BuildFontCacheItem;
 var
   s: string;
@@ -150,6 +227,7 @@ begin
   FFamilyName := FFileInfo.FamilyName;
   if Pos(s, FFamilyName) = 1 then
     Delete(s, 1, Length(FFamilyName));
+  FHumanFriendlyName := FFileInfo.HumanFriendlyName;
 
   FStyleFlags := [fsRegular];
 
@@ -192,13 +270,6 @@ begin
 
   if AFileName = '' then
     raise ETTF.Create(rsNoFontFileName);
-
-  if FileExists(AFilename) then
-  begin
-    FFileInfo := TTFFileInfo.Create;
-    FFileInfo.LoadFromFile(AFilename);
-    BuildFontCacheItem;
-  end;
 end;
 
 destructor TFPFontCacheItem.Destroy;
@@ -240,6 +311,7 @@ var
   s: string;
   {$ENDIF}
 begin
+  DoLoadFileInfo;
   Result := 0;
   if Length(AStr) = 0 then
     Exit;
@@ -281,6 +353,7 @@ end;
 
 function TFPFontCacheItem.TextHeight(const AText: utf8string; const APointSize: single; out ADescender: single): single;
 begin
+  DoLoadFileInfo;
   { Both lHeight and lDescenderHeight are in pixels }
   Result := FFileInfo.CapHeight * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm);
   ADescender := Abs(FFileInfo.Descender) * APointSize * gTTFontCache.DPI / (72 * FFileInfo.Head.UnitsPerEm);
@@ -294,7 +367,7 @@ var
   lFont: TFPFontCacheItem;
   s: String;
 begin
-  if FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
+  if SysUtils.FindFirst(AFontPath + AllFilesMask, faAnyFile, sr) = 0 then
   begin
     repeat
       // check if special files to skip
@@ -309,13 +382,18 @@ begin
         if (lowercase(ExtractFileExt(s)) = '.ttf') or
            (lowercase(ExtractFileExt(s)) = '.otf') then
         begin
-          lFont := TFPFontCacheItem.Create(AFontPath + s);
-          Add(lFont);
+          try
+            lFont := TFPFontCacheItem.Create(AFontPath + s);
+            Add(lFont);
+          except
+            if not FBuildFontCacheIgnoresErrors then
+              Raise;
+          end;
         end;
       end;
-    until FindNext(sr) <> 0;
+    until SysUtils.FindNext(sr) <> 0;
   end;
-  FindClose(sr);
+  SysUtils.FindClose(sr);
 end;
 
 procedure TFPFontCacheList.SetDPI(AValue: integer);
@@ -401,6 +479,96 @@ begin
   FList.Clear;
 end;
 
+procedure TFPFontCacheList.LoadFromFile(const AFilename: string);
+var
+  sl: TStringList;
+  i: integer;
+begin
+  sl := TStringList.Create;
+  try
+    sl.LoadFromFile(AFilename);
+    for i := 0 to sl.Count-1 do
+      Add(TFPFontCacheItem.Create(sl[i]));
+  finally
+    sl.Free;
+  end;
+end;
+
+{ This is operating system dependent. Our default implementation only supports
+  Linux, FreeBSD, Windows and OSX. On other platforms, no fonts will be loaded,
+  until a implementation is created.
+
+  NOTE:
+    This is definitely not a perfect solution, especially due to the inconsistent
+    implementations and locations of files under various Linux distros. But it's
+    the best we can do for now. }
+procedure TFPFontCacheList.ReadStandardFonts;
+
+  {$ifdef linux}
+    {$define HasFontsConf}
+    const
+      cFontsConf = '/etc/fonts/fonts.conf';
+  {$endif}
+
+  {$ifdef freebsd}
+    {$define HasFontsConf}
+    const
+      cFontsConf = '/usr/local/etc/fonts/fonts.conf';
+  {$endif}
+
+  {$ifdef mswindows}
+  function GetWinDir: string;
+  var
+    dir: array [0..MAX_PATH] of Char;
+  begin
+    GetWindowsDirectory(dir, MAX_PATH);
+    Result := StrPas(dir);
+  end;
+  {$endif}
+
+{$ifdef HasFontsConf}
+var
+  doc: TXMLDocument;
+  lChild: TDOMNode;
+  lDir: string;
+{$endif}
+begin
+  {$ifdef HasFontsConf} // Linux & FreeBSD
+  ReadXMLFile(doc, cFontsConf);
+  try
+    lChild := doc.DocumentElement.FirstChild;
+    while Assigned(lChild) do
+    begin
+      if lChild.NodeName = 'dir' then
+      begin
+        if lChild.FirstChild.NodeValue = '~/.fonts' then
+          lDir := ExpandFilename(lChild.FirstChild.NodeValue)
+        else
+          lDir := lChild.FirstChild.NodeValue;
+        SearchPath.Add(lDir);
+//        writeln(lDir);
+      end;
+      lChild := lChild.NextSibling;
+    end;
+  finally
+    doc.Free;
+  end;
+  {$endif}
+
+  {$ifdef mswindows}
+  SearchPath.Add(GetWinDir);
+  {$endif}
+
+  {$ifdef darwin} // OSX
+  { As per Apple Support page: https://support.apple.com/en-us/HT201722 }
+  SearchPath.Add('/System/Library/Fonts/');
+  SearchPath.Add('/Library/Fonts/');
+  SearchPath.Add(ExpandFilename('~/Library/Fonts/'));
+  {$endif}
+
+  BuildFontCache;
+end;
+
 function TFPFontCacheList.IndexOf(const AObject: TFPFontCacheItem): integer;
 begin
   Result := FList.IndexOf(AObject);
diff --git a/packages/fcl-pdf/src/fpttfsubsetter.pp b/packages/fcl-pdf/src/fpttfsubsetter.pp
new file mode 100644
index 0000000000..1bf107b6f2
--- /dev/null
+++ b/packages/fcl-pdf/src/fpttfsubsetter.pp
@@ -0,0 +1,1259 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2016 by Graeme Geldenhuys
+
+    This unit creates a new TTF subset font file, reducing the file
+    size in the process. This is primarily so the new font file can
+    be embedded in PDF documents.
+
+    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 fpTTFSubsetter;
+
+{$mode objfpc}{$H+}
+
+{ $R+}
+
+// enable this define for more verbose output
+{.$define gdebug}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  contnrs,
+  fpparsettf,
+  FPFontTextMapping;
+
+type
+  ETTFSubsetter = class(Exception);
+
+  TArrayUInt32 = array of UInt32;
+
+  // forward declaration
+  TGIDList = class;
+  TGIDListEnumerator = class;
+
+
+  TFontSubsetter = class(TObject)
+  private
+    FPrefix: string;
+    FHasAddedCompoundReferences: boolean;  // one glyph made up of multiple glyphs
+    FKeepTables: TStrings;
+    FFontInfo: TTFFileInfo;
+    FGlyphIDList: TTextMappingList;
+    FStream: TFileStream; // original TTF file
+    FGlyphLocations: array of UInt32;
+    FGlyphIDs: TGIDList;
+    function    Int32HighestOneBit(const AValue: integer): integer;
+    function    Int32Log2(const AValue: integer): integer;
+    function    ToUInt32(const AHigh, ALow: UInt32): UInt32;
+    function    ToUInt32(const ABytes: AnsiString): UInt32;
+    function    GetRawTable(const ATableName: AnsiString): TMemoryStream;
+    function    WriteFileHeader(AOutStream: TStream; const nTables: integer): uint32;
+    function    WriteTableHeader(AOutStream: TStream; const ATag: AnsiString; const AOffset: UInt32; const AData: TStream): int64;
+    function    GetNewGlyphId(const OldGid: integer): Integer;
+    procedure   WriteTableBodies(AOutStream: TStream; const ATables: TStringList);
+    procedure   UpdateOrigGlyphIDList;
+    // AGlyphID is the original GlyphID in the original TTF file
+    function    GetCharIDfromGlyphID(const AGlyphID: uint32): uint32;
+    { Copy glyph data as-is for a specific glyphID. }
+    function    GetRawGlyphData(const AGlyphID: UInt16): TMemoryStream;
+    procedure   LoadLocations;
+    // Stream writing functions.
+    procedure   WriteInt16(AStream: TStream; const AValue: Int16); inline;
+    procedure   WriteUInt16(AStream: TStream; const AValue: UInt16); inline;
+    procedure   WriteInt32(AStream: TStream; const AValue: Int32); inline;
+    procedure   WriteUInt32(AStream: TStream; const AValue: UInt32); inline;
+    function    ReadInt16(AStream: TStream): Int16; inline;
+    function    ReadUInt32(AStream: TStream): UInt32; inline;
+    function    ReadUInt16(AStream: TStream): UInt16; inline;
+
+    procedure   AddCompoundReferences;
+    function    buildHeadTable: TStream;
+    function    buildHheaTable: TStream;
+    function    buildMaxpTable: TStream;
+    function    buildFpgmTable: TStream;
+    function    buildPrepTable: TStream;
+    function    buildCvtTable: TStream;
+    function    buildGlyfTable(var newOffsets: TArrayUInt32): TStream;
+    function    buildLocaTable(var newOffsets: TArrayUInt32): TStream;
+    function    buildCmapTable: TStream;
+    function    buildHmtxTable: TStream;
+  public
+    constructor Create(const AFont: TTFFileInfo; const AGlyphIDList: TTextMappingList);
+    constructor Create(const AFont: TTFFileInfo);
+    destructor  Destroy; override;
+    procedure   SaveToFile(const AFileName: String);
+    procedure   SaveToStream(const AStream: TStream);
+    // Add the given Unicode codepoint to the subset.
+    procedure   Add(const ACodePoint: uint32);
+    // The prefix to add to the font's PostScript name.
+    property    Prefix: string read FPrefix write FPrefix;
+  end;
+
+
+  TGIDItem = class(TObject)
+  private
+    FGID: integer;
+    FGlyphData: TMemoryStream;
+    FIsCompoundGlyph: boolean;
+    FNewGID: integer;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    property    IsCompoundGlyph: boolean read FIsCompoundGlyph write FIsCompoundGlyph;
+    property    GID: integer read FGID write FGID;
+    property    GlyphData: TMemoryStream read FGlyphData write FGlyphData;
+    property    NewGID: integer read FNewGID write FNewGID;
+  end;
+
+
+  TGIDList = class(TObject)
+  private
+    FList: TFPObjectList;
+    function    GetCount: integer;
+    function    GetItems(i: integer): TGIDItem;
+    procedure   SetItems(i: integer; const AValue: TGIDItem);
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    function    Add(const GID: Integer): integer; overload;
+    function    Add(const AObject: TGIDItem): integer; overload;
+    procedure   Clear;
+    function    Contains(const GID: integer): boolean;
+    function    GetEnumerator: TGIDListEnumerator;
+    function    GetNewGlyphID(const OriginalGID: integer): integer;
+    procedure   Sort;
+    property    Count: integer read GetCount;
+    property    Items[i: integer]: TGIDItem read GetItems write SetItems; default;
+  end;
+
+
+  TGIDListEnumerator = class(TObject)
+  private
+    FIndex: Integer;
+    FList: TGIDList;
+  public
+    constructor Create(AList: TGIDList);
+    function    GetCurrent: TGIDItem;
+    function    MoveNext: Boolean;
+    property    Current: TGIDItem read GetCurrent;
+  end;
+
+
+
+
+implementation
+
+uses
+  math;
+
+resourcestring
+  rsErrFontInfoNotAssigned = 'FontInfo was not assigned';
+  rsErrFailedToReadFromStream = 'Failed to read from file stream';
+  rsErrCantFindFontFile = 'Can''t find the actual TTF font file.';
+  rsErrGlyphLocationsNotLoaded = 'Glyph Location data has not been loaded yet.';
+
+const
+  PAD_BUF: array[ 1..3 ] of Byte = ( $0, $0, $0 );
+
+
+{ TFontSubsetter }
+
+{ The method simply returns the int value with a single one-bit, in the position
+  of the highest-order one-bit in the specified value, or zero if the specified
+  value is itself equal to zero. }
+function TFontSubsetter.Int32HighestOneBit(const AValue: integer): integer;
+var
+  i: integer;
+begin
+  i := AValue;
+  i := i or (i shr 1);
+  i := i or (i shr 2);
+  i := i or (i shr 4);
+  i := i or (i shr 8);
+  i := i or (i shr 16);
+//  i := i or (i shr 32);
+  Result := i - (i shr 1);
+end;
+
+function TFontSubsetter.Int32Log2(const AValue: integer): integer;
+begin
+  if AValue <= 0 then
+    raise Exception.Create('Illegal argument');
+//  Result :=  31 - Integer.numberOfLeadingZeros(n);
+
+  Result := Floor(Log10(AValue) / Log10(2));
+end;
+
+function TFontSubsetter.ToUInt32(const AHigh, ALow: UInt32): UInt32;
+begin
+  result := ((AHigh and $FFFF) shl 16) or (ALow and $FFFF);
+end;
+
+function TFontSubsetter.ToUInt32(const ABytes: AnsiString): UInt32;
+var
+  b: array of Byte absolute ABytes;
+begin
+  Result := (b[0] and $FF) shl 24
+           or (b[1] and $FF) shl 16
+           or (b[2] and $FF) shl 8
+           or (b[3] and $FF);
+end;
+
+function TFontSubsetter.GetRawTable(const ATableName: AnsiString): TMemoryStream;
+var
+  lEntry: TTableDirectoryEntry;
+begin
+  Result := nil;
+  FillMem(@lEntry, SizeOf(TTableDirectoryEntry), 0);
+  if not FFontInfo.GetTableDirEntry(ATableName, lEntry) then
+    Exit;
+
+  Result := TMemoryStream.Create;
+  FStream.Seek(lEntry.offset, soFromBeginning);
+  if Result.CopyFrom(FStream, lEntry.Length) <> lEntry.Length then
+    raise ETTF.Create('GetRawTable: ' + rsErrFailedToReadFromStream);
+end;
+
+{ AOutStream: the data output stream.
+  nTables: the number of font tables.
+  result: the file offset of the first TTF table to write. }
+function TFontSubsetter.WriteFileHeader(AOutStream: TStream; const nTables: integer): uint32;
+var
+  mask: integer;
+  searchRange: integer;
+  entrySelector: integer;
+  rangeShift: integer;
+begin
+  WriteUInt32(AOutStream, $00010000);
+  WriteUInt16(AOutStream, nTables);
+
+  mask := Int32HighestOneBit(nTables);
+  searchRange := mask * 16;
+  WriteUInt16(AOutStream, searchRange);
+
+  entrySelector := Int32Log2(mask);
+  WriteUInt16(AOutStream, entrySelector);
+
+  rangeShift := 16 * nTables - searchRange;
+  WriteUInt16(AOutStream, rangeShift);
+
+  result := $00010000 + ToUInt32(nTables, searchRange) + ToUInt32(entrySelector, rangeShift);
+end;
+
+function TFontSubsetter.WriteTableHeader(AOutStream: TStream; const ATag: AnsiString; const AOffset: UInt32;
+  const AData: TStream): int64;
+var
+  checksum: Int64;
+  n: integer;
+  lByte: Byte;
+begin
+  AData.Position := 0;
+  checksum := 0;
+
+  for n := 0 to AData.Size-1 do
+  begin
+    lByte := AData.ReadByte;
+    checksum := checksum + (((lByte and $FF) shl 24) - n mod 4 * 8);
+  end;
+  checksum := checksum and $FFFFFFFF;
+
+  AOutStream.WriteBuffer(Pointer(ATag)^, 4); // Tag is always 4 bytes - written as-is, no NtoBE() required
+  WriteUInt32(AOutStream, checksum);
+  WriteUInt32(AOutStream, AOffset);
+  WriteUInt32(AOutStream, AData.Size);
+
+  {$ifdef gdebug}
+  writeln(Format('tag: "%s"  CRC: %8.8x  offset: %8.8x (%2:7d bytes)  size: %8.8x (%3:7d bytes)', [ATag, checksum, AOffset, AData.Size]));
+  {$endif}
+
+  // account for the checksum twice, once for the header field, once for the content itself
+  Result := ToUInt32(ATag) + checksum + checksum + AOffset + AData.Size;
+end;
+
+function TFontSubsetter.GetNewGlyphId(const OldGid: integer): Integer;
+var
+  itm: TGIDItem;
+begin
+  result := -1;
+  for itm in FGlyphIDs do
+  begin
+    if itm.GID = OldGID then
+    begin
+      Result := itm.NewGID;
+      exit;
+    end;
+  end;
+end;
+
+procedure TFontSubsetter.WriteTableBodies(AOutStream: TStream; const ATables: TStringList);
+var
+  i: integer;
+  n: uint64;
+  lData: TStream;
+begin
+  for i := 0 to ATables.Count-1 do
+  begin
+    lData := TStream(ATables.Objects[i]);
+    if lData <> nil then
+    begin
+      lData.Position := 0;
+      n := lData.Size;
+      AOutStream.CopyFrom(lData, lData.Size);
+    end;
+    if (n mod 4) <> 0 then
+    begin
+      {$ifdef gdebug}
+      writeln('Padding applied at the end of ', ATables[i], ': ', 4 - (n mod 4), ' byte(s)');
+      {$endif}
+      AOutStream.WriteBuffer(PAD_BUF, 4 - (n mod 4));
+    end;
+  end;
+end;
+
+{ This updates the original GlyphIDList passed in to the constructor - normally
+  done by fcl-pdf. This allows fcl-pdf to use the NewGlyphID values in its
+  generated PDF output. }
+procedure TFontSubsetter.UpdateOrigGlyphIDList;
+var
+  i: integer;
+  itm: TGIDItem;
+begin
+  for itm in FGlyphIDs do
+  begin
+    for i := 0 to FGlyphIDList.Count-1 do
+    begin
+      if FGlyphIDList[i].GlyphID = itm.GID then
+      begin
+        FGlyphIDList[i].NewGlyphID := itm.NewGID;
+        break;
+      end;
+    end;
+  end;
+end;
+
+function TFontSubsetter.GetCharIDfromGlyphID(const AGlyphID: uint32): uint32;
+var
+  i: integer;
+begin
+  Result := 0;
+  for i := 0 to Length(FFontInfo.Chars)-1 do
+    if FFontInfo.Chars[i] = AGlyphID then
+    begin
+      Result := i;
+      Exit;
+    end;
+end;
+
+function TFontSubsetter.GetRawGlyphData(const AGlyphID: UInt16): TMemoryStream;
+var
+  lGlyf: TTableDirectoryEntry;
+  lSize: UInt16;
+begin
+  Result := nil;
+  if Length(FGlyphLocations) < 2 then
+    raise ETTF.Create(rsErrGlyphLocationsNotLoaded);
+  FillMem(@lGlyf, SizeOf(TTableDirectoryEntry), 0);
+  FFontInfo.GetTableDirEntry(TTFTableNames[ttglyf], lGlyf);
+
+  lSize := FGlyphLocations[AGlyphID+1] - FGlyphLocations[AGlyphID];
+  Result := TMemoryStream.Create;
+  if lSize > 0 then
+  begin
+    FStream.Seek(lGlyf.offset + FGlyphLocations[AGlyphID], soFromBeginning);
+    if Result.CopyFrom(FStream, lSize) <> lSize then
+      raise ETTF.Create('GetRawGlyphData: ' + rsErrFailedToReadFromStream)
+    else
+      Result.Position := 0;
+  end;
+end;
+
+procedure TFontSubsetter.LoadLocations;
+var
+  lLocaEntry: TTableDirectoryEntry;
+  lGlyf: TTableDirectoryEntry;
+  ms: TMemoryStream;
+  numLocations: integer;
+  n: integer;
+begin
+  FillMem(@lGlyf, SizeOf(TTableDirectoryEntry), 0);
+  FillMem(@lLocaEntry, SizeOf(TTableDirectoryEntry), 0);
+
+  FFontInfo.GetTableDirEntry(TTFTableNames[ttglyf], lGlyf);
+  if FFontInfo.GetTableDirEntry(TTFTableNames[ttloca], lLocaEntry) then
+  begin
+    ms := TMemoryStream.Create;
+    try
+      FStream.Seek(lLocaEntry.offset, soFromBeginning);
+      if ms.CopyFrom(FStream, lLocaEntry.Length) <> lLocaEntry.Length then
+        raise ETTF.Create('LoadLocations: ' + rsErrFailedToReadFromStream)
+      else
+        ms.Position := 0;
+
+      if FFontInfo.Head.IndexToLocFormat = 0 then
+      begin
+        // Short offsets
+        numLocations := lLocaEntry.Length shr 1;
+        {$IFDEF gDEBUG}
+        Writeln('Number of Glyph locations ( 16 bits offsets ): ', numLocations );
+        {$ENDIF}
+        SetLength(FGlyphLocations, numLocations);
+        for n := 0 to numLocations-1 do
+          FGlyphLocations[n] := BEtoN(ms.ReadWord) * 2;
+      end
+      else
+      begin
+        // Long offsets
+        numLocations := lLocaEntry.Length shr 2;
+        {$IFDEF gDEBUG}
+        Writeln('Number of Glyph locations ( 32 bits offsets ): ', numLocations );
+        {$ENDIF}
+        SetLength(FGlyphLocations, numLocations);
+        for n := 0 to numLocations-1 do
+          FGlyphLocations[n] := BEtoN(ms.ReadDWord);
+      end;
+    finally
+      ms.Free;
+    end;
+  end
+  else
+  begin
+    {$ifdef gDEBUG}
+    Writeln('WARNING: ''loca'' table is not found.');
+    {$endif}
+  end;
+end;
+
+procedure TFontSubsetter.WriteInt16(AStream: TStream; const AValue: Int16);
+begin
+  AStream.WriteBuffer(NtoBE(AValue), 2);
+end;
+
+procedure TFontSubsetter.WriteUInt16(AStream: TStream; const AValue: UInt16);
+begin
+  AStream.WriteWord(NtoBE(AValue));
+end;
+
+procedure TFontSubsetter.WriteInt32(AStream: TStream; const AValue: Int32);
+begin
+  AStream.WriteBuffer(NtoBE(AValue), 4);
+end;
+
+procedure TFontSubsetter.WriteUInt32(AStream: TStream; const AValue: UInt32);
+begin
+  AStream.WriteDWord(NtoBE(AValue));
+end;
+
+function TFontSubsetter.ReadInt16(AStream: TStream): Int16;
+begin
+  Result:=Int16(ReadUInt16(AStream));
+end;
+
+function TFontSubsetter.ReadUInt32(AStream: TStream): UInt32;
+begin
+  Result:=0;
+  AStream.ReadBuffer(Result,SizeOf(Result));
+  Result:=BEtoN(Result);
+end;
+
+function TFontSubsetter.ReadUInt16(AStream: TStream): UInt16;
+begin
+  Result:=0;
+  AStream.ReadBuffer(Result,SizeOf(Result));
+  Result:=BEtoN(Result);
+end;
+
+procedure TFontSubsetter.AddCompoundReferences;
+var
+  GlyphIDsToAdd: TStringList;
+  n: integer;
+  gs: TMemoryStream;
+  buf: TGlyphHeader;
+  i: integer;
+  flags: uint16;
+  glyphIndex: uint16;
+  hasNested: boolean;
+begin
+  if FHasAddedCompoundReferences then
+    Exit;
+  FHasAddedCompoundReferences := True;
+
+  LoadLocations;
+
+  repeat
+    GlyphIDsToAdd := TStringList.Create;
+    GlyphIDsToAdd.Duplicates := dupIgnore;
+    GlyphIDsToAdd.Sorted := True;
+
+    for n := 0 to FGlyphIDs.Count-1 do
+    begin
+      if not Assigned(FGlyphIDs[n].GlyphData) then
+        FGlyphIDs[n].GlyphData := GetRawGlyphData(FGlyphIDs[n].GID);
+      gs := FGlyphIDs[n].GlyphData;
+      gs.Position := 0;
+
+      if gs.Size > 0 then
+      begin
+        FillMem(@buf, SizeOf(TGlyphHeader), 0);
+        gs.ReadBuffer(buf, SizeOf(Buf));
+        {$IFDEF gDEBUG}
+        writeln('   glyph data size: ', gs.Size);
+        {$ENDIF}
+
+        if buf.numberOfContours = -1 then
+        begin
+          FGlyphIDs[n].IsCompoundGlyph := True;
+          {$IFDEF gDEBUG}
+          writeln('   numberOfContours: ', buf.numberOfContours);
+          {$ENDIF}
+          repeat
+            flags := ReadUInt16(gs);
+            glyphIndex := ReadUInt16(gs);
+            // find compound glyph IDs and add them to the GlyphIDsToAdd list
+            if not FGlyphIDs.Contains(glyphIndex) then
+            begin
+              {$IFDEF gDEBUG}
+              writeln(Format('      glyphIndex: %.4x (%0:d) ', [glyphIndex]));
+              {$ENDIF}
+              GlyphIDsToAdd.Add(IntToStr(glyphIndex));
+            end;
+            // ARG_1_AND_2_ARE_WORDS
+            if (flags and (1 shl 0)) <> 0 then
+              ReadUInt32(gs)
+            else
+              ReadUInt16(gs);
+            // WE_HAVE_A_TWO_BY_TWO
+            if (flags and (1 shl 7)) <> 0 then
+            begin
+              ReadUInt32(gs);
+              ReadUInt32(gs);
+            end
+            // WE_HAVE_AN_X_AND_Y_SCALE
+            else if (flags and (1 shl 6)) <> 0 then
+            begin
+              ReadUInt32(gs);
+            end
+            // WE_HAVE_A_SCALE
+            else if (flags and (1 shl 3)) <> 0 then
+            begin
+              ReadUInt16(gs);
+            end;
+
+          until (flags and (1 shl 5)) = 0;   // MORE_COMPONENTS
+        end;  { if buf.numberOfContours = -1 }
+      end;  { if gs.Size > 0 }
+    end; { for n ... FGlyphIDs.Count-1 }
+
+    if GlyphIDsToAdd.Count > 0 then
+    begin
+      for i := 0 to GlyphIDsToAdd.Count-1 do
+      begin
+        glyphIndex := StrToInt(GlyphIDsToAdd[i]);
+        FGlyphIDs.Add(glyphIndex);
+      end;
+    end;
+    hasNested := GlyphIDsToAdd.Count > 0;
+    {$IFDEF gDEBUG}
+    if hasNested then
+      writeln('------------------');
+    {$ENDIF}
+    FreeAndNil(GlyphIDsToAdd);
+  until (hasNested = false);
+end;
+
+function TFontSubsetter.buildHeadTable: TStream;
+var
+  t: THead;
+  rec: THead;
+  i: Integer;
+begin
+  Result := TMemoryStream.Create;
+
+  t := FFontInfo.Head;
+  FillMem(@rec, SizeOf(THead), 0);
+  rec.FileVersion.Version := NtoBE(t.FileVersion.Version);
+  rec.FontRevision.Version := NtoBE(t.FontRevision.Version);
+  rec.CheckSumAdjustment := 0;
+  rec.MagicNumber := NtoBE(t.MagicNumber);
+  rec.Flags := NtoBE(t.Flags);
+  rec.UnitsPerEm := NtoBE(t.UnitsPerEm);
+  rec.Created := NtoBE(t.Created);
+  rec.Modified := NtoBE(t.Modified);
+  For i := 0 to 3 do
+    rec.BBox[i] := NtoBE(t.BBox[i]);
+  rec.MacStyle := NtoBE(t.MacStyle);
+  rec.LowestRecPPEM := NtoBE(t.LowestRecPPEM);
+  rec.FontDirectionHint := NtoBE(t.FontDirectionHint);
+  // force long format of 'loca' table. ie: 'loca' table offsets are in 4-Bytes each, not Words.
+  rec.IndexToLocFormat := NtoBE(Int16(1)); //NtoBE(t.IndexToLocFormat);
+  rec.glyphDataFormat := NtoBE(t.glyphDataFormat);
+
+  Result.WriteBuffer(rec, SizeOf(THead));
+end;
+
+function TFontSubsetter.buildHheaTable: TStream;
+var
+  t: THHead;
+  rec: THHead;
+  hmetrics: UInt16;
+begin
+  Result := TMemoryStream.Create;
+
+  t := FFontInfo.HHead;
+  FillMem(@rec, SizeOf(THHead), 0);
+  rec.TableVersion.Version := NtoBE(t.TableVersion.Version);
+  rec.Ascender := NtoBE(t.Ascender);
+  rec.Descender := NtoBE(t.Descender);
+  rec.LineGap := NtoBE(t.LineGap);
+  rec.AdvanceWidthMax := NtoBE(t.AdvanceWidthMax);
+  rec.MinLeftSideBearing := NtoBE(t.MinLeftSideBearing);
+  rec.MinRightSideBearing := NtoBE(t.MinRightSideBearing);
+  rec.XMaxExtent := NtoBE(t.XMaxExtent);
+  rec.CaretSlopeRise := NtoBE(t.CaretSlopeRise);
+  rec.CaretSlopeRun := NtoBE(t.CaretSlopeRun);
+  rec.caretOffset := NtoBE(t.caretOffset);
+  rec.metricDataFormat := NtoBE(t.metricDataFormat);
+//  rec.numberOfHMetrics := NtoBE(t.numberOfHMetrics);
+
+  hmetrics := FGlyphIDs.Count;
+  if (FGlyphIDs.Items[FGlyphIDs.Count-1].GID >= t.numberOfHMetrics) and (not FGlyphIDs.Contains(t.numberOfHMetrics-1)) then
+    inc(hmetrics);
+  rec.numberOfHMetrics := NtoBE(hmetrics);
+
+  Result.WriteBuffer(rec, SizeOf(THHead));
+end;
+
+function TFontSubsetter.buildMaxpTable: TStream;
+var
+  t: TMaxP;
+  rec: TMaxP;
+  lCount: word;
+begin
+  Result := TMemoryStream.Create;
+
+  t := FFontInfo.MaxP;
+  FillMem(@rec, SizeOf(TMaxP), 0);
+  rec.VersionNumber.Version := NtoBE(t.VersionNumber.Version);
+
+  lCount := FGlyphIDs.Count;
+  rec.numGlyphs := NtoBE(lCount);
+
+  rec.maxPoints := NtoBE(t.maxPoints);
+  rec.maxContours := NtoBE(t.maxContours);
+  rec.maxCompositePoints := NtoBE(t.maxCompositePoints);
+  rec.maxCompositeContours := NtoBE(t.maxCompositeContours);
+  rec.maxZones := NtoBE(t.maxZones);
+  rec.maxTwilightPoints := NtoBE(t.maxTwilightPoints);
+  rec.maxStorage := NtoBE(t.maxStorage);
+  rec.maxFunctionDefs := NtoBE(t.maxFunctionDefs);
+  rec.maxInstructionDefs := NtoBE(t.maxInstructionDefs);
+  rec.maxStackElements := NtoBE(t.maxStackElements);
+  rec.maxSizeOfInstructions := NtoBE(t.maxSizeOfInstructions);
+  rec.maxComponentElements := NtoBE(t.maxComponentElements);
+  rec.maxComponentDepth := NtoBE(t.maxComponentDepth);
+
+  Result.WriteBuffer(rec, SizeOf(TMaxP));
+end;
+
+function TFontSubsetter.buildFpgmTable: TStream;
+begin
+  Result := GetRawTable('fpgm');
+  Result.Position := 0;
+end;
+
+function TFontSubsetter.buildPrepTable: TStream;
+begin
+  Result := GetRawTable('prep');
+  Result.Position := 0;
+end;
+
+function TFontSubsetter.buildCvtTable: TStream;
+begin
+  Result := GetRawTable('cvt ');
+  Result.Position := 0;
+end;
+
+function TFontSubsetter.buildGlyfTable(var newOffsets: TArrayUInt32): TStream;
+var
+  n: integer;
+  lOffset: uint32;
+  lLen: uint32;
+  gs: TMemoryStream;
+  buf: TGlyphHeader;
+  flags: uint16;
+  glyphIndex: uint16;
+begin
+  lOffset := 0;
+  Result := TMemoryStream.Create;
+  LoadLocations;
+
+  {  - Assign new glyph indexes
+     - Retrieve glyph data if it doesn't yet exist (retrieved from original TTF file) }
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    FGlyphIDs[n].NewGID := n;
+    if not Assigned(FGlyphIDs[n].GlyphData) then
+      FGlyphIDs[n].GlyphData := GetRawGlyphData(FGlyphIDs[n].GID);
+  end;
+
+  {   - Now fix GlyphID references in Compound Glyphs to point to new GlyphIDs }
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    if not FGlyphIDs[n].IsCompoundGlyph then
+      Continue;
+    {$IFDEF gDEBUG}
+    writeln(Format('found compound glyph:  %.4x   glyphID: %d', [0, FGlyphIDs[n].GID]));
+    {$ENDIF}
+    gs := TMemoryStream(FGlyphIDs[n].GlyphData);
+    gs.Position := 0;
+
+    if gs.Size > 0 then
+    begin
+      FillMem(@buf, SizeOf(TGlyphHeader), 0);
+      gs.ReadBuffer(buf, SizeOf(Buf));
+
+      if buf.numberOfContours = -1 then
+      begin
+        repeat
+          flags := ReadUInt16(gs);
+          lOffset := gs.Position;
+          glyphIndex := ReadUInt16(gs);
+          // now write new GlyphID in it's place.
+          gs.Position := lOffset;
+          glyphIndex := FGlyphIDs.GetNewGlyphID(glyphIndex);
+          WriteUInt16(gs, glyphIndex);
+
+          // ARG_1_AND_2_ARE_WORDS
+          if (flags and (1 shl 0)) <> 0 then
+            ReadUInt32(gs)
+          else
+            ReadUInt16(gs);
+          // WE_HAVE_A_TWO_BY_TWO
+          if (flags and (1 shl 7)) <> 0 then
+          begin
+            ReadUInt32(gs);
+            ReadUInt32(gs);
+          end
+          // WE_HAVE_AN_X_AND_Y_SCALE
+          else if (flags and (1 shl 6)) <> 0 then
+          begin
+            ReadUInt32(gs);
+          end
+          // WE_HAVE_A_SCALE
+          else if (flags and (1 shl 3)) <> 0 then
+          begin
+            ReadUInt16(gs);
+          end;
+
+        until (flags and (1 shl 5)) = 0;   // MORE_COMPONENTS
+      end;  { if buf.numberOfContours = -1 }
+    end;  { if gs.Size > 0 }
+  end; { for n ... FGlyphIDList.Count-1 }
+
+  // write all glyph data to resulting data stream
+  lOffset := 0;
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    newOffsets[n] := lOffset;
+    lOffset := lOffset + FGlyphIDs[n].GlyphData.Size;
+    FGlyphIDs[n].GlyphData.Position := 0;
+    Result.CopyFrom(FGlyphIDs[n].GlyphData, FGlyphIDs[n].GlyphData.Size);
+    // 4-byte alignment
+    if (lOffset mod 4) <> 0 then
+    begin
+      lLen := 4 - (lOffset mod 4);
+      Result.WriteBuffer(PAD_BUF, lLen);
+      lOffset := lOffset + lLen;
+    end;
+  end;
+  newOffsets[n+1] := lOffset;
+end;
+
+// write as UInt32 as defined in head.indexToLocFormat field (long format).
+function TFontSubsetter.buildLocaTable(var newOffsets: TArrayUInt32): TStream;
+var
+  i: integer;
+begin
+  Result := TMemoryStream.Create;
+  for i := 0 to Length(newOffsets)-1 do
+    WriteUInt32(Result, newOffsets[i]);
+end;
+
+function TFontSubsetter.buildCmapTable: TStream;
+const
+    // platform
+    PLATFORM_UNICODE = 0;
+    PLATFORM_MACINTOSH = 1;
+    // value 2 is reserved; do not use
+    PLATFORM_WINDOWS = 3;
+
+    // Mac encodings
+    ENCODING_MAC_ROMAN = 0;
+
+    // Windows encodings
+    ENCODING_WIN_SYMBOL = 0; // Unicode, non-standard character set
+    ENCODING_WIN_UNICODE_BMP = 1; // Unicode BMP (UCS-2)
+    ENCODING_WIN_SHIFT_JIS = 2;
+    ENCODING_WIN_BIG5 = 3;
+    ENCODING_WIN_PRC = 4;
+    ENCODING_WIN_WANSUNG = 5;
+    ENCODING_WIN_JOHAB = 6;
+    ENCODING_WIN_UNICODE_FULL = 10; // Unicode Full (UCS-4)
+
+    // Unicode encodings
+    ENCODING_UNICODE_1_0 = 0;
+    ENCODING_UNICODE_1_1 = 1;
+    ENCODING_UNICODE_2_0_BMP = 3;
+    ENCODING_UNICODE_2_0_FULL = 4;
+var
+  segCount: UInt16;
+  searchRange: UInt16;
+  i: integer;
+  startCode: Array of Integer;
+  endCode: Array of Integer;
+  idDelta: Array of Integer;
+  lastChar: integer;
+  prevChar: integer;
+  lastGid: integer;
+  curGid: integer;
+  itm: TTextMapping;
+begin
+  Result := TMemoryStream.Create;
+  SetLength(startCode, FGlyphIDList.Count);
+  SetLength(endCode, FGlyphIDList.Count);
+  SetLength(idDelta, FGlyphIDList.Count);
+
+  // cmap header
+  WriteUInt16(Result, 0);  // version
+  WriteUInt16(Result, 1);  // numberSubTables
+
+  // encoding record
+  WriteUInt16(Result, PLATFORM_WINDOWS);  // platformID
+  WriteUInt16(Result, ENCODING_WIN_UNICODE_BMP);  // platformSpecificID
+  WriteUInt32(Result, 4 * 2 + 4); // offset
+
+  // build Format 4 subtable (Unicode BMP)
+  lastChar := 0;
+  prevChar := lastChar;
+  lastGid  := GetNewGlyphId(FGlyphIDList[0].GlyphID);
+  segCount := 0;
+
+  for i := 0 to FGlyphIDList.Count-1 do
+  begin
+    itm := FGlyphIDList[i];
+    if itm.CharID > $FFFF then
+      raise Exception.Create('non-BMP Unicode character');
+    curGid := GetNewGlyphId(itm.GlyphID);
+
+    if (itm.CharID <> FGlyphIDList[prevChar].CharID+1) or ((curGid - lastGid) <> (itm.CharID - FGlyphIDList[lastChar].CharID)) then
+    begin
+      if (lastGid <> 0) then
+      begin
+        { don't emit ranges, which map to GID 0, the undef glyph is emitted at the very last segment }
+        startCode[segCount] := FGlyphIDList[lastChar].CharID;
+        endCode[segCount] := FGlyphIDList[prevChar].CharID;
+        idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
+        inc(segCount);
+      end
+      else if not (FGlyphIDList[lastChar].CharID = FGlyphIDList[prevChar].CharID) then
+      begin
+        { shorten ranges which start with GID 0 by one }
+        startCode[segCount] := FGlyphIDList[lastChar].CharID + 1;
+        endCode[segCount] := FGlyphIDList[prevChar].CharID;
+        idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
+        inc(segCount);
+      end;
+      lastGid := curGid;
+      lastChar := i;
+    end;
+    prevChar := i;
+  end;
+
+  // trailing segment
+  startCode[segCount] := FGlyphIDList[lastChar].CharID;
+  endCode[segCount] := FGlyphIDList[prevChar].CharID;
+  idDelta[segCount] := lastGid - FGlyphIDList[lastChar].CharID;
+  inc(segCount);
+
+  // GID 0
+  startCode[segCount] := $FFFF;
+  endCode[segCount] := $FFFF;
+  idDelta[segCount] := 1;
+  inc(segCount);
+
+  // write format 4 subtable
+  searchRange := trunc(2 * Power(2, Floor(Log2(segCount))));
+  WriteUInt16(Result, 4); // format
+  WriteUInt16(Result, 8 * 2 + segCount * 4*2); // length
+  WriteUInt16(Result, 0); // language
+  WriteUInt16(Result, segCount * 2); // segCountX2
+  WriteUInt16(Result, searchRange); // searchRange
+  WriteUInt16(Result, trunc(log2(searchRange / 2))); // entrySelector
+  WriteUInt16(Result, 2 * segCount - searchRange); // rangeShift
+
+  // write endCode
+  for i := 0 to segCount-1 do
+    WriteUInt16(Result, endCode[i]);
+
+  // reservedPad
+  WriteUInt16(Result, 0);
+
+  // startCode
+  for i := 0 to segCount-1 do
+    WriteUInt16(Result, startCode[i]);
+
+  // idDelta
+  for i := 0 to segCount-1 do
+  begin
+    {$IFDEF gDEBUG}
+    writeln(Format(' idDelta[%d] = %d', [i, idDelta[i]]));
+    {$ENDIF}
+    WriteInt16(Result, idDelta[i]);
+  end;
+
+  // idRangeOffset
+  for i := 0 to segCount-1 do
+    WriteUInt16(Result, 0);
+end;
+
+function TFontSubsetter.buildHmtxTable: TStream;
+var
+  n: integer;
+begin
+  Result := TMemoryStream.Create;
+  for n := 0 to FGlyphIDs.Count-1 do
+  begin
+    WriteUInt16(Result, FFontInfo.Widths[FGlyphIDs[n].GID].AdvanceWidth);
+    WriteInt16(Result, FFontInfo.Widths[FGlyphIDs[n].GID].LSB);
+  end;
+end;
+
+constructor TFontSubsetter.Create(const AFont: TTFFileInfo; const AGlyphIDList: TTextMappingList);
+var
+  i: integer;
+begin
+  FFontInfo := AFont;
+  if not Assigned(FFontInfo) then
+    raise ETTFSubsetter.Create(rsErrFontInfoNotAssigned);
+  FGlyphIDList := AGlyphIDList;
+
+  FGlyphIDs := TGIDList.Create;
+  // always copy GID 0
+  FGlyphIDs.Add(0);
+
+  FKeepTables := TStringList.Create;
+  FHasAddedCompoundReferences := False;
+  FPrefix := '';
+
+  // create a default list
+  FKeepTables.Add('head');
+  FKeepTables.Add('hhea');
+  FKeepTables.Add('maxp');
+  FKeepTables.Add('hmtx');
+  FKeepTables.Add('cmap');
+  FKeepTables.Add('fpgm');
+  FKeepTables.Add('prep');
+  FKeepTables.Add('cvt ');
+  FKeepTables.Add('loca');
+  FKeepTables.Add('glyf');
+
+  if Assigned(FGlyphIDList) then
+  begin
+    FGlyphIDList.Sort;
+    for i := 0 to FGlyphIDList.Count-1 do
+      FGlyphIDs.Add(FGlyphIDList[i].GlyphID);
+  end;
+
+  if FFontInfo.Filename <> '' then
+    FStream := TFileStream.Create(FFontInfo.FileName, fmOpenRead or fmShareDenyNone)
+  else
+    raise ETTF.Create(rsErrCantFindFontFile);
+end;
+
+constructor TFontSubsetter.Create(const AFont: TTFFileInfo);
+begin
+  Create(AFont, nil);
+end;
+
+destructor TFontSubsetter.Destroy;
+var
+  i: integer;
+begin
+  // the owner of FGlyphIDList doesn't need the GlyphData information
+  for i := 0 to FGlyphIDList.Count-1 do
+    FGlyphIDList[i].GlyphData.Free;
+  FStream.Free;
+  FKeepTables.Free;
+  FreeAndNil(FGlyphIDs);
+  inherited Destroy;
+end;
+
+procedure TFontSubsetter.SaveToFile(const AFileName: String);
+var
+  fs: TFileStream;
+begin
+  fs := TFileStream.Create(AFileName, fmCreate);
+  try
+    SaveToStream(fs);
+  finally
+    FreeAndNil(fs);
+  end;
+end;
+
+procedure TFontSubsetter.SaveToStream(const AStream: TStream);
+var
+  checksum: int64;
+  offset: int64;
+  head: TStream;
+  hhea: TStream;
+  maxp: TStream;
+  hmtx: TStream;
+  cmap: TStream;
+  fpgm: TStream;
+  prep: TStream;
+  cvt: TStream;
+  loca: TStream;
+  glyf: TStream;
+  newLoca: TArrayUInt32;
+  tables: TStringList;
+  i: integer;
+  o: uint64;
+  p: uint64;
+  lPadding: byte;
+begin
+  FGlyphIDs.Sort;
+
+  // resolve compound glyph references
+  AddCompoundReferences;
+
+  // always copy GID 0
+  FGlyphIDList.Add(0, 0);
+  FGlyphIDList.Sort;
+
+  SetLength(newLoca, FGlyphIDs.Count+1);
+
+  head := buildHeadTable();
+  hhea := buildHheaTable();
+  maxp := buildMaxpTable();
+  fpgm := buildFpgmTable();
+  prep := buildPrepTable();
+  cvt  := buildCvtTable();
+  glyf := buildGlyfTable(newLoca);
+  loca := buildLocaTable(newLoca);
+  cmap := buildCmapTable();
+  hmtx := buildHmtxTable();
+
+  tables := TStringList.Create;
+  tables.CaseSensitive := True;
+  if Assigned(cmap) then
+    tables.AddObject('cmap', cmap);
+  if Assigned(glyf) then
+    tables.AddObject('glyf', glyf);
+  tables.AddObject('head', head);
+  tables.AddObject('hhea', hhea);
+  tables.AddObject('hmtx', hmtx);
+  if Assigned(loca) then
+    tables.AddObject('loca', loca);
+  tables.AddObject('maxp', maxp);
+  tables.AddObject('fpgm', fpgm);
+  tables.AddObject('prep', prep);
+  tables.AddObject('cvt ', cvt);
+  tables.Sort;
+
+  // calculate checksum
+  checksum := writeFileHeader(AStream, tables.Count);
+  offset := 12 + (16 * tables.Count);
+  lPadding := 0;
+  for i := 0 to tables.Count-1 do
+  begin
+    if tables.Objects[i] <> nil then
+    begin
+      checksum := checksum + WriteTableHeader(AStream, tables.Strings[i], offset, TStream(tables.Objects[i]));
+      p := TStream(tables.Objects[i]).Size;
+      // table bodies must be 4-byte aligned - calculate the padding so the tableHeader.Offset field can reflect that.
+      if (p mod 4) = 0 then
+        lPadding := 0
+      else
+        lPadding := 4 - (p mod 4);
+      o := p + lPadding;
+      offset := offset + o;
+    end;
+  end;
+  checksum := $B1B0AFBA - (checksum and $ffffffff);
+
+  // update head.ChecksumAdjustment field
+  head.Seek(8, soBeginning);
+  WriteInt32(head, Int32(checksum));
+
+  // write table bodies
+  WriteTableBodies(AStream, tables);
+
+  for i := 0 to tables.Count-1 do
+    TStream(tables.Objects[i]).Free;
+  tables.Free;
+
+  UpdateOrigGlyphIDList;
+end;
+
+procedure TFontSubsetter.Add(const ACodePoint: uint32);
+var
+  gid: uint32;
+begin
+  gid := FFontInfo.Chars[ACodePoint];
+  if gid <> 0 then
+  begin
+    FGlyphIDList.Add(ACodePoint, FFontInfo.Chars[ACodePoint]);
+    FGlyphIDs.Add(gid);
+  end;
+end;
+
+{ TGIDList }
+
+function TGIDList.GetCount: integer;
+begin
+  Result := FList.Count;
+end;
+
+function TGIDList.GetItems(i: integer): TGIDItem;
+begin
+  Result := FList[i] as TGIDItem;
+end;
+
+procedure TGIDList.SetItems(i: integer; const AValue: TGIDItem);
+begin
+  FList[i] := AValue;
+end;
+
+constructor TGIDList.Create;
+begin
+  FList := TFPObjectList.Create;
+end;
+
+destructor TGIDList.Destroy;
+begin
+  FList.Free;
+  inherited Destroy;
+end;
+
+function TGIDList.Add(const GID: Integer): integer;
+var
+  itm: TGIDItem;
+begin
+  itm := TGIDItem.Create;
+  itm.GID := GID;
+  result := Add(itm);
+end;
+
+function TGIDList.Add(const AObject: TGIDItem): integer;
+begin
+  Result := FList.Add(AObject);
+end;
+
+procedure TGIDList.Clear;
+begin
+  FList.Clear;
+end;
+
+function TGIDList.Contains(const GID: integer): boolean;
+var
+  itm: TGIDItem;
+begin
+  Result := False;
+  for itm in self do
+  begin
+    if itm.GID = GID then
+    begin
+      Result := True;
+      Exit;
+    end;
+  end;
+end;
+
+function TGIDList.GetEnumerator: TGIDListEnumerator;
+begin
+  Result := TGIDListEnumerator.Create(self);
+end;
+
+function TGIDList.GetNewGlyphID(const OriginalGID: integer): integer;
+var
+  itm: TGIDItem;
+begin
+  Result := -1;
+  for itm in self do
+  begin
+    if itm.GID = OriginalGID then
+    begin
+      Result := itm.NewGID;
+      Exit;
+    end;
+  end;
+end;
+
+function CompareByGID(A, B: TGIDItem): Integer; inline;
+begin
+  if A.GID < B.GID then
+    Result := -1
+  else if A.GID > B.GID then
+    Result := 1
+  else
+    Result := 0;
+end;
+
+function CompareByGIDPtr(A, B: Pointer): Integer;
+begin
+  Result := CompareByGID(TGIDItem(A), TGIDItem(B));
+end;
+
+procedure TGIDList.Sort;
+begin
+  FList.Sort(@CompareByGIDPtr);
+end;
+
+{ TGIDListEnumerator }
+
+constructor TGIDListEnumerator.Create(AList: TGIDList);
+begin
+  FIndex := -1;
+  FList := AList;
+end;
+
+function TGIDListEnumerator.GetCurrent: TGIDItem;
+begin
+  Result := FList[FIndex];
+end;
+
+function TGIDListEnumerator.MoveNext: Boolean;
+begin
+  Result := FIndex < (FList.Count-1);
+  if Result then
+    Inc(FIndex);
+end;
+
+{ TGIDItem }
+
+constructor TGIDItem.Create;
+begin
+  FGID := -1;
+  FNewGID := -1;
+  FGlyphData := nil;
+  FIsCompoundGlyph := False;
+end;
+
+destructor TGIDItem.Destroy;
+begin
+  FreeAndNil(FGlyphData);
+  inherited Destroy;
+end;
+
+
+end.
+
diff --git a/packages/fcl-pdf/tests/fontlist.txt b/packages/fcl-pdf/tests/fontlist.txt
new file mode 100644
index 0000000000..0432d674f9
--- /dev/null
+++ b/packages/fcl-pdf/tests/fontlist.txt
@@ -0,0 +1,3 @@
+fonts/DejaVuSans.ttf
+fonts/FreeSans.ttf
+fonts/LiberationSans-Italic.ttf
\ No newline at end of file
diff --git a/packages/fcl-pdf/tests/fonts/README.txt b/packages/fcl-pdf/tests/fonts/README.txt
index a8592d38b0..0587afb2ad 100644
--- a/packages/fcl-pdf/tests/fonts/README.txt
+++ b/packages/fcl-pdf/tests/fonts/README.txt
@@ -1,4 +1,4 @@
-These sets of unit tests requires four font files of specific versions
+These sets of unit tests requires 5 font files of specific versions
 each. Here is what the tests were designed against.
 
  Font File                  |  Size (bytes)   |  Version
@@ -6,6 +6,7 @@ each. Here is what the tests were designed against.
 DejaVuSans.ttf              |    622,280      |    2.30
 FreeSans.ttf                |  1,563,256      |  412.2268
 LiberationSans-Regular.ttf  |    350,200      |    2.00.1
+LiberationSans-Italic.ttf   |    355,608      |    2.00.1
 Ubuntu-R.ttf                |    353,824      |    0.80
 
 
diff --git a/packages/fcl-pdf/tests/fpparsettf_test.pas b/packages/fcl-pdf/tests/fpparsettf_test.pas
index 9dddebb9f1..a8878ed3be 100644
--- a/packages/fcl-pdf/tests/fpparsettf_test.pas
+++ b/packages/fcl-pdf/tests/fpparsettf_test.pas
@@ -193,6 +193,25 @@ type
     { Utility functions }
     procedure TestGetGlyphIndex;
     procedure TestGetAdvanceWidth;
+
+    { General info }
+    procedure TestPostScriptName;
+    procedure TestFamilyName;
+    procedure TestHumanFriendlyName;
+  end;
+
+
+  TTestLiberationItalicFont = class(TBaseTestParseTTF)
+  protected
+    procedure SetUp; override;
+  published
+    { PostScript data structure }
+    procedure TestPostScript_ItalicAngle;
+
+    { General info }
+    procedure TestPostScriptName;
+    procedure TestFamilyName;
+    procedure TestHumanFriendlyName;
   end;
 
 
@@ -349,6 +368,11 @@ type
     procedure TestPostScript_maxMemType42;
     procedure TestPostScript_minMemType1;
     procedure TestPostScript_maxMemType1;
+
+    { General info }
+    procedure TestPostScriptName;
+    procedure TestFamilyName;
+    procedure TestHumanFriendlyName;
   end;
 
 implementation
@@ -361,6 +385,7 @@ uses
 const
   cFont1 = 'fonts' + PathDelim + 'LiberationSans-Regular.ttf';
   cFont2 = 'fonts' + PathDelim + 'FreeSans.ttf';
+  cFont3 = 'fonts' + PathDelim + 'LiberationSans-Italic.ttf';
 
 { TTestEmptyParseTTF }
 
@@ -468,22 +493,17 @@ var
 begin
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
-  //dt := EncodeDateTime(1904, 1, 1, 0, 0, 0, 0);
-  //s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  //AssertEquals('Failed on 1', '1904-01-01 00:00:00', s);
-
-  //dt := IncSecond(dt, FI.Head.Created);
 
-  // The above code equates to using MacToDateTime()
   dt := MacToDateTime(FI.Head.Created);
 
-  // We don't use this AssertEquals() because it shows a huge Double data-type
-  // value as the result.
-  //AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 20, 2, 31, 0), dt);
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //    created:             Thu Oct 04 11:02:31 2012
+  //    modified:            Thu Oct 04 11:02:31 2012
+  AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 11, 2, 31, 0), dt);
 
   // Instead we use this - which shows human readable dates.
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-10-04 20:02:31', s);
+  AssertEquals('Failed on 2', '2012-10-04 11:02:31', s);
 end;
 
 procedure TTestLiberationFont.TestHead_Modified;
@@ -491,9 +511,13 @@ var
   dt: TDateTime;
   s: string;
 begin
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //    created:             Thu Oct 04 11:02:31 2012
+  //    modified:            Thu Oct 04 11:02:31 2012
+
   dt := MacToDateTime(FI.Head.Modified);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-10-04 20:02:31', s);
+  AssertEquals('Failed on 2', '2012-10-04 11:02:31', s);
 end;
 
 procedure TTestLiberationFont.TestHead_BBox_xMin;
@@ -962,7 +986,7 @@ end;
 
 procedure TTestLiberationFont.TestOS2Data_ulUnicodeRange1;
 begin
-  AssertEquals('Failed on 1', '1110 0000 0000 0000 0000 1010 1111 1111', IntToBin(FI.OS2Data.ulUnicodeRange1, 32, 4));
+//  AssertEquals('Failed on 1', '1110 0000 0000 0000 0000 1010 1111 1111', IntToBin(FI.OS2Data.ulUnicodeRange1, 32, 4));
   AssertEquals('Failed on 2', 'E0000AFF', IntToHex(FI.OS2Data.ulUnicodeRange1, 8));
 end;
 
@@ -1150,6 +1174,53 @@ begin
   AssertEquals('Failed on 12', 1139, FI.GetAdvanceWidth(20));  // '1'
 end;
 
+procedure TTestLiberationFont.TestPostScriptName;
+begin
+  AssertEquals('Failed on 1', 'LiberationSans', FI.PostScriptName);
+end;
+
+procedure TTestLiberationFont.TestFamilyName;
+begin
+  AssertEquals('Failed on 1', 'Liberation Sans', FI.FamilyName);
+end;
+
+procedure TTestLiberationFont.TestHumanFriendlyName;
+begin
+  AssertEquals('Failed on 1', 'Liberation Sans', FI.HumanFriendlyName);
+end;
+
+{ TTestLiberationItalicFont }
+
+procedure TTestLiberationItalicFont.SetUp;
+begin
+  inherited SetUp;
+  AssertTrue('Failed to find TTF font file <' + cFont3 + '>' + LineEnding +
+    'You can download it from [https://fedorahosted.org/releases/l/i/liberation-fonts/liberation-fonts-ttf-2.00.1.tar.gz]',
+    FileExists(cFont3) = True);
+  LoadFont(cFont3);
+end;
+
+procedure TTestLiberationItalicFont.TestPostScript_ItalicAngle;
+begin
+  AssertEquals('Failed on 1', -12.0, FI.PostScript.ItalicAngle / 65536.0);
+  AssertEquals('Failed on 2', -12.0, FI.ItalicAngle);
+end;
+
+procedure TTestLiberationItalicFont.TestPostScriptName;
+begin
+  AssertEquals('Failed on 1', 'LiberationSans-Italic', FI.PostScriptName);
+end;
+
+procedure TTestLiberationItalicFont.TestFamilyName;
+begin
+  AssertEquals('Failed on 1', 'Liberation Sans', FI.FamilyName);
+end;
+
+procedure TTestLiberationItalicFont.TestHumanFriendlyName;
+begin
+  AssertEquals('Failed on 1', 'Liberation Sans Italic', FI.HumanFriendlyName);
+end;
+
 { TTestFreeSansFont }
 
 procedure TTestFreeSansFont.SetUp;
@@ -1232,22 +1303,20 @@ var
 begin
   // LONGDATETIME: Date represented in number of seconds since 12:00 midnight,
   //              January 1, 1904. The value is represented as a signed 64-bit integer.
-  //dt := EncodeDateTime(1904, 1, 1, 0, 0, 0, 0);
-  //s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  //AssertEquals('Failed on 1', '1904-01-01 00:00:00', s);
 
-  //dt := IncSecond(dt, FI.Head.Created);
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //  created:             Thu May 03 13:34:25 2012
+  //  modified:            Thu May 03 13:34:25 2012
 
-  // The above code equates to using MacToDateTime()
   dt := MacToDateTime(FI.Head.Created);
 
   // We don't use this AssertEquals() because it shows a huge Double data-type
   // value as the result.
-  //AssertEquals('Failed on 1', EncodeDateTime(2012, 10, 4, 20, 2, 31, 0), dt);
+  AssertEquals('Failed on 1', EncodeDateTime(2012, 5, 3, 13, 34, 25, 0), dt);
 
   // Instead we use this - which shows human readable dates.
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-05-02 22:34:25', s);
+  AssertEquals('Failed on 2', '2012-05-03 13:34:25', s);
 end;
 
 procedure TTestFreeSansFont.TestHead_Modified;
@@ -1255,9 +1324,12 @@ var
   dt: TDateTime;
   s: string;
 begin
+  // value verified with Microsoft's ttfdump tool and GMT timezone (no daylight saving applied).
+  //  created:             Thu May 03 13:34:25 2012
+  //  modified:            Thu May 03 13:34:25 2012
   dt := MacToDateTime(FI.Head.Modified);
   s := FormatDateTime('yyyy-mm-dd hh:nn:ss', dt);
-  AssertEquals('Failed on 2', '2012-05-02 22:34:25', s);
+  AssertEquals('Failed on 2', '2012-05-03 13:34:25', s);
 end;
 
 procedure TTestFreeSansFont.TestHead_BBox_xMin;
@@ -1895,11 +1967,27 @@ begin
   AssertEquals('Failed on 1', 0, FI.PostScript.maxMemType1);
 end;
 
+procedure TTestFreeSansFont.TestPostScriptName;
+begin
+  AssertEquals('Failed on 1', 'FreeSans', FI.PostScriptName);
+end;
+
+procedure TTestFreeSansFont.TestFamilyName;
+begin
+  AssertEquals('Failed on 1', 'FreeSans', FI.FamilyName);
+end;
+
+procedure TTestFreeSansFont.TestHumanFriendlyName;
+begin
+  AssertEquals('Failed on 1', 'FreeSans', FI.HumanFriendlyName);
+end;
+
 
 initialization
   RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestEmptyParseTTF{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestLiberationFont{$ifdef fptest}.Suite{$endif});
   RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestFreeSansFont{$ifdef fptest}.Suite{$endif});
+  RegisterTest({$ifdef fptest}'fpParseTTF',{$endif}TTestLiberationItalicFont{$ifdef fptest}.Suite{$endif});
 
 end.
 
diff --git a/packages/fcl-pdf/tests/fppdf_test.pas b/packages/fcl-pdf/tests/fppdf_test.pas
index d512e94458..4dcb9d65b5 100644
--- a/packages/fcl-pdf/tests/fppdf_test.pas
+++ b/packages/fcl-pdf/tests/fppdf_test.pas
@@ -21,6 +21,7 @@ type
   private
     FPDF: TPDFDocument;
     FStream: TStringStream;
+    procedure   CreatePages(const ACount: integer);
   protected
     procedure   SetUp; override;
     procedure   TearDown; override;
@@ -200,6 +201,7 @@ type
     procedure   TestWrite_ppsDot;
     procedure   TestWrite_ppsDashDot;
     procedure   TestWrite_ppsDashDotDot;
+    procedure   TestLocalisationChanges;
   end;
 
 
@@ -232,7 +234,8 @@ type
   published
     procedure   TestPageDocument;
     procedure   TestPageDefaultUnitOfMeasure;
-    procedure   TestMatrix;
+    procedure   TestMatrixOn;
+    procedure   TestMatrixOff;
     procedure   TestUnitOfMeasure_MM;
     procedure   TestUnitOfMeasure_Inches;
     procedure   TestUnitOfMeasure_CM;
@@ -295,6 +298,23 @@ type
 
 { TBasePDFTest }
 
+procedure TBasePDFTest.CreatePages(const ACount: integer);
+var
+  page: TPDFPage;
+  sec: TPDFSection;
+  i: integer;
+begin
+  if FPDF.Sections.Count = 0 then
+    sec := FPDF.Sections.AddSection
+  else
+    sec := FPDF.Sections[0];
+  for i := 1 to ACount do
+  begin
+    page := FPDF.Pages.AddPage;
+    sec.AddPage(page);
+  end;
+end;
+
 procedure TBasePDFTest.SetUp;
 begin
   inherited SetUp;
@@ -334,7 +354,7 @@ Var
 
 begin
   AssertEquals('Failed on 1', '0.12', TMockPDFObject.FloatStr(TPDFFLoat(0.12)));
-  AssertEquals('Failed on 2', '  12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
+  AssertEquals('Failed on 2', '12', TMockPDFObject.FloatStr(TPDFFLoat(12.00)));
   AssertEquals('Failed on 3', '12.30', TMockPDFObject.FloatStr(TPDFFLoat(12.30)));
   AssertEquals('Failed on 4', '12.34', TMockPDFObject.FloatStr(TPDFFLoat(12.34)));
   AssertEquals('Failed on 5', '123.45', TMockPDFObject.FloatStr(TPDFFLoat(123.45)));
@@ -399,7 +419,7 @@ begin
       '1 J'+CRLF+
       '300.50 w'+CRLF+           // line width 300.5
       '1 J'+CRLF+
-      ' 123 w'+CRLF,             // line width 123
+      '123 w'+CRLF,             // line width 123
       s.DataString);
   finally
     o.Free;
@@ -446,7 +466,7 @@ begin
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFMoveTo(o).Write(S);
-    AssertEquals('Failed on 2', '  10   20 m'+CRLF, S.DataString);
+    AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
   finally
     o.Free;
   end;
@@ -463,7 +483,7 @@ begin
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFMoveTo(o).Write(S);
-    AssertEquals('Failed on 2', '  10   20 m'+CRLF, S.DataString);
+    AssertEquals('Failed on 2', '10 20 m'+CRLF, S.DataString);
   finally
     o.Free;
   end;
@@ -655,7 +675,7 @@ var
   s8: UTF8String;
 begin
   PDF.Options := []; // disable all compression
-  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans');
   o := TPDFUTF8String.Create(PDF, 'TestT', fnt);
   try
     AssertEquals('Failed on 1', '', S.DataString);
@@ -685,7 +705,7 @@ var
   o: TPDFUTF8String;
   fnt: integer;
 begin
-  fnt := PDF.AddFont(cFont1, 'Liberation Sans', clBlack);
+  fnt := PDF.AddFont(cFont1, 'Liberation Sans');
   o := TPDFUTF8String.Create(PDF, 'a(b)c\def/g', fnt);
   try
     AssertEquals('Failed on 1', '', S.DataString);
@@ -743,8 +763,11 @@ end;
 procedure TTestPDFEmbeddedFont.TestWrite;
 var
   o: TPDFEmbeddedFont;
+  p: TPDFPage;
 begin
-  o := TPDFEmbeddedFont.Create(PDF, 1, '16');
+  CreatePages(1);
+  p := PDF.Pages[0];
+  o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFEmbeddedFont(o).Write(S);
@@ -759,10 +782,13 @@ var
   o: TPDFEmbeddedFont;
   lStream: TMemoryStream;
   str: String;
+  p: TPDFPage;
 begin
   PDF.Options := []; // disable compressed fonts
   str := 'Hello World';
-  o := TPDFEmbeddedFont.Create(PDF, 1, '16');
+  CreatePages(1);
+  p := PDF.Pages[0];
+  o := TPDFEmbeddedFont.Create(PDF, p, 1, '16');
   try
     AssertEquals('Failed on 1', '', S.DataString);
     lStream := TMemoryStream.Create;
@@ -785,13 +811,13 @@ var
 begin
   x := 10.5;
   y := 20.0;
-  o := TPDFText.Create(PDF, x, y, 'Hello World!', 0);
+  o := TPDFText.Create(PDF, x, y, 'Hello World!', nil, 0, false, false);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     TMockPDFText(o).Write(S);
     AssertEquals('Failed on 2',
       'BT'+CRLF+
-      '10.50   20 TD'+CRLF+
+      '10.50 20 TD'+CRLF+
       '(Hello World!) Tj'+CRLF+
       'ET'+CRLF,
       S.DataString);
@@ -808,7 +834,7 @@ var
 begin
   pos.X := 10.0;
   pos.Y := 55.5;
-  AssertEquals('Failed on 1', '  10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
+  AssertEquals('Failed on 1', '10 55.50 l'+CRLF, TPDFLineSegment.Command(pos));
 end;
 
 procedure TTestPDFLineSegment.TestWrite;
@@ -827,9 +853,9 @@ begin
     TMockPDFLineSegment(o).Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+             // line width
-      '  10 15.50 m'+CRLF+       // moveto command
-      '  50 55.50 l'+CRLF+       // line segment
+      '2 w'+CRLF+             // line width
+      '10 15.50 m'+CRLF+      // moveto command
+      '50 55.50 l'+CRLF+      // line segment
       'S'+CRLF,               // end line segment
       S.DataString);
   finally
@@ -854,7 +880,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '  10   11  100  200 re'+CRLF,
+      '10 11 100 200 re'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -877,8 +903,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      '  10   11  100  200 re'+CRLF+
+      '2 w'+CRLF+
+      '10 11 100 200 re'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -902,8 +928,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      '  10   11  100  200 re'+CRLF+
+      '2 w'+CRLF+
+      '10 11 100 200 re'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -926,7 +952,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '  10   11  100  200 re'+CRLF+
+      '10 11 100 200 re'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -950,7 +976,7 @@ begin
   X3 := 200;
   Y3 := 250;
   s1 := TMockPDFCurveC.Command(x1, y1, x2, y2, x3, y3);
-  AssertEquals('Failed on 1', '  10   11  100    9  200  250 c'+CRLF, s1);
+  AssertEquals('Failed on 1', '10 11 100 9 200 250 c'+CRLF, s1);
 end;
 
 procedure TTestPDFCurveC.TestWrite_Stroke;
@@ -974,8 +1000,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      '  10   11  100    9  200  250 c'+CRLF+
+      '2 w'+CRLF+
+      '10 11 100 9 200 250 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1003,7 +1029,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '  10   11  100    9  200  250 c'+CRLF,
+      '10 11 100 9 200 250 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1030,8 +1056,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      ' 100    9  200  250 v'+CRLF+
+      '2 w'+CRLF+
+      '100 9 200 250 v'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1056,7 +1082,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      ' 100    9  200  250 v'+CRLF,
+      '100 9 200 250 v'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1083,8 +1109,8 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
-      ' 100    9  200  250 y'+CRLF+
+      '2 w'+CRLF+
+      '100 9 200 250 y'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1109,7 +1135,7 @@ begin
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      ' 100    9  200  250 y'+CRLF,
+      '100 9 200 250 y'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1134,15 +1160,15 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF,
+      '54.77 270 10 214.04 10 145 c'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1165,15 +1191,15 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF+
+      '54.77 270 10 214.04 10 145 c'+CRLF+
       'f'+CRLF,
       S.DataString);
   finally
@@ -1197,17 +1223,17 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
+      '2 w'+CRLF+
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF+
+      '54.77 270 10 214.04 10 145 c'+CRLF+
       'S'+CRLF,
       S.DataString);
   finally
@@ -1231,17 +1257,17 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       '1 J'+CRLF+
-      '   2 w'+CRLF+
+      '2 w'+CRLF+
       // move to
-      '  10  145 m'+CRLF+
+      '10 145 m'+CRLF+
       // curveC 1
-      '  10 76.25   55   20  110   20 c'+CRLF+
+      '10 75.96 54.77 20 110 20 c'+CRLF+
       // curveC 2
-      ' 165   20  210 76.25  210  145 c'+CRLF+
+      '165.23 20 210 75.96 210 145 c'+CRLF+
       // curveC 3
-      ' 210 213.75  165  270  110  270 c'+CRLF+
+      '210 214.04 165.23 270 110 270 c'+CRLF+
       // curveC 4
-      '  55  270   10 213.75   10  145 c'+CRLF+
+      '54.77 270 10 214.04 10 145 c'+CRLF+
       'b'+CRLF,
       S.DataString);
   finally
@@ -1270,11 +1296,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '  10   20 m'+CRLF+
+      '10 20 m'+CRLF+
       // line segment - p1
-      '  30   40 l'+CRLF+
+      '30 40 l'+CRLF+
       // line segment - p2
-      '  50   60 l'+CRLF+
+      '50 60 l'+CRLF+
       'h'+CRLF+   // close
       'f'+CRLF,   // fill
       S.DataString);
@@ -1303,11 +1329,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '  10   20 m'+CRLF+
+      '10 20 m'+CRLF+
       // line segment - p1
-      '  30   40 l'+CRLF+
+      '30 40 l'+CRLF+
       // line segment - p2
-      '  50   60 l'+CRLF+
+      '50 60 l'+CRLF+
       'h'+CRLF,   // close
       S.DataString);
   finally
@@ -1335,11 +1361,11 @@ begin
     o.Write(S);
     AssertEquals('Failed on 2',
       // move to - p0
-      '  10   20 m'+CRLF+
+      '10 20 m'+CRLF+
       // line segment - p1
-      '  30   40 l'+CRLF+
+      '30 40 l'+CRLF+
       // line segment - p2
-      '  50   60 l'+CRLF+
+      '50 60 l'+CRLF+
       'f'+CRLF,   // fill
       S.DataString);
   finally
@@ -1364,7 +1390,7 @@ begin
     AssertEquals('Failed on 2',
       // save graphics state
       'q'+CRLF+
-      ' 150 0 0   75  100  200 cm'+CRLF+
+      '150 0 0 75 100 200 cm'+CRLF+
       '/I1 Do'+CRLF+
       // restore graphics state
       'Q'+CRLF,
@@ -1379,6 +1405,7 @@ var
   p: TPDFPage;
   img: TMockPDFImage;
 begin
+  PDF.Options := [poPageOriginAtTop];
   p := PDF.Pages.AddPage;
   p.UnitOfMeasure := uomMillimeters;
   AssertEquals('Failed on 1', 0, p.ObjectCount);
@@ -1391,7 +1418,7 @@ begin
   AssertEquals('Failed on 5',
     // save graphics state
     'q'+CRLF+
-    ' 200 0 0  100 28.35 785.31 cm'+CRLF+
+    '200 0 0 100 28.35 785.31 cm'+CRLF+
     '/I1 Do'+CRLF+
     // restore graphics state
     'Q'+CRLF,
@@ -1411,7 +1438,7 @@ begin
   AssertEquals('Failed on 10',
     // save graphics state
     'q'+CRLF+
-    ' 200 0 0  100 283.46 275.07 cm'+CRLF+
+    '200 0 0 100 283.46 275.07 cm'+CRLF+
     '/I1 Do'+CRLF+
     // restore graphics state
     'Q'+CRLF,
@@ -1423,6 +1450,7 @@ var
   p: TPDFPage;
   img: TMockPDFImage;
 begin
+  PDF.Options := [poPageOriginAtTop];
   p := PDF.Pages.AddPage;
   p.UnitOfMeasure := uomMillimeters;
   AssertEquals('Failed on 1', 0, p.ObjectCount);
@@ -1468,7 +1496,7 @@ procedure TTestPDFLineStyle.TestWrite_ppsSolid;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1);
+  o := TMockPDFLineStyle.Create(PDF, ppsSolid, 1, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
@@ -1484,12 +1512,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDash;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDash, 2);
+  o := TMockPDFLineStyle.Create(PDF, ppsDash, 2, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[5 3] 2 d'+CRLF,
+      '[5 5] 2 d'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1500,12 +1528,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDot;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDot, 3);
+  o := TMockPDFLineStyle.Create(PDF, ppsDot, 3, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[1 3] 3 d'+CRLF,
+      '[0.80 4] 3 d'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1516,12 +1544,12 @@ procedure TTestPDFLineStyle.TestWrite_ppsDashDot;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4);
+  o := TMockPDFLineStyle.Create(PDF, ppsDashDot, 4, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[5 3 1 3] 4 d'+CRLF,
+      '[5 3 0.80 3] 4 d'+CRLF,
       S.DataString);
   finally
     o.Free;
@@ -1532,16 +1560,36 @@ procedure TTestPDFLineStyle.TestWrite_ppsDashDotDot;
 var
   o: TMockPDFLineStyle;
 begin
-  o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1);
+  o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
+  try
+    AssertEquals('Failed on 1', '', S.DataString);
+    o.Write(S);
+    AssertEquals('Failed on 2',
+      '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
+      S.DataString);
+  finally
+    o.Free;
+  end;
+end;
+
+procedure TTestPDFLineStyle.TestLocalisationChanges;
+var
+  o: TMockPDFLineStyle;
+  d: char;
+begin
+  d :=  DefaultFormatSettings.DecimalSeparator;
+  DefaultFormatSettings.DecimalSeparator := Char('~');
+  o := TMockPDFLineStyle.Create(PDF, ppsDashDotDot, 1, 1);
   try
     AssertEquals('Failed on 1', '', S.DataString);
     o.Write(S);
     AssertEquals('Failed on 2',
-      '[5 3 1 3 1 3] 1 d'+CRLF,
+      '[5 3 0.80 3 0.80 3] 1 d'+CRLF,
       S.DataString);
   finally
     o.Free;
   end;
+  DefaultFormatSettings.DecimalSeparator := d;
 end;
 
 { TTestPDFColor }
@@ -1673,11 +1721,13 @@ begin
   AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
 end;
 
-procedure TTestPDFPage.TestMatrix;
+// (0,0) origin is at top-left of page
+procedure TTestPDFPage.TestMatrixOn;
 var
   p: TPDFPage;
   pt1, pt2: TPDFCoord;
 begin
+  PDF.Options := [poPageOriginAtTop];
   p := PDF.Pages.AddPage;
   AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
   AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), p.Paper.H);
@@ -1693,6 +1743,28 @@ begin
   AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
 end;
 
+// (0,0) origin is at bottom-left of page
+procedure TTestPDFPage.TestMatrixOff;
+var
+  p: TPDFPage;
+  pt1, pt2: TPDFCoord;
+begin
+  PDF.Options := [];
+  p := PDF.Pages.AddPage;
+  AssertTrue('Failed on 1', p.UnitOfMeasure = uomMillimeters);
+  AssertEquals('Failed on 2', mmToPDF(p.Matrix._21), 0);
+
+  pt1.X := 10;
+  pt1.Y := 20;
+  pt2 := p.Matrix.Transform(pt1);
+  AssertEquals('Failed on 3', 10, pt2.X);
+  AssertEquals('Failed on 4', 20, pt2.Y, 0.1);
+
+  pt1 := p.Matrix.ReverseTransform(pt2);
+  AssertEquals('Failed on 5', 10, pt1.X);
+  AssertEquals('Failed on 6', 20, pt1.Y, 0.1);
+end;
+
 procedure TTestPDFPage.TestUnitOfMeasure_MM;
 var
   p: TPDFPage;
diff --git a/packages/fcl-pdf/tests/fpttf_test.pas b/packages/fcl-pdf/tests/fpttf_test.pas
index d29dbb5a54..508b849e0b 100644
--- a/packages/fcl-pdf/tests/fpttf_test.pas
+++ b/packages/fcl-pdf/tests/fpttf_test.pas
@@ -12,25 +12,39 @@ uses
   ,fpcunit, testregistry
   {$endif}
   ,fpttf
+  ,fpparsettf
   ;
 
 type
 
+  TMyTestFPFontCacheItem = class(TFPFontCacheItem)
+  protected
+    FFileInfo: TTFFileInfo;
+  end;
+
+
   TFPFontCacheItemTest = class(TTestCase)
   private
-    FCacheItem: TFPFontCacheItem;
+    FCacheItem: TMyTestFPFontCacheItem;
+    procedure SetupRealFont;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
   public
-    property CI: TFPFontCacheItem read FCacheItem;
+    property CI: TMyTestFPFontCacheItem read FCacheItem;
   published
+    procedure TestIsRegularCantFind;
+    procedure TestIsBoldCantFind;
+    procedure TestIsItalicCantFind;
+    procedure TestIsFixedWidthCantFind;
+    procedure TestFileInfoCantFind;
     procedure TestIsRegular;
     procedure TestIsBold;
     procedure TestIsItalic;
     procedure TestIsFixedWidth;
     procedure TestRegularVsFixedWidth;
     procedure TestFileName;
+    procedure TestFontInfoAfterCreate;
     procedure TestTextWidth_FontUnits;
     procedure TestTextWidth_Pixels;
   end;
@@ -52,22 +66,31 @@ type
     procedure TestFind_FamilyName;
     procedure TestFind_PostscriptName;
     procedure TestAssignFontList;
+    procedure TestLoadFromFile;
+    procedure TestReadStandardFonts;
   end;
 
 implementation
 
-uses
-  fpparsettf;
+const
+  cFontCount = 5;
 
 resourcestring
-  cErrFontCountWrong =   ' - make sure you only have the 4 test fonts in the "fonts" directory.';
+  cErrFontCountWrong =   ' - make sure you only have the 5 test fonts in the "fonts" directory.';
+
 
 { TFPFontCacheItemTest }
 
+procedure TFPFontCacheItemTest.SetupRealFont;
+begin
+  FCacheItem.Free;
+  FCacheItem := TMyTestFPFontCacheItem.Create('fonts' + PathDelim + 'DejaVuSans.ttf');
+end;
+
 procedure TFPFontCacheItemTest.SetUp;
 begin
   inherited SetUp;
-  FCacheItem := TFPFontCacheItem.Create('mytest.ttf');
+  FCacheItem := TMyTestFPFontCacheItem.Create('mytest.ttf');
 end;
 
 procedure TFPFontCacheItemTest.TearDown;
@@ -76,29 +99,103 @@ begin
   inherited TearDown;
 end;
 
+procedure TFPFontCacheItemTest.TestIsRegularCantFind;
+begin
+  try
+    AssertFalse(CI.IsRegular);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsBoldCantFind;
+begin
+  try
+    AssertFalse(CI.IsBold);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsItalicCantFind;
+begin
+  try
+    AssertFalse(CI.IsItalic);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
+procedure TFPFontCacheItemTest.TestIsFixedWidthCantFind;
+begin
+  try
+    AssertFalse(CI.IsFixedWidth);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;end;
+
+procedure TFPFontCacheItemTest.TestFileInfoCantFind;
+begin
+  try
+    AssertFalse(CI.FontData <> nil);  // this should raise an error
+    Fail('Failed on 1');
+  except
+    on E: Exception do
+      begin
+        AssertEquals('Failed on 2', 'ETTF', E.ClassName);
+        AssertEquals('Failed on 3', 'The font file <mytest.ttf> can''t be found.', E.Message);
+      end;
+  end;
+end;
+
 procedure TFPFontCacheItemTest.TestIsRegular;
 begin
+  SetupRealFont;
   { regular should be the default flag set }
   AssertEquals('Failed on 1', True, CI.IsRegular);
 end;
 
 procedure TFPFontCacheItemTest.TestIsBold;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', False, CI.IsBold);
 end;
 
 procedure TFPFontCacheItemTest.TestIsItalic;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', False, CI.IsItalic);
 end;
 
 procedure TFPFontCacheItemTest.TestIsFixedWidth;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', False, CI.IsFixedWidth);
 end;
 
 procedure TFPFontCacheItemTest.TestRegularVsFixedWidth;
 begin
+  SetupRealFont;
   AssertEquals('Failed on 1', True, CI.IsRegular);
   AssertEquals('Failed on 2', False, CI.IsFixedWidth);
 end;
@@ -106,8 +203,14 @@ end;
 procedure TFPFontCacheItemTest.TestFileName;
 begin
   AssertTrue('Failed on 1', CI.FileName <> '');
-  { FileName is a non-existing file though, so FontData should be nil }
-  AssertTrue('Failed on 2', CI.FontData = nil);
+  { The Filename property doesn't trigger the loading of font info data }
+  AssertTrue('Failed on 2', CI.FFileInfo = nil);
+end;
+
+procedure TFPFontCacheItemTest.TestFontInfoAfterCreate;
+begin
+  { Font info isn't loaded in the constructor any more - it is now loaded on demand }
+  AssertTrue('Failed on 1', CI.FFileInfo = nil);
 end;
 
 procedure TFPFontCacheItemTest.TestTextWidth_FontUnits;
@@ -192,7 +295,7 @@ begin
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   AssertEquals('Failed on 2', 0, FC.Count);
   FC.BuildFontCache;
-  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, cFontCount, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache;
@@ -211,7 +314,7 @@ begin
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   AssertEquals('Failed on 4', 0, FC.Count);
   FC.BuildFontCache;
-  AssertEquals('Failed on 5' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 5' + cErrFontCountWrong, cFontCount, FC.Count);
 end;
 
 procedure TFPFontCacheListTest.TestBuildFontCache_tests_for_bug;
@@ -227,7 +330,7 @@ begin
   AssertEquals('Failed on 1', 0, FC.Count);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  AssertEquals('Failed on 2', 4, FC.Count);
+  AssertEquals('Failed on 2' + cErrFontCountWrong, cFontCount, FC.Count);
   FC.Clear;
   AssertEquals('Failed on 3', 0, FC.Count);
 end;
@@ -242,7 +345,7 @@ begin
   AssertTrue('Failed on 2', lCI = nil);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, cFontCount, FC.Count);
   lCI := FC.Find('Ubuntu');
   AssertTrue('Failed on 4', Assigned(lCI));
 
@@ -272,7 +375,7 @@ begin
   AssertTrue('Failed on 2', lCI = nil);
   FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
   FC.BuildFontCache;
-  AssertEquals('Failed on 3' + cErrFontCountWrong, 4, FC.Count);
+  AssertEquals('Failed on 3' + cErrFontCountWrong, cFontCount, FC.Count);
   lCI := FC.Find('Ubuntu');
   AssertTrue('Failed on 4', Assigned(lCI));
 
@@ -301,14 +404,48 @@ begin
     AssertEquals('Failed on 1', 0, FC.Count);
     FC.SearchPath.Add(ExtractFilePath(ParamStr(0)) + 'fonts');
     FC.BuildFontCache;
-    AssertEquals('Failed on 2', 4, FC.Count);
+    AssertEquals('Failed on 2' + cErrFontCountWrong, cFontCount, FC.Count);
     FC.AssignFontList(sl);
-    AssertEquals('Failed on 3', 4, sl.Count);
+    AssertEquals('Failed on 3', cFontCount, sl.Count);
   finally
     sl.Free;
   end;
 end;
 
+{ The fontlist file contains 3 font names, instead of the 5 that should
+  be available. This tests that we only load info of fonts that we need. }
+procedure TFPFontCacheListTest.TestLoadFromFile;
+const
+  cFontListFile = 'fontlist.txt';
+var
+  s: string;
+  lCI: TFPFontCacheItem;
+begin
+  s := ExtractFilePath(ParamStr(0)) + cFontListFile;
+  AssertEquals('Failed on 1', 0, FC.Count);
+  FC.LoadFromFile(s);
+  AssertEquals('Failed on 2', 3, FC.Count);
+
+  lCI := FC.Find('DejaVuSans');
+  AssertTrue('Failed on 3', Assigned(lCI));
+  lCI := nil;
+
+  lCI := FC.Find('FreeSans');
+  AssertTrue('Failed on 4', Assigned(lCI));
+  lCI := nil;
+
+  lCI := FC.Find('LiberationSans-Italic');
+  AssertTrue('Failed on 5', Assigned(lCI));
+  lCI := nil;
+end;
+
+procedure TFPFontCacheListTest.TestReadStandardFonts;
+begin
+  AssertEquals('Failed on 1', 0, FC.Count);
+  FC.ReadStandardFonts;
+  AssertTrue('Failed on 2', FC.Count > 1);
+end;
+
 
 initialization
   RegisterTest({$ifdef fptest}'fpTTF', {$endif}TFPFontCacheItemTest{$ifdef fptest}.Suite{$endif});
diff --git a/packages/fcl-pdf/tests/unittests_console.lpi b/packages/fcl-pdf/tests/unittests_console.lpi
index 22105d690f..8a3b807e27 100644
--- a/packages/fcl-pdf/tests/unittests_console.lpi
+++ b/packages/fcl-pdf/tests/unittests_console.lpi
@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <Flags>
         <LRSInOutputDirectory Value="False"/>
@@ -13,7 +13,6 @@
     <VersionInfo>
       <Language Value=""/>
       <CharSet Value=""/>
-      <StringTable ProductVersion=""/>
     </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
diff --git a/packages/fcl-pdf/utils/mkpdffontdef.pp b/packages/fcl-pdf/utils/mkpdffontdef.pp
deleted file mode 100644
index ff2a60d7bd..0000000000
--- a/packages/fcl-pdf/utils/mkpdffontdef.pp
+++ /dev/null
@@ -1,36 +0,0 @@
-{
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 2014 by Michael Van Canneyt
-
-    This small program reads a TTF font file and creates a definition in a .ini file for later use
-
-    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.
-
- **********************************************************************}
-{$mode objfpc}
-{$h+}
-
-program mkpdffontdef;
-
-uses sysutils, fpttfencodings, fpparsettf;
-
-begin
-  if (ParamCount<3) then
-    begin
-    writeln('Usage : ',ExtractFileName(paramstr(0)),' ttffilename encoding fntfilename');
-    Halt(1);
-    end;
-  With TTFFileInfo.Create do
-    try
-      LoadFromFile(ParamStr(1));
-      MakePDFFontDef(Paramstr(3),Paramstr(2),False)
-    finally
-      Free;
-    end;
-end.
-
diff --git a/packages/fcl-pdf/utils/ttfdump.lpi b/packages/fcl-pdf/utils/ttfdump.lpi
index a8baa8c4e8..9969635656 100644
--- a/packages/fcl-pdf/utils/ttfdump.lpi
+++ b/packages/fcl-pdf/utils/ttfdump.lpi
@@ -32,6 +32,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="-f ../tests/fonts/FreeSans.ttf -s"/>
       </local>
     </RunParams>
     <Units Count="1">
@@ -56,6 +57,17 @@
         <AllowLabel Value="False"/>
       </SyntaxOptions>
     </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+      </Checks>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-pdf/utils/ttfdump.lpr b/packages/fcl-pdf/utils/ttfdump.lpr
index 2167632d65..9e564b9773 100644
--- a/packages/fcl-pdf/utils/ttfdump.lpr
+++ b/packages/fcl-pdf/utils/ttfdump.lpr
@@ -1,46 +1,18 @@
 program ttfdump;
 
 {$mode objfpc}{$H+}
+{$codepage utf8}
 
 uses
-  {$IFDEF UNIX}{$IFDEF UseCThreads}
-  cwstrings,
-  {$ENDIF}{$ENDIF}
-  Classes, SysUtils, CustApp,
-  fpparsettf, contnrs;
+  {$ifdef unix}cwstring,{$endif}  // required for UnicodeString handling.
+  Classes,
+  SysUtils,
+  CustApp,
+  fpparsettf,
+  FPFontTextMapping,
+  fpTTFSubsetter;
 
 type
-  // forward declarations
-  TTextMapping = class;
-
-
-  TTextMappingList = class(TObject)
-  private
-    FList: TFPObjectList;
-    function GetCount: Integer;
-  protected
-    function    GetItem(AIndex: Integer): TTextMapping; reintroduce;
-    procedure   SetItem(AIndex: Integer; AValue: TTextMapping); reintroduce;
-  public
-    constructor Create;
-    destructor  Destroy; override;
-    function    Add(AObject: TTextMapping): Integer; overload;
-    function    Add(const ACharID, AGlyphID: uint16): Integer; overload;
-    property    Count: Integer read GetCount;
-    property    Items[Index: Integer]: TTextMapping read GetItem write SetItem; default;
-  end;
-
-
-  TTextMapping = class(TObject)
-  private
-    FCharID: uint16;
-    FGlyphID: uint16;
-  public
-    class function NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
-    property    CharID: uint16 read FCharID write FCharID;
-    property    GlyphID: uint16 read FGlyphID write FGlyphID;
-  end;
-
 
   TMyApplication = class(TCustomApplication)
   private
@@ -48,6 +20,7 @@ type
     procedure   DumpGlyphIndex;
     function    GetGlyphIndicesString(const AText: UnicodeString): AnsiString; overload;
     function    GetGlyphIndices(const AText: UnicodeString): TTextMappingList; overload;
+    procedure   CreateSubsetFontFile(const AList: TTextMappingList);
   protected
     procedure   DoRun; override;
   public
@@ -56,70 +29,10 @@ type
     procedure   WriteHelp; virtual;
   end;
 
-  TFriendClass = class(TTFFileInfo)
-  end;
-
-{ TTextMappingList }
-
-function TTextMappingList.GetCount: Integer;
-begin
-  Result := FList.Count;
-end;
-
-function TTextMappingList.GetItem(AIndex: Integer): TTextMapping;
-begin
-  Result := TTextMapping(FList.Items[AIndex]);
-end;
-
-procedure TTextMappingList.SetItem(AIndex: Integer; AValue: TTextMapping);
-begin
-  FList.Items[AIndex] := AValue;
-end;
-
-constructor TTextMappingList.Create;
-begin
-  FList := TFPObjectList.Create;
-end;
-
-destructor TTextMappingList.Destroy;
-begin
-  FList.Free;
-  inherited Destroy;
-end;
 
-function TTextMappingList.Add(AObject: TTextMapping): Integer;
-var
-  i: integer;
-begin
-  Result := -1;
-  for i := 0 to FList.Count-1 do
-  begin
-    if TTextMapping(FList.Items[i]).CharID = AObject.CharID then
-      Exit; // mapping already exists
+  TFriendClass = class(TTFFileInfo)
   end;
-  Result := FList.Add(AObject);
-end;
-
-function TTextMappingList.Add(const ACharID, AGlyphID: uint16): Integer;
-var
-  o: TTextMapping;
-begin
-  o := TTextMapping.Create;
-  o.CharID := ACharID;
-  o.GlyphID := AGlyphID;
-  Result := Add(o);
-  if Result = -1 then
-    o.Free;
-end;
 
-{ TTextMapping }
-
-class function TTextMapping.NewTextMap(const ACharID, AGlyphID: uint16): TTextMapping;
-begin
-  Result := TTextMapping.Create;
-  Result.CharID := ACharID;
-  Result.GlyphID := AGlyphID;
-end;
 
 { TMyApplication }
 
@@ -127,16 +40,16 @@ procedure TMyApplication.DumpGlyphIndex;
 begin
   Writeln('FHHead.numberOfHMetrics = ', FFontFile.HHead.numberOfHMetrics);
   Writeln('Length(Chars[]) = ', Length(FFontFile.Chars));
-
+  writeln;
   writeln('Glyph Index values:');
-  Writeln('U+0020 (space) = ', FFontFile.Chars[$0020]);
-  Writeln('U+0021 (!) = ', FFontFile.Chars[$0021]);
-  Writeln('U+0048 (H) = ', FFontFile.Chars[$0048]);
-
+  Writeln('  U+0020 (space) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0020]]));
+  Writeln('  U+0021 (!) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0021]]));
+  Writeln('  U+0048 (H) = ', Format('%d  (%0:4.4x)', [FFontFile.Chars[$0048]]));
+  writeln;
   Writeln('Glyph widths:');
-  Writeln('3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
-  Writeln('4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
-  Writeln('H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
+  Writeln('  3 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0020]].AdvanceWidth));
+  Writeln('  4 = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0021]].AdvanceWidth));
+  Writeln('  H = ', TFriendClass(FFontFile).ToNatural(FFontFile.Widths[FFontFile.Chars[$0048]].AdvanceWidth));
 end;
 
 function TMyApplication.GetGlyphIndices(const AText: UnicodeString): TTextMappingList;
@@ -154,6 +67,20 @@ begin
   end;
 end;
 
+procedure TMyApplication.CreateSubsetFontFile(const AList: TTextMappingList);
+var
+  lSubset: TFontSubsetter;
+begin
+  writeln;
+  writeln('called CreateSubsetFontFile...');
+  lSubset := TFontSubsetter.Create(FFontFile, AList);
+  try
+    lSubSet.SaveToFile(ExtractFileName(GetOptionValue('f'))+'.subset.ttf');
+  finally
+    FreeAndNil(lSubSet);
+  end;
+end;
+
 function TMyApplication.GetGlyphIndicesString(const AText: UnicodeString): AnsiString;
 var
   i: integer;
@@ -177,7 +104,7 @@ var
   i: integer;
 begin
   // quick check parameters
-  ErrorMsg := CheckOptions('hf:', 'help');
+  ErrorMsg := CheckOptions('hf:s', 'help');
   if ErrorMsg <> '' then
   begin
     ShowException(Exception.Create(ErrorMsg));
@@ -196,13 +123,25 @@ begin
   FFontFile.LoadFromFile(self.GetOptionValue('f'));
   DumpGlyphIndex;
 
-  s := 'Hello, World!';
+  // test #1
+//  s := 'Hello, World!';
+  // test #2
+  s := 'Typography: “What’s wrong?”';
+
   Writeln('');
   lst := GetGlyphIndices(s);
   Writeln(Format('%d Glyph indices for: "%s"', [lst.Count, s]));
+  writeln(#9'GID'#9'CharID');
+  writeln(#9'---'#9'------');
   for i := 0 to lst.Count-1 do
-    Writeln(Format(#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4)]));
+    Writeln(Format(#9'%s'#9'%s'#9'%s', [IntToHex(lst[i].GlyphID, 4), IntToHex(lst[i].CharID, 4), Char(lst[i].CharID)]));
+
+  if HasOption('s','') then
+    CreateSubsetFontFile(lst);
+  lst.Free;
 
+  writeln;
+  writeln;
   // stop program loop
   Terminate;
 end;
@@ -225,11 +164,13 @@ begin
   writeln('Usage: ', ExeName, ' -h');
   writeln('   -h            Show this help.');
   writeln('   -f <ttf>      Load TTF font file.');
+  writeln('   -s            Generate a subset TTF file.');
 end;
 
+
+
 var
   Application: TMyApplication;
-
 begin
   Application := TMyApplication.Create(nil);
   Application.Title := 'TTF Font Dump';
diff --git a/packages/fcl-process/fpmake.pp b/packages/fcl-process/fpmake.pp
index 6d764dff95..8eb0ecf08f 100644
--- a/packages/fcl-process/fpmake.pp
+++ b/packages/fcl-process/fpmake.pp
@@ -26,6 +26,8 @@ begin
     P.Options.Add('-S2h');
     P.NeedLibC:= false;
     P.OSes:=AllOSes-[embedded,msdos];
+    if Defaults.CPU=powerpc then
+      P.OSes:=P.OSes-[amiga];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src/unix',AllUnixOSes);
diff --git a/packages/fcl-process/src/simpleipc.pp b/packages/fcl-process/src/simpleipc.pp
index fd4bd8d4b8..8ec77b770c 100644
--- a/packages/fcl-process/src/simpleipc.pp
+++ b/packages/fcl-process/src/simpleipc.pp
@@ -292,6 +292,7 @@ destructor TIPCServerMsgQueue.Destroy;
 begin
   Clear;
   FList.Free;
+  Inherited;
 end;
 
 procedure TIPCServerMsgQueue.Clear;
diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp
index f3f9d2b3f7..ef10ce8893 100644
--- a/packages/fcl-registry/src/registry.pp
+++ b/packages/fcl-registry/src/registry.pp
@@ -58,13 +58,13 @@ type
     procedure SetRootKey(Value: HKEY);
     Procedure SysRegCreate;
     Procedure SysRegFree;
-    Function  SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer;
+    Function  SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; Out RegData: TRegDataType): Integer;
     Function  SysPutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean;
     Function  SysCreateKey(const Key: String): Boolean;
   protected
     function GetBaseKey(Relative: Boolean): HKey;
     function GetData(const Name: string; Buffer: Pointer;
-                  BufSize: Integer; var RegData: TRegDataType): Integer;
+                  BufSize: Integer; Out RegData: TRegDataType): Integer;
     function GetKey(const Key: string): HKEY;
     procedure ChangeKey(Value: HKey; const Path: string);
     procedure PutData(const Name: string; Buffer: Pointer;
@@ -78,10 +78,10 @@ type
     function CreateKey(const Key: string): Boolean;
     function DeleteKey(const Key: string): Boolean;
     function DeleteValue(const Name: string): Boolean;
-    function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
+    function GetDataInfo(const ValueName: string; Out Value: TRegDataInfo): Boolean;
     function GetDataSize(const ValueName: string): Integer;
     function GetDataType(const ValueName: string): TRegDataType;
-    function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+    function GetKeyInfo(Out Value: TRegKeyInfo): Boolean;
     function HasSubKeys: Boolean;
     function KeyExists(const Key: string): Boolean;
     function LoadKey(const Key, FileName: string): Boolean;
@@ -272,8 +272,7 @@ begin
     Result := RootKey;
 end;
 
-function TRegistry.GetData(const Name: string; Buffer: Pointer;
-  BufSize: Integer; var RegData: TRegDataType): Integer;
+function TRegistry.GetData(const Name: string; Buffer: Pointer; BufSize: Integer; out RegData: TRegDataType): Integer;
 begin
   Result:=SysGetData(Name,Buffer,BufSize,RegData);
   If (Result=-1) then
@@ -353,12 +352,14 @@ end;
 function TRegistry.ReadCurrency(const Name: string): Currency;
 
 begin
+  Result:=Default(Currency);
   ReadBinaryData(Name, Result, SizeOf(Currency));
 end;
 
 function TRegistry.ReadDate(const Name: string): TDateTime;
 
 begin
+  Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
   Result:=Trunc(Result);
 end;
@@ -366,12 +367,14 @@ end;
 function TRegistry.ReadDateTime(const Name: string): TDateTime;
 
 begin
+  Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
 end;
 
 function TRegistry.ReadFloat(const Name: string): Double;
 
 begin
+  Result:=Default(Double);
   ReadBinaryData(Name,Result,SizeOf(Double));
 end;
 
@@ -409,6 +412,7 @@ end;
 function TRegistry.ReadTime(const Name: string): TDateTime;
 
 begin
+  Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
   Result:=Frac(Result);
 end;
diff --git a/packages/fcl-registry/src/winreg.inc b/packages/fcl-registry/src/winreg.inc
index 20bf951e90..fd400b9438 100644
--- a/packages/fcl-registry/src/winreg.inc
+++ b/packages/fcl-registry/src/winreg.inc
@@ -78,7 +78,7 @@ begin
 end;
 
 function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
-          BufSize: Integer; var RegData: TRegDataType): Integer;
+          BufSize: Integer; Out RegData: TRegDataType): Integer;
 Var
   P: PChar;
   RD : DWord;
@@ -105,7 +105,7 @@ begin
     end;
 end;
 
-function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
+function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean;
 
 Var
   P: PChar;
@@ -143,7 +143,7 @@ begin
 end;
 
 
-function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+function TRegistry.GetKeyInfo(out Value: TRegKeyInfo): Boolean;
 var
   winFileTime: Windows.FILETIME;
   sysTime: TSystemTime;
diff --git a/packages/fcl-registry/src/xmlreg.pp b/packages/fcl-registry/src/xmlreg.pp
index 3953f78d4d..63793fc119 100644
--- a/packages/fcl-registry/src/xmlreg.pp
+++ b/packages/fcl-registry/src/xmlreg.pp
@@ -61,8 +61,8 @@ Type
     Function  CreateKey(KeyPath : String) : Boolean;
     Function  GetValueSize(Name : String) : Integer;
     Function  GetValueType(Name : String) : TDataType;
-    Function  GetValueInfo(Name : String; Var Info : TDataInfo) : Boolean;
-    Function  GetKeyInfo(Var Info : TKeyInfo) : Boolean;
+    Function  GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean;
+    Function  GetKeyInfo(Out Info : TKeyInfo) : Boolean;
     Function  EnumSubKeys(List : TStrings) : Integer;
     Function  EnumValues(List : TStrings) : Integer;
     Function  KeyExists(KeyPath : String) : Boolean;
@@ -71,7 +71,7 @@ Type
     Function  DeleteValue(S : String) : Boolean;
     Procedure Flush;
     Procedure Load;
-    Function GetValueData(Name : String; Var DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+    Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : String Read FRootKey Write SetRootkey;
@@ -285,7 +285,7 @@ begin
   MaybeFlush;
 end;
 
-Function TXmlRegistry.GetValueData(Name : String; Var DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
 
 Type
   PCardinal = ^Cardinal;
@@ -293,10 +293,11 @@ Type
 Var
   Node  : TDomElement;
   DataNode : TDomNode;
-  ND : Integer;
-  S : AnsiString;
+  BL,ND,NS : Integer;
+  S : UTF8String;
   HasData: Boolean;
-  IntValue: Integer;
+  D : DWord;
+  
 begin
   Node:=FindValueKey(Name);
   Result:=Node<>Nil;
@@ -309,38 +310,37 @@ begin
     If Result then
       begin
       DataType:=TDataType(ND);
+      NS:=0; // Initialize, for optional nodes.
       Case DataType of
         dtDWORD : begin   // DataNode is required
-                  if HasData and TryStrToInt(DataNode.NodeValue,IntValue) then
-                    begin
-                    PCardinal(@Data)^:=IntValue;
-                    DataSize:=SizeOf(Cardinal);
-                    end
-                  else
-                    Result:=False;
+                  NS:=SizeOf(Cardinal);
+                  Result:=HasData and TryStrToDWord(DataNode.NodeValue,D) and (DataSize>=NS);
+                  if Result then
+                    PCardinal(@Data)^:=D;
                   end;
-        dtString : begin  // DataNode is optional
+        dtString : // DataNode is optional
                    if HasData then
                      begin
-                     S:=DataNode.NodeValue; // Convert to ansistring
-                     DataSize:=Length(S);
-                     if (DataSize>0) then
-                       Move(S[1],Data,DataSize);
-                     end
-                   else
-                     DataSize:=0;
-                   end;
-        dtBinary : begin  // DataNode is optional
+                     S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring
+                     NS:=Length(S);
+                     Result:=(DataSize>=NS);
+                     if Result then
+                       Move(S[1],Data,NS);
+                     end;
+
+        dtBinary : // DataNode is optional
                    if HasData then
                      begin
-                     DataSize:=Length(DataNode.NodeValue);
-                     If (DataSize>0) then
-                       HexToBuf(DataNode.NodeValue,Data,DataSize);
-                     end
-                   else
-                     DataSize:=0;
-                   end;
+                     BL:=Length(DataNode.NodeValue);
+                     NS:=BL div 2;
+                     Result:=DataSize>=NS;
+                     If Result then
+                       // No need to check for -1, We checked NS before calling.
+                       NS:=HexToBuf(DataNode.NodeValue,Data,BL);
+                     end;
       end;
+      // Report needed/used size in all cases
+      DataSize:=NS;
       end;
     end;
 end;
@@ -353,7 +353,7 @@ Type
 Var
   Node  : TDomElement;
   DataNode : TDomNode;
-  S : String;
+  SW : Widestring;
 begin
   Node:=FindValueKey(Name);
   If Node=Nil then
@@ -365,23 +365,26 @@ begin
     DataNode:=Node.FirstChild;
 
     Case DataType of
-      dtDWORD : S:=IntToStr(PCardinal(@Data)^);
-      dtString : SetString(S, PAnsiChar(@Data), DataSize);
-      dtBinary : S:=BufToHex(Data,DataSize);
+      dtDWORD : SW:=IntToStr(PCardinal(@Data)^);
+      dtString : begin
+                   SW:=WideString(PAnsiChar(@Data));
+                   //S:=UTF8Encode(SW);
+                 end;
+      dtBinary : SW:=BufToHex(Data,DataSize);
     else
-      s:='';
+      sw:='';
     end;
-    if s <> '' then
+    if sw <> '' then
       begin
       if DataNode=nil then
         begin
         // may happen if previous value was empty;
         // XML does not handle empty textnodes.
-        DataNode:=FDocument.CreateTextNode(s);
+        DataNode:=FDocument.CreateTextNode(sw);
         Node.AppendChild(DataNode);
         end
       else
-        DataNode.NodeValue:=s;
+        DataNode.NodeValue:=sw;
       end
     else
       DataNode.Free;
@@ -536,16 +539,21 @@ end;
 Function TXMLRegistry.hexToBuf(Const Str : String; Var Buf; Var Len : Integer ) : Integer;
 
 Var
-  I : Integer;
+  NLeN,I : Integer;
   P : PByte;
   S : String;
   B : Byte;
   Code : Integer;
 
 begin
-  P:=@Buf;
-  Len:= Length(Str) div 2;
   Result:=0;
+  P:=@Buf;
+  NLen:= Length(Str) div 2;
+  If (NLen>Len) then
+    begin
+    Len:=NLen;
+    Exit(-1);
+    end;
   For I:=0 to Len-1 do
     begin
     S:='$'+Copy(Str,(I*2)+1,2);
@@ -599,7 +607,7 @@ begin
     Result:=dtUnknown;
 end;
 
-Function TXMLRegistry.GetValueInfo(Name : String; Var Info : TDataInfo) : Boolean;
+Function TXMLRegistry.GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean;
 
 Var
   N  : TDomElement;
@@ -613,7 +621,7 @@ begin
     begin
     DN:=N.FirstChild;
     if Assigned(DN) and (DN.NodeType=TEXT_NODE) then begin
-      S := DN.NodeValue;
+      S := UTF8Encode(DN.NodeValue);
       L:=Length(S);
     end else
       L:=0;
@@ -630,14 +638,14 @@ begin
     end;
 end;
 
-Function  TXMLRegistry.GetKeyInfo(Var Info : TKeyInfo) : Boolean;
+Function  TXMLRegistry.GetKeyInfo(Out Info : TKeyInfo) : Boolean;
 
 Var
   Node,DataNode : TDOMNode;
   L    : Integer;
 
 begin
-  FillChar(Info,SizeOf(Info),0);
+  Info:=Default(TKeyInfo);
   Result:=FCurrentElement<>Nil;
   If Result then
     With Info do
@@ -666,7 +674,7 @@ begin
               Case TDataType(StrToIntDef(TDomElement(Node)[SType],0)) of
                 dtUnknown : L:=0;
                 dtDWord   : L:=4;
-                DtString  : L:=Length(DataNode.NodeValue);
+                DtString  : L:=Length(UTF8Encode(DataNode.NodeValue));
                 dtBinary  : L:=Length(DataNode.NodeValue) div 2;
               end
             else
diff --git a/packages/fcl-registry/src/xregreg.inc b/packages/fcl-registry/src/xregreg.inc
index b93b12d0ad..ab155b7d45 100644
--- a/packages/fcl-registry/src/xregreg.inc
+++ b/packages/fcl-registry/src/xregreg.inc
@@ -118,7 +118,7 @@ begin
 end;
 
 function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
-          BufSize: Integer; var RegData: TRegDataType): Integer;
+          BufSize: Integer; Out RegData: TRegDataType): Integer;
 
 Var
   DataType : TDataType;
@@ -138,8 +138,7 @@ begin
 end;
 
 
-function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo
-  ): Boolean;
+function TRegistry.GetDataInfo(const ValueName: string; out Value: TRegDataInfo): Boolean;
 
 Var
   Info : TDataInfo;
@@ -170,7 +169,7 @@ begin
   Result := 0;
 end;
 
-function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+function TRegistry.GetKeyInfo(Out Value: TRegKeyInfo): Boolean;
 
 Var
   Info : TKeyInfo;
diff --git a/packages/fcl-registry/tests/regtestframework.pp b/packages/fcl-registry/tests/regtestframework.pp
index dcd6af419e..573fa4828b 100644
--- a/packages/fcl-registry/tests/regtestframework.pp
+++ b/packages/fcl-registry/tests/regtestframework.pp
@@ -1,53 +1,31 @@
 program regtestframework;

 

 {$IFDEF FPC}

-  {$mode objfpc}{$H+}

+{$mode objfpc}{$H+}

 {$ENDIF}

 

-{ $DEFINE STOREDB}

-

+{$IFDEF WINDOWS}

 {$APPTYPE CONSOLE}

+{$ENDIF}

 

 uses

   SysUtils,

   fpcunit,  testreport, testregistry,

-{$IFDEF STOREDB}

-  DBResultsWriter,

-{$ENDIF}

 // Units wich contains the tests

-  testbasics;

+  tcxmlreg,

+  testbasics, consoletestrunner;

+

+Var

+  A : TTestRunner;

 

-var

-  FXMLResultsWriter: TXMLResultsWriter;

-{$IFDEF STOREDB}

-  FDBResultsWriter: TDBResultsWriter;

-{$ENDIF}

-  testResult: TTestResult;

 begin

-  testResult := TTestResult.Create;

-  FXMLResultsWriter := TXMLResultsWriter.Create;

-{$IFDEF STOREDB}

-  FDBResultsWriter := TDBResultsWriter.Create;

-{$ENDIF}

+  DefaultFormat:=fPlain;

+  DefaultRunAllTests:=True;

+  A:=TTestRunner.Create(Nil);

   try

-    testResult.AddListener(FXMLResultsWriter);

-{$IFDEF STOREDB}

-    testResult.AddListener(FDBResultsWriter);

-{$ENDIF}

-    FXMLResultsWriter.WriteHeader;

-{$IFDEF STOREDB}

-    FDBResultsWriter.OpenConnection(dbconnectorname+';'+dbconnectorparams);

-{$ENDIF}

-    GetTestRegistry.Run(testResult);

-    FXMLResultsWriter.WriteResult(testResult);

-{$IFDEF STOREDB}

-    FDBResultsWriter.CloseConnection;

-{$ENDIF}

+    A.Initialize;

+    A.Run;

   finally

-    testResult.Free;

-    FXMLResultsWriter.Free;

-{$IFDEF STOREDB}

-    FDBResultsWriter.Free;

-{$ENDIF}

+    A.Free;

   end;

 end.

diff --git a/packages/fcl-registry/tests/tcxmlreg.pp b/packages/fcl-registry/tests/tcxmlreg.pp
new file mode 100644
index 0000000000..e5ff2d79c3
--- /dev/null
+++ b/packages/fcl-registry/tests/tcxmlreg.pp
@@ -0,0 +1,111 @@
+unit tcxmlreg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry, testdecorator, Classes, SysUtils, xmlreg;
+
+Type
+
+  { TTestXMLRegistry }
+
+  TTestXMLRegistry = Class(TTestCase)
+  private
+    FXMLReg: TXmlRegistry;
+  Protected
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    Property XMLReg : TXmlRegistry Read FXMLReg;
+  Published
+    Procedure TestReadBufDataDWord;
+    Procedure TestReadBufDataString;
+    Procedure TestReadBufDataBinary;
+  end;
+
+
+implementation
+
+{ TTestXMLRegistry }
+
+procedure TTestXMLRegistry.Setup;
+begin
+  inherited Setup;
+  DeleteFile('test.xml');
+  FXMLReg:=TXmlRegistry.Create('test.xml');
+end;
+
+procedure TTestXMLRegistry.TearDown;
+begin
+  FreeAndNil(FXMLReg);
+  inherited TearDown;
+end;
+
+procedure TTestXMLRegistry.TestReadBufDataDWord;
+
+Var
+  C : Cardinal;
+  I : Smallint;
+  DS : Integer;
+  dt : TDataType;
+
+begin
+  XMLReg.SetKey('a',True);
+  C:=123456;
+  XMLReg.SetValueData('b',dtDWORD,C,SizeOf(C));
+  XMLReg.Flush;
+  DS:=SizeOf(SmallInt);
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,I,ds));
+  AssertTrue('Correct data type reported',dt=dtDWord);
+  AssertEquals('Correct data buffer size reported',SizeOf(C),DS);
+
+end;
+
+procedure TTestXMLRegistry.TestReadBufDataString;
+
+Var
+  S1,S2 : String;
+  I : Smallint;
+  DS : Integer;
+  dt : TDataType;
+
+begin
+  XMLReg.SetKey('a',True);
+  S1:=StringOfChar('*',100);
+  XMLReg.SetValueData('b',dtString,S1[1],Length(S1));
+  XMLReg.Flush;
+  DS:=SizeOf(S1) div 2;
+  S2:=StringOfChar('*',DS);
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,S2[1],ds));
+  AssertTrue('Correct data type reported',dt=dtString);
+  AssertEquals('Correct data buffer size reported',Length(S1),DS);
+end;
+
+procedure TTestXMLRegistry.TestReadBufDataBinary;
+Var
+  S1,S2 : Array of byte;
+  I : Smallint;
+  DS : Integer;
+  dt : TDataType;
+
+begin
+  XMLReg.SetKey('a',True);
+  SetLength(S1,100);
+  For I:=0 to 99 do
+    S1[I]:=i;
+  XMLReg.SetValueData('b',dtBinary,S1[1],Length(S1));
+  XMLReg.Flush;
+  DS:=SizeOf(S1) div 4;
+  SetLength(S2,DS);
+  For I:=0 to DS-1 do
+    S2[I]:=i;
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,S2[1],ds));
+  AssertTrue('Correct data type reported',dt=dtBinary);
+  AssertEquals('Correct data buffer size reported',Length(S1),DS);
+end;
+
+begin
+  RegisterTest(TTestXMLRegistry);
+end.
+
diff --git a/packages/fcl-registry/tests/testbasics.pp b/packages/fcl-registry/tests/testbasics.pp
index 0709263bd0..d78d4e2b5b 100644
--- a/packages/fcl-registry/tests/testbasics.pp
+++ b/packages/fcl-registry/tests/testbasics.pp
@@ -7,8 +7,7 @@ unit TestBasics;
 interface
 
 uses
-  fpcunit, testutils, testregistry, testdecorator,
-  Classes, SysUtils;
+  fpcunit, testutils, testregistry, testdecorator, Classes, SysUtils;
 
 type
 
@@ -97,7 +96,7 @@ end;
 procedure TTestBasics.bug16395;
 var
   r: TRegistry;
-  s: string;
+  s,t: string;
 begin
   DeleteUserXmlFile;
   
@@ -149,6 +148,19 @@ begin
     r.Free;
   end;
 
+  r := TRegistry.Create;
+  try
+    r.RootKey := HKEY_CURRENT_USER;
+    r.OpenKey('LongNode',true);
+    t:=StringOfChar('*',4000);
+    r.WriteString('LongString',T);
+    s := r.ReadString('LongString');
+    AssertEquals('Writing long string works OK', t, s);
+    r.CloseKey;
+  finally
+    r.Free;
+  end;
+
   DeleteUserXmlFile;
 end;
 
diff --git a/packages/fcl-web/examples/echo/cgi/echo.lpi b/packages/fcl-web/examples/echo/cgi/echo.lpi
index cd8d0db04f..e04a0ec6ea 100644
--- a/packages/fcl-web/examples/echo/cgi/echo.lpi
+++ b/packages/fcl-web/examples/echo/cgi/echo.lpi
@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -31,7 +31,6 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">
@@ -43,29 +42,22 @@
       <Unit0>
         <Filename Value="echo.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="echo"/>
       </Unit0>
       <Unit1>
         <Filename Value="..\webmodule\wmecho.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="EchoModule"/>
         <ResourceBaseClass Value="DataModule"/>
-        <UnitName Value="wmecho"/>
       </Unit1>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\webmodule"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-web/examples/echo/cgi/echo.res b/packages/fcl-web/examples/echo/cgi/echo.res
index e66ecf85fe..e1df0e994f 100644
--- a/packages/fcl-web/examples/echo/cgi/echo.res
+++ b/packages/fcl-web/examples/echo/cgi/echo.res
diff --git a/packages/fcl-web/examples/httpapp/testhttp.lpi b/packages/fcl-web/examples/httpapp/testhttp.lpi
index e8a9de58dc..2ba6f77e7f 100644
--- a/packages/fcl-web/examples/httpapp/testhttp.lpi
+++ b/packages/fcl-web/examples/httpapp/testhttp.lpi
@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -6,13 +6,10 @@
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
-        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <MainUnit Value="0"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
-      <ActiveWindowIndexAtStart Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -31,269 +28,122 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <Units Count="12">
       <Unit0>
         <Filename Value="testhttp.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testhttp"/>
-        <EditorIndex Value="0"/>
-        <WindowIndex Value="0"/>
-        <TopLine Value="1"/>
-        <CursorPos X="16" Y="5"/>
+        <IsVisibleTab Value="True"/>
+        <CursorPos X="41" Y="6"/>
         <UsageCount Value="20"/>
         <Loaded Value="True"/>
       </Unit0>
       <Unit1>
         <Filename Value="fpwebfile.pp"/>
-        <UnitName Value="fpwebfile"/>
-        <EditorIndex Value="10"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="8"/>
         <CursorPos X="22" Y="14"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit1>
       <Unit2>
         <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/fphttp.pp"/>
-        <UnitName Value="fphttp"/>
-        <EditorIndex Value="11"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="188"/>
-        <CursorPos X="1" Y="196"/>
+        <CursorPos Y="196"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit2>
       <Unit3>
         <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/fphttpapp.pp"/>
-        <UnitName Value="fphttpapp"/>
-        <EditorIndex Value="6"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="14"/>
         <CursorPos X="31" Y="20"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit3>
       <Unit4>
         <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/custhttpapp.pp"/>
-        <UnitName Value="custhttpapp"/>
-        <EditorIndex Value="7"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="35"/>
         <CursorPos X="30" Y="39"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit4>
       <Unit5>
         <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/fphttpserver.pp"/>
-        <UnitName Value="fphttpserver"/>
-        <EditorIndex Value="8"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="18"/>
         <CursorPos X="24" Y="39"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit5>
       <Unit6>
         <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/httpdefs.pp"/>
         <UnitName Value="HTTPDefs"/>
-        <EditorIndex Value="9"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="1005"/>
         <CursorPos X="42" Y="1038"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit6>
       <Unit7>
         <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <UnitName Value="reglazwebextra"/>
-        <IsVisibleTab Value="True"/>
-        <EditorIndex Value="1"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="218"/>
         <CursorPos X="29" Y="235"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit7>
       <Unit8>
         <Filename Value="../../../../../projects/lazarus/components/fpweb/weblazideintf.pp"/>
         <UnitName Value="WebLazIDEIntf"/>
-        <EditorIndex Value="5"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="623"/>
-        <CursorPos X="1" Y="642"/>
+        <CursorPos Y="642"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit8>
       <Unit9>
         <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
         <ComponentName Value="NewHTTPApplicationForm"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="frmnewhttpapp"/>
-        <EditorIndex Value="3"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="25"/>
         <CursorPos X="34" Y="104"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
         <LoadedDesigner Value="True"/>
       </Unit9>
       <Unit10>
         <Filename Value="../../../../../projects/lazarus/components/fpweb/fpwebstrconsts.pas"/>
         <UnitName Value="fpWebStrConsts"/>
-        <EditorIndex Value="4"/>
-        <WindowIndex Value="0"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="92"/>
         <CursorPos X="22" Y="121"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit10>
       <Unit11>
         <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/webdata/fpwebdata.pp"/>
-        <UnitName Value="fpwebdata"/>
-        <EditorIndex Value="2"/>
-        <WindowIndex Value="0"/>
-        <TopLine Value="1"/>
+        <EditorIndex Value="-1"/>
         <CursorPos X="14" Y="15"/>
         <UsageCount Value="10"/>
-        <Loaded Value="True"/>
       </Unit11>
     </Units>
-    <JumpHistory Count="30" HistoryIndex="29">
+    <JumpHistory Count="3" HistoryIndex="2">
       <Position1>
         <Filename Value="testhttp.pp"/>
-        <Caret Line="23" Column="3" TopLine="1"/>
+        <Caret Line="23" Column="3"/>
       </Position1>
       <Position2>
         <Filename Value="testhttp.pp"/>
-        <Caret Line="8" Column="44" TopLine="1"/>
+        <Caret Line="8" Column="44"/>
       </Position2>
       <Position3>
-        <Filename Value="fpwebfile.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position3>
-      <Position4>
         <Filename Value="testhttp.pp"/>
-        <Caret Line="29" Column="44" TopLine="1"/>
-      </Position4>
-      <Position5>
-        <Filename Value="fpwebfile.pp"/>
-        <Caret Line="63" Column="22" TopLine="48"/>
-      </Position5>
-      <Position6>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/custhttpapp.pp"/>
-        <Caret Line="39" Column="30" TopLine="35"/>
-      </Position6>
-      <Position7>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/fphttpserver.pp"/>
-        <Caret Line="35" Column="38" TopLine="18"/>
-      </Position7>
-      <Position8>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/httpdefs.pp"/>
-        <Caret Line="623" Column="33" TopLine="613"/>
-      </Position8>
-      <Position9>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/httpdefs.pp"/>
-        <Caret Line="1012" Column="7" TopLine="1009"/>
-      </Position9>
-      <Position10>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/httpdefs.pp"/>
-        <Caret Line="281" Column="71" TopLine="263"/>
-      </Position10>
-      <Position11>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/httpdefs.pp"/>
-        <Caret Line="1014" Column="21" TopLine="1010"/>
-      </Position11>
-      <Position12>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/base/httpdefs.pp"/>
-        <Caret Line="660" Column="21" TopLine="627"/>
-      </Position12>
-      <Position13>
-        <Filename Value="fpwebfile.pp"/>
-        <Caret Line="77" Column="60" TopLine="48"/>
-      </Position13>
-      <Position14>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <Caret Line="86" Column="29" TopLine="58"/>
-      </Position14>
-      <Position15>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/weblazideintf.pp"/>
-        <Caret Line="549" Column="14" TopLine="547"/>
-      </Position15>
-      <Position16>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="54" Column="17" TopLine="36"/>
-      </Position16>
-      <Position17>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="41" Column="20" TopLine="41"/>
-      </Position17>
-      <Position18>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="27" Column="29" TopLine="1"/>
-      </Position18>
-      <Position19>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <Caret Line="93" Column="28" TopLine="76"/>
-      </Position19>
-      <Position20>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="39" Column="43" TopLine="21"/>
-      </Position20>
-      <Position21>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="97" Column="29" TopLine="68"/>
-      </Position21>
-      <Position22>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/webdata/fpwebdata.pp"/>
-        <Caret Line="1" Column="1" TopLine="1"/>
-      </Position22>
-      <Position23>
-        <Filename Value="../../../../../FPC/trunk/packages/fcl-web/src/webdata/fpwebdata.pp"/>
-        <Caret Line="15" Column="14" TopLine="1"/>
-      </Position23>
-      <Position24>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <Caret Line="203" Column="23" TopLine="184"/>
-      </Position24>
-      <Position25>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="66" Column="10" TopLine="59"/>
-      </Position25>
-      <Position26>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="71" Column="24" TopLine="39"/>
-      </Position26>
-      <Position27>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/frmnewhttpapp.pp"/>
-        <Caret Line="75" Column="18" TopLine="58"/>
-      </Position27>
-      <Position28>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <Caret Line="111" Column="66" TopLine="95"/>
-      </Position28>
-      <Position29>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <Caret Line="186" Column="15" TopLine="160"/>
-      </Position29>
-      <Position30>
-        <Filename Value="../../../../../projects/lazarus/components/fpweb/reglazwebextra.pp"/>
-        <Caret Line="200" Column="3" TopLine="184"/>
-      </Position30>
+        <Caret Line="29" Column="44"/>
+      </Position3>
     </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <Parsing>
       <SyntaxOptions>
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-web/examples/httpapp/testhttp.pp b/packages/fcl-web/examples/httpapp/testhttp.pp
index 901ea8306c..ce9e6c269a 100644
--- a/packages/fcl-web/examples/httpapp/testhttp.pp
+++ b/packages/fcl-web/examples/httpapp/testhttp.pp
@@ -3,7 +3,7 @@
 program testhttp;
 
 uses
-  SysUtils, fphttpapp, fpwebfile;
+  SysUtils, fphttpapp, fpwebfile, wmecho;
 
 Procedure Usage;
 
diff --git a/packages/fcl-web/examples/httpclient/httpget.lpi b/packages/fcl-web/examples/httpclient/httpget.lpi
index 2d4de9a0cb..e14670d693 100644
--- a/packages/fcl-web/examples/httpclient/httpget.lpi
+++ b/packages/fcl-web/examples/httpclient/httpget.lpi
@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -32,14 +32,12 @@
       <local>
         <FormatVersion Value="1"/>
         <CommandLineParams Value="http://home/~michael/redirect.cgi out"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <Units Count="1">
       <Unit0>
         <Filename Value="httpget.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="httpget"/>
       </Unit0>
     </Units>
   </ProjectOptions>
@@ -48,12 +46,6 @@
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-web/examples/httpclient/keepalive.lpi b/packages/fcl-web/examples/httpclient/keepalive.lpi
new file mode 100644
index 0000000000..9eb01c8c74
--- /dev/null
+++ b/packages/fcl-web/examples/httpclient/keepalive.lpi
@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="keepalive"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="keepalive.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="keepalive"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/fcl-web/examples/httpclient/keepalive.pp b/packages/fcl-web/examples/httpclient/keepalive.pp
new file mode 100644
index 0000000000..877bfecd2f
--- /dev/null
+++ b/packages/fcl-web/examples/httpclient/keepalive.pp
@@ -0,0 +1,125 @@
+program keepalive;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CustApp, fphttpclient;
+
+const
+  URL_DIRECT = 'https://www.google.com/humans.txt';
+  URL_REDIRECTED = 'https://google.com/humans.txt';
+
+type
+
+  { TKeepConnectionDemo }
+
+  TKeepConnectionDemo = class(TCustomApplication)
+  private
+    FURL : String;
+    FShowResult : Boolean;
+    FCount : Integer;
+    FHttp: TFPHTTPClient;
+    FData: TBytesStream;
+    procedure DoRequests;
+    procedure Usage(Msg: string);
+  Protected
+    Procedure DoRun; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+  end;
+
+
+constructor TKeepConnectionDemo.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  StopOnException:=True;
+  FHttp := TFPHTTPClient.Create(nil);
+  FData := TBytesStream.Create;
+end;
+
+destructor TKeepConnectionDemo.Destroy;
+begin
+  FData.Free;
+  FHttp.Free;
+  inherited Destroy;
+end;
+
+
+procedure TKeepConnectionDemo.DoRequests;
+var
+  U: string;
+  B, E: TDateTime;
+  L : TStrings;
+  I : Integer;
+
+begin
+  for I:=1 to FCount do
+    begin
+    FData.Clear;
+    B := Now;
+    if (FURL<>'') then
+      U:=FURL
+    else if FHTTP.AllowRedirect then
+      U := URL_REDIRECTED
+    else
+      U := URL_DIRECT;
+    FHttp.Get(U, FData);
+    E := Now;
+    Writeln('Request ',i,', Duration: ',FormatDateTime('hh:nn:ss.zzz', E - B));
+    If FShowResult then
+      begin
+      FData.Seek(0, TSeekOrigin.soBeginning);
+      With TStringList.Create do
+        try
+          LoadFromStream(FData);
+          Writeln(text);
+        finally
+          Free;
+        end;
+     end;
+    end;
+end;
+
+procedure TKeepConnectionDemo.Usage(Msg : string);
+
+begin
+  if (Msg<>'') then
+    Writeln('Error : ',Msg);
+  Writeln(' Usage : keepalive [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h  --help              This help');
+  Writeln('-r  --redirect          Allow HTTP Redirect');
+  Writeln('-k  --keep-connection   Keep connection');
+  Writeln('-c  --count=N           Number of requests');
+  Writeln('-u  --URL=uri           Specify url');
+  Halt(Ord(Msg<>''));
+end;
+procedure TKeepConnectionDemo.DoRun;
+
+Var
+  S : String;
+
+begin
+  S:=CheckOptions('hrksc:u:',['count:','show','url:','redirect','keep-connection','help']);
+  if (S<>'') or HasOption('h','help') then
+    Usage(S);
+  FCount:=StrToIntDef(GetOptionValue('c','count'),10);
+  FShowResult:=HasOption('s','show');
+  FURL:=GetOptionValue('u','url');
+  FHTTP.AllowRedirect:=HasOption('r','redirect');
+  FHTTP.KeepConnection:=HasOption('k','keep-connection');
+  DoRequests;
+  Terminate;
+end;
+
+begin
+  With TKeepConnectionDemo.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    Finally
+      Free;
+    end;
+end.
+
diff --git a/packages/fcl-web/examples/httpserver/simplehttpserver.lpi b/packages/fcl-web/examples/httpserver/simplehttpserver.lpi
index 77428146d8..ff56b96f0c 100644
--- a/packages/fcl-web/examples/httpserver/simplehttpserver.lpi
+++ b/packages/fcl-web/examples/httpserver/simplehttpserver.lpi
@@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
     <Version Value="9"/>
@@ -13,7 +13,6 @@
       <Title Value="Simple HTTP server demo"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -32,28 +31,20 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <Units Count="1">
       <Unit0>
         <Filename Value="simplehttpserver.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="simplehttpserver"/>
       </Unit0>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
     </SearchPaths>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-web/examples/routing/README b/packages/fcl-web/examples/routing/README
new file mode 100644
index 0000000000..04afc62c07
--- /dev/null
+++ b/packages/fcl-web/examples/routing/README
@@ -0,0 +1,22 @@
+This demo demonstrates the routing mechanism of fpWeb.
+
+It can be run as a CGI or as a HTTP standalone server program.
+
+In order to get a correct set of routes in the demo, demorouting.ini file
+must be configured correctly and placed next to the binary.
+
+There is a different section for each type of binary: (CGI or Standalone)
+
+Each section needs at least the BaseURL key, this is the URL where the
+application can be reached.
+
+Example:
+
+[CGI]
+; Assuming the demo is in cgi-bin
+BaseURL=http://localhost/cgi-bin/demorouting.cgi
+
+[Standalone]
+Port=8080
+; Optional, the following is the default.
+;BaseURL=http://localhost:8080/
diff --git a/packages/fcl-pdf/utils/mkpdffontdef.lpi b/packages/fcl-web/examples/routing/demorouting.lpi
index 3b479598f6..8116b0c945 100644
--- a/packages/fcl-pdf/utils/mkpdffontdef.lpi
+++ b/packages/fcl-web/examples/routing/demorouting.lpi
@@ -9,13 +9,10 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <Title Value="mkpdffontdef"/>
+      <Title Value="demorouting"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
-    <i18n>
-      <EnableI18N LFM="False"/>
-    </i18n>
     <VersionInfo>
       <StringTable ProductVersion=""/>
     </VersionInfo>
@@ -28,20 +25,19 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="/usr/share/fonts/truetype/msttcorefonts/arial.ttf cp1252 arial.fnt"/>
       </local>
     </RunParams>
     <Units Count="3">
       <Unit0>
-        <Filename Value="mkpdffontdef.pp"/>
+        <Filename Value="demorouting.lpr"/>
         <IsPartOfProject Value="True"/>
       </Unit0>
       <Unit1>
-        <Filename Value="fpttfencodings.pp"/>
+        <Filename Value="routes.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit1>
       <Unit2>
-        <Filename Value="fpparsettf.pp"/>
+        <Filename Value="../../src/base/httproute.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit2>
     </Units>
@@ -49,23 +45,13 @@
   <CompilerOptions>
     <Version Value="11"/>
     <Target>
-      <Filename Value="mkpdffontdef"/>
+      <Filename Value="demorouting"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src"/>
-      <UnitOutputDirectory Value="units/"/>
+      <OtherUnitFiles Value="../../src/base"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
-    <Parsing>
-      <SyntaxOptions>
-        <UseAnsiStrings Value="False"/>
-      </SyntaxOptions>
-    </Parsing>
-    <Linking>
-      <Debugging>
-        <UseHeaptrc Value="True"/>
-      </Debugging>
-    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">
diff --git a/packages/fcl-web/examples/routing/demorouting.lpr b/packages/fcl-web/examples/routing/demorouting.lpr
new file mode 100644
index 0000000000..0c989b3923
--- /dev/null
+++ b/packages/fcl-web/examples/routing/demorouting.lpr
@@ -0,0 +1,34 @@
+program demorouting;
+
+{$DEFINE STANDALONE}
+
+uses
+  sysutils,
+  routes,
+{$IFDEF STANDALONE}
+  fphttpapp,
+{$ENDIF}
+{$IFDEF CGI}
+  fpcgi,
+{$ENDIF}
+  inifiles;
+
+
+begin
+  With TInifile.Create(ChangeFileExt(ParamStr(0),'.ini')) do
+    try
+      {$IFDEF CGI}
+      BaseURL:=ReadString('CGI','BaseURL','');
+      {$ENDIF CGI}
+      {$IFDEF STANDALONE}
+      Application.Port:=ReadInteger('Standalone','Port',8080);
+      BaseURL:=ReadString('Standalone','BaseURL','http://localhost:'+IntToStr(Application.Port));
+      {$ENDIF STANDALONE}
+    finally
+      Free;
+    end;
+  RegisterRoutes;
+  Application.Initialize;
+  Application.Run;
+end.
+
diff --git a/packages/fcl-web/examples/routing/routes.pp b/packages/fcl-web/examples/routing/routes.pp
new file mode 100644
index 0000000000..9c7812ae3e
--- /dev/null
+++ b/packages/fcl-web/examples/routing/routes.pp
@@ -0,0 +1,203 @@
+unit routes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ sysutils, classes, httpdefs, httproute;
+
+Var
+  BaseURL : String;
+
+Procedure RegisterRoutes;
+
+implementation
+
+uses webutil, fphttp;
+
+Type
+
+  { TMyModule }
+
+  TMyModule = Class(TCustomHTTPModule)
+    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  end;
+  
+  { TMyIntf }
+
+  TMyIntf = Class(TObject,IRouteInterface)
+  public
+    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse);
+  end;
+
+  { TMyHandler }
+
+  TMyHandler = Class(TRouteObject)
+  public
+    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse);override;
+  end;
+
+Var
+  C1,C2 : TComponent;
+  MyIntf : TMyIntf;
+
+
+Procedure DumpRoutes(L : TStrings; AURL : String);
+
+  Function DefaultReps(S : String) : string;
+
+  begin
+    Result:=StringReplace(S,'*path','somepath',[]);
+    Result:=StringReplace(Result,':param1','theparam1',[]);
+    Result:=StringReplace(Result,':param2','theparam2',[]);
+    Result:=StringReplace(Result,':param','theparam',[]);
+    If (Result<>'') and (Result[1]='/') then
+      Delete(Result,1,1);
+  end;
+
+Var
+  I : Integer;
+  P : String;
+
+begin
+  THTTPRouter.SanitizeRoute(AURL);
+  L.Add('<A NAME="routes"/>');
+  L.Add('<H1>Try these routes:</H1>');
+  For I:=0 to HTTPRouter.RouteCount-1 do
+    begin
+    P:=DefaultReps(HTTPRouter[i].URLPattern);
+    L.Add('<A HREF="'+BaseURL+'/'+P+'">'+P+'</a><br>');
+    end;
+end;
+
+Procedure RequestToResponse(ATitle : String; ARequest : TRequest; AResponse : TResponse; RouteParams : Array of String);
+
+Var
+  L : TStrings;
+  S : String;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.Add('<HTML>');
+    L.Add('<HEAD>');
+    L.Add('<TITLE>'+ATitle+'</TITLE>');
+    L.Add('</HEAD>');
+    L.Add('<BODY>');
+    L.Add('<H1>'+ATitle+'</H1>');
+    L.Add('<A HREF="#routes">Jump to routes overview</A>');
+    if (Length(RouteParams)>0) then
+      begin
+      L.Add('<H2>Routing parameters:</H2>');
+      L.Add('<table>');
+      L.Add('<tr><th>Param</th><th>Value</th></tr>');
+      for S in RouteParams do
+        L.Add('<tr><td>'+S+'</th><th>'+ARequest.RouteParams[S]+'</th></tr>');
+      L.Add('</table>');
+      end;
+    DumpRequest(ARequest,L,False);
+    DumpRoutes(L,ARequest.URL);
+    L.Add('</BODY>');
+    L.Add('</HTML>');
+    AResponse.Content:=L.Text;
+    AResponse.SendResponse;
+  finally
+    L.Free;
+  end;
+end;
+
+Procedure RequestToResponse(ATitle : String; ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse(ATitle,ARequest,AResponse,[]);
+end;
+
+Procedure SimpleCallBack(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse('Simple callback',ARequest,AResponse);
+end;
+
+Procedure DefaultCallBack(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse('Default callback (*path)',ARequest,AResponse,['path']);
+end;
+
+Procedure ParamPathMiddle(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse('Path in the middle (onepath/*path/new)',ARequest,AResponse,['path']);
+end;
+
+Procedure ParamPath(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse('Parametrized path (onepath/:param)',ARequest,AResponse,['param']);
+end;
+
+Procedure ParamPaths2(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse('Parametrized path (onepath/:param)',ARequest,AResponse,['param1','param2']);
+end;
+
+Procedure ComponentPath(AData : Pointer; ARequest : TRequest; AResponse : TResponse);
+
+begin
+  RequestToResponse('Component path (component: '+TComponent(AData).Name+')',ARequest,AResponse);
+end;
+
+
+
+{ TMyModule }
+
+procedure TMyModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  RequestToResponse('Old-fashioned Module',ARequest,AResponse);
+end;
+
+{ TMyHandler }
+
+procedure TMyHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  RequestToResponse('Route object',ARequest,AResponse);
+end;
+
+{ TMyIntf }
+
+procedure TMyIntf.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  RequestToResponse('Interface object',ARequest,AResponse);
+end;
+
+Procedure RegisterRoutes;
+
+begin
+  if (C1=Nil) then
+    begin
+    C1:=TComponent.Create(Nil);
+    C1.Name:='ComponentRoute1';
+    C2:=TComponent.Create(Nil);
+    C2.Name:='ComponentRoute2';
+    MyIntf:=TMyIntf.Create;
+    end;
+  HTTPRouter.RegisterRoute('simple',rmall,@SimpleCallBack);
+  HTTPRouter.RegisterRoute('onepath/:param',rmall,@ParamPath);
+  HTTPRouter.RegisterRoute('twopaths/:param1/:param2',rmall,@ParamPaths2);
+  HTTPRouter.RegisterRoute('onepath/*path/new',rmall,@ParamPathMiddle);
+  RegisterHTTPModule('module',TMyModule,True);
+  HTTPRouter.RegisterRoute('/component/1',C1,rmall,@ComponentPath);
+  HTTPRouter.RegisterRoute('/component/2',C2,rmall,@ComponentPath);
+  HTTPRouter.RegisterRoute('/interfaced',rmall,MyIntf);
+  HTTPRouter.RegisterRoute('/routed/object',rmall,TMyHandler);
+  // This will catch all other paths
+  HTTPRouter.RegisterRoute('*path',rmall,@DefaultCallBack,True);
+end;
+
+begin
+  FreeAndNil(C1);
+  FreeAndNil(C2);
+end.
+
diff --git a/packages/fcl-web/examples/routing/sample.ini b/packages/fcl-web/examples/routing/sample.ini
new file mode 100644
index 0000000000..c73365fd8f
--- /dev/null
+++ b/packages/fcl-web/examples/routing/sample.ini
@@ -0,0 +1,8 @@
+[CGI]
+; Assuming the demo is in cgi-bin
+BaseURL=http://localhost/cgi-bin/demorouting.cgi
+
+[Standalone]
+Port=8080
+; Optional, the following is the default.
+;BaseURL=http://localhost:8080/
diff --git a/packages/fcl-web/examples/simpleserver/README.txt b/packages/fcl-web/examples/simpleserver/README.txt
new file mode 100644
index 0000000000..f8f5799064
--- /dev/null
+++ b/packages/fcl-web/examples/simpleserver/README.txt
@@ -0,0 +1,10 @@
+
+Small demo for simple file module. The server will listen on a specified
+port (default 3000) and will serve files starting from the current working
+directory.
+
+Just start the server, no options, and point your browser at
+http://localhost:3000/
+
+running simpleserver -h will provide some help.
+
diff --git a/packages/fcl-web/examples/simpleserver/index.css b/packages/fcl-web/examples/simpleserver/index.css
new file mode 100644
index 0000000000..d92fefe7ca
--- /dev/null
+++ b/packages/fcl-web/examples/simpleserver/index.css
@@ -0,0 +1,3 @@
+.important {
+  color: red
+}
diff --git a/packages/fcl-web/examples/simpleserver/index.html b/packages/fcl-web/examples/simpleserver/index.html
new file mode 100644
index 0000000000..c0fb9296d1
--- /dev/null
+++ b/packages/fcl-web/examples/simpleserver/index.html
@@ -0,0 +1,10 @@
+<http>
+<link rel="stylesheet" href="index.css">
+<body>
+<H1>Simple server demo</H1>
+If you see this page, it demonstrates that the simple server demo serves the
+<span class="important">index.html</span> page. <p>
+If it shows index.html in a
+different style, it means the css is loaded as well.
+</body>
+</http>
\ No newline at end of file
diff --git a/packages/fcl-web/examples/simpleserver/simpleserver.lpi b/packages/fcl-web/examples/simpleserver/simpleserver.lpi
new file mode 100644
index 0000000000..95bb840b67
--- /dev/null
+++ b/packages/fcl-web/examples/simpleserver/simpleserver.lpi
@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="simpleserver"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="simpleserver.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="simpleserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/fcl-web/examples/simpleserver/simpleserver.pas b/packages/fcl-web/examples/simpleserver/simpleserver.pas
new file mode 100644
index 0000000000..f2f2939e99
--- /dev/null
+++ b/packages/fcl-web/examples/simpleserver/simpleserver.pas
@@ -0,0 +1,89 @@
+program simpleserver;
+
+uses sysutils,custhttpapp, fpwebfile;
+
+Type
+
+  { THTTPApplication }
+
+  THTTPApplication = Class(TCustomHTTPApplication)
+  private
+    FQuiet: Boolean;
+    procedure Usage(Msg: String);
+  published
+    procedure DoLog(EventType: TEventType; const Msg: String); override;
+    Procedure DoRun; override;
+    property Quiet : Boolean read FQuiet Write FQuiet;
+  end;
+
+Var
+  Application : THTTPApplication;
+
+{ THTTPApplication }
+
+procedure THTTPApplication.DoLog(EventType: TEventType; const Msg: String);
+begin
+  if Quiet then
+    exit;
+  if IsConsole then
+    Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now),' [',EventType,'] ',Msg)
+  else
+    inherited DoLog(EventType, Msg);
+end;
+
+procedure THTTPApplication.Usage(Msg : String);
+
+begin
+  if (Msg<>'') then
+    Writeln('Error: ',Msg);
+  Writeln('Usage ',ExtractFileName(ParamStr(0)),' [options] ');
+  Writeln('Where options is one or more of : ');
+  Writeln('-d --directory=dir  Base directory from which to serve files.');
+  Writeln('                    Default is current working directory: ',GetCurrentDir);
+  Writeln('-h --help           This help text');
+  Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
+  Writeln('-n --noindexpage    Do not allow index page.');
+  Writeln('-p --port=NNNN      TCP/IP port to listen on (default is 3000)');
+  Writeln('-q --quiet          Do not write diagnostic messages');
+  Halt(Ord(Msg<>''));
+end;
+
+procedure THTTPApplication.DoRun;
+
+Var
+  S,IndexPage,D : String;
+
+begin
+  S:=Checkoptions('hqd:ni:p:',['help','quiet','noindexpage','directory:','port:','indexpage:']);
+  if (S<>'') or HasOption('h','help') then
+    usage(S);
+  Quiet:=HasOption('q','quiet');
+  Port:=StrToIntDef(GetOptionValue('p','port'),3000);
+  D:=GetOptionValue('d','directory');
+  if D='' then
+    D:=GetCurrentDir;
+  Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+{$ifdef unix}
+  MimeTypesFile:='/etc/mime.types';
+{$endif}
+  TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
+  TSimpleFileModule.OnLog:=@Log;
+  If not HasOption('n','noindexpage') then
+    begin
+    IndexPage:=GetOptionValue('i','indexpage');
+    if IndexPage='' then
+      IndexPage:='index.html';
+    Log(etInfo,'Using index page %s',[IndexPage]);
+    TSimpleFileModule.IndexPageName:=IndexPage;
+    end;
+  inherited;
+end;
+
+begin
+  TSimpleFileModule.RegisterDefaultRoute;
+  Application:=THTTPApplication.Create(Nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.
+
diff --git a/packages/fcl-web/fpmake.pp b/packages/fcl-web/fpmake.pp
index f35e6fe6d5..8fed0c6ce6 100644
--- a/packages/fcl-web/fpmake.pp
+++ b/packages/fcl-web/fpmake.pp
@@ -19,12 +19,15 @@ begin
 {$endif ALLPACKAGES}
     P.Version:='3.0.1';
     P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros,morphos,dragonfly];
+    if Defaults.CPU=powerpc then
+      P.OSes:=P.OSes-[amiga];
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-db');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-json');
     P.Dependencies.Add('fcl-net');
     P.Dependencies.Add('fcl-process');
+    P.Dependencies.Add('fcl-fpcunit');
     P.Dependencies.Add('fastcgi');
     P.Dependencies.Add('httpd22', AllOses - [amiga,aros,morphos]);
     P.Dependencies.Add('httpd24', AllOses - [amiga,aros,morphos]);
@@ -41,6 +44,14 @@ begin
     P.SourcePath.Add('src/base');
     P.SourcePath.Add('src/webdata');
     P.SourcePath.Add('src/jsonrpc');
+    P.SourcePath.Add('src/hpack');
+
+    T:=P.Targets.AddUnit('httpdefs.pp');
+    T.ResourceStrings:=true;
+    T.Dependencies.AddUnit('httpprotocol');
+
+    T:=P.Targets.AddUnit('httproute.pp');
+    T.Dependencies.AddUnit('httpdefs');
 
     T:=P.Targets.AddUnit('cgiapp.pp');
     T.ResourceStrings:=true;
@@ -88,10 +99,7 @@ begin
     T:=P.Targets.AddUnit('httpprotocol.pp');
     T:=P.Targets.AddUnit('cgiprotocol.pp');
 
-    T:=P.Targets.AddUnit('httpdefs.pp');
-    T.Dependencies.AddUnit('httpprotocol');
     
-    T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('iniwebsession.pp');
     T.ResourceStrings:=true;
       with T.Dependencies do
@@ -113,6 +121,7 @@ begin
       begin
         ResourceStrings:=true;
         Dependencies.AddUnit('httpdefs');
+        Dependencies.AddUnit('httproute');
         Dependencies.AddUnit('fphttp');
       end;
     with P.Targets.AddUnit('webpage.pp') do
@@ -251,6 +260,17 @@ begin
     T.Dependencies.AddUnit('fpwebclient');
     T:=P.Targets.AddUnit('restbase.pp');
     T:=P.Targets.AddUnit('restcodegen.pp');
+
+    T:=P.Targets.AddUnit('uhpacktables.pp');
+    T:=P.Targets.AddUnit('uhpackimp.pp');
+    With T.Dependencies do  
+      AddUnit('uhpacktables');
+    T:=P.Targets.AddUnit('uhpack.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('uhpackimp');
+      end;
+    
 {$ifndef ALLPACKAGES}
     Run;
     end;
diff --git a/packages/fcl-web/src/base/README.txt b/packages/fcl-web/src/base/README.txt
index 958a904d48..aad01d62f0 100644
--- a/packages/fcl-web/src/base/README.txt
+++ b/packages/fcl-web/src/base/README.txt
@@ -6,6 +6,12 @@ fcl-base. See the fcl-base/texts/fptemplate.txt file.
 
 Architecture:
 
+httpprotocol:
+------------
+
+Mostly standard HTTP header definitions, and some auxiliary routines.
+
+
 httpdefs
 --------
 contains the basic HTTP system definitions: 
@@ -25,6 +31,75 @@ TResponse:
 TCustomSession: 
  Base for all session components.
 
+httproute
+---------
+
+The old Delphi style routing worked with Datamodules only. The pattern was
+strictly /modulename/actionname or through query variables: ?module=xyz&Action=nmo
+
+This old routing is still available by setting the LegacyRouting property of
+webhandler or webapplication (custweb) to true. (the new routing described
+below is then disabled)
+
+The new routing is more flexible in 3 ways.
+
+- It is no longer required to use datamodules, but this is still supported.
+  There are now 4 methods that can be used to register a route:
+
+  - Using a callback procedure
+    TRouteCallback = Procedure(ARequest: TRequest; AResponse);
+ 
+  - Using a callback event:
+    TRouteEvent = Procedure(ARequest: TRequest; AResponse) of object;
+
+  - Using an interface
+    IRouteInterface = Interface ['{10115353-10BA-4B00-FDA5-80B69AC4CAD0}']
+      Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse);
+    end;
+    Note that this is a CORBA interface, so no reference counting.
+
+  - Using a router object:
+    TRouteObject = Class(TObject,IRouteInterface)
+    Public
+      Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
+    end;
+    TRouteObjectClass = Class of TRouteObject;
+  The object class needs to be registered. The router will instantiate the
+  object and release it once the request was handled.
+ 
+  More methods can be added, if need be.
+  All routes are registered using the HTTPRouter.RegisterRoute method.
+  it is overloaded to accept any of the above parameters.
+
+- The router can now match more complex, parametrized routes.
+
+  A route is the path part of an URL; query parameters are not examined.
+
+  /path1/path2/path3/path4
+
+  In these paths, parameters and wildcards are recognized:
+  :param means that it will match any request with a single part in this location
+  *paramm means that it will match any request with zero or more path parts in this location
+
+  examples:
+
+  /path1  
+  /REST/:Resource/:ID
+  /REST/:Resource
+  /*/something
+  /*path/somethiingelse
+  /*path  
+ 
+  The parameters will be added to TRequest, they are available in the (new) RouteParams array property of TRequest.
+  
+  Paths are matched case sensitively by default, and the first matching pattern is used.
+ 
+  HTTP Modules are registered in the router using classname/* or defaultmodulename/*
+
+- A set of methods can be added to the route registration (default is to  accept all methods). 
+  The router will  match the request method. If the method does not match, it will raise an
+  exception which will result in a 405 HTTP error.
+
 fphttp:
 -------
 Basic web system components/classes
diff --git a/packages/fcl-web/src/base/custcgi.pp b/packages/fcl-web/src/base/custcgi.pp
index 7ee11a0335..e4954dafb7 100644
--- a/packages/fcl-web/src/base/custcgi.pp
+++ b/packages/fcl-web/src/base/custcgi.pp
@@ -353,7 +353,7 @@ procedure TCGIRequest.InitFromEnvironment;
 
 Var
   I : Integer;
-  R,V,OV : String;
+  R,V : String;
   M : TMap;
   
 begin
diff --git a/packages/fcl-web/src/base/custfcgi.pp b/packages/fcl-web/src/base/custfcgi.pp
index 652b289f39..246ed898d4 100644
--- a/packages/fcl-web/src/base/custfcgi.pp
+++ b/packages/fcl-web/src/base/custfcgi.pp
@@ -354,6 +354,9 @@ begin
     else
       NameValueList.Add(Name+'='+Value)
     end;
+  // Microsoft-IIS hack. IIS includes the script name in the PATH_INFO
+  if Pos('IIS', ServerSoftware) > 0 then
+    SetHTTPVariable(hvPathInfo,StringReplace(PathInfo, ScriptName, '', [rfReplaceAll, rfIgnoreCase]));
 end;
 
 procedure TFCGIRequest.Log(EventType: TEventType; const Msg: String);
diff --git a/packages/fcl-web/src/base/custhttpapp.pp b/packages/fcl-web/src/base/custhttpapp.pp
index 69501fc571..70fedc49be 100644
--- a/packages/fcl-web/src/base/custhttpapp.pp
+++ b/packages/fcl-web/src/base/custhttpapp.pp
@@ -37,6 +37,8 @@ Type
     Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); override;
     Property WebHandler : TFPHTTPServerHandler Read FWebHandler;
     Property Active;
+    Property OnAcceptIdle;
+    Property AcceptIdleTimeout;
   end;
 
   { TFCgiHandler }
@@ -49,9 +51,13 @@ Type
     FServer: TEmbeddedHTTPServer;
     function GetAllowConnect: TConnectQuery;
     function GetAddress: string;
+    function GetIdle: TNotifyEvent;
+    function GetIDleTimeOut: Cardinal;
     function GetPort: Word;
     function GetQueueSize: Word;
     function GetThreaded: Boolean;
+    procedure SetIdle(AValue: TNotifyEvent);
+    procedure SetIDleTimeOut(AValue: Cardinal);
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
     procedure SetAddress(const AValue: string);
     procedure SetPort(const AValue: Word);
@@ -86,13 +92,22 @@ Type
     Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
     // Should addresses be matched to hostnames ? (expensive)
     Property LookupHostNames : Boolean Read GetLookupHostNames Write SetLookupHostNames;
+    // Event handler called when going Idle while waiting for a connection
+    Property OnAcceptIdle : TNotifyEvent Read GetIdle Write SetIdle;
+    // If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
+    Property AcceptIdleTimeout : Cardinal Read GetIDleTimeOut Write SetIDleTimeOut;
   end;
 
   { TCustomHTTPApplication }
 
   TCustomHTTPApplication = Class(TCustomWebApplication)
   private
+    procedure FakeConnect;
+    function GetIdle: TNotifyEvent;
+    function GetIDleTimeOut: Cardinal;
     function GetLookupHostNames : Boolean;
+    procedure SetIdle(AValue: TNotifyEvent);
+    procedure SetIDleTimeOut(AValue: Cardinal);
     Procedure SetLookupHostnames(Avalue : Boolean);
     function GetAllowConnect: TConnectQuery;
     function GetAddress: String;
@@ -108,6 +123,7 @@ Type
     function InitializeWebHandler: TWebHandler; override;
     Function HTTPHandler : TFPHTTPServerHandler;
   Public
+    procedure Terminate; override;
     Property Address : string Read GetAddress Write SetAddress;
     Property Port : Word Read GetPort Write SetPort Default 80;
     // Max connections on queue (for Listen call)
@@ -118,6 +134,10 @@ Type
     property Threaded : Boolean read GetThreaded Write SetThreaded;
     // Should addresses be matched to hostnames ? (expensive)
     Property LookupHostNames : Boolean Read GetLookupHostNames Write SetLookupHostNames;
+    // Event handler called when going Idle while waiting for a connection
+    Property OnAcceptIdle : TNotifyEvent Read GetIdle Write SetIdle;
+    // If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
+    Property AcceptIdleTimeout : Cardinal Read GetIDleTimeOut Write SetIDleTimeOut;
   end;
 
 
@@ -143,13 +163,33 @@ uses
 
 { TCustomHTTPApplication }
 
+function TCustomHTTPApplication.GetIdle: TNotifyEvent;
+begin
+  Result:=HTTPHandler.OnAcceptIdle;
+end;
+
+function TCustomHTTPApplication.GetIDleTimeOut: Cardinal;
+begin
+  Result:=HTTPHandler.AcceptIdleTimeout;
+end;
+
 function TCustomHTTPApplication.GetLookupHostNames : Boolean;
 
 begin
   Result:=HTTPHandler.LookupHostNames;
 end;
 
-Procedure TCustomHTTPApplication.SetLookupHostnames(Avalue : Boolean);
+procedure TCustomHTTPApplication.SetIdle(AValue: TNotifyEvent);
+begin
+  HTTPHandler.OnAcceptIdle:=AValue;
+end;
+
+procedure TCustomHTTPApplication.SetIDleTimeOut(AValue: Cardinal);
+begin
+  HTTPHandler.AcceptIdleTimeOut:=AValue;
+end;
+
+procedure TCustomHTTPApplication.SetLookupHostnames(Avalue: Boolean);
 
 begin
   HTTPHandler.LookupHostNames:=AValue;
@@ -215,6 +255,25 @@ begin
   Result:=Webhandler as TFPHTTPServerHandler;
 end;
 
+procedure TCustomHTTPApplication.FakeConnect;
+
+begin
+  try
+    TInetSocket.Create('localhost',Self.Port).Free;
+  except
+    // Ignore errors this may raise.
+  end
+end;
+
+procedure TCustomHTTPApplication.Terminate;
+
+begin
+  inherited Terminate;
+  // We need to break the accept loop. Do a fake connect.
+  if Threaded And (AcceptIdleTimeout=0) then
+    FakeConnect;
+end;
+
 { TFPHTTPServerHandler }
 
 procedure TFPHTTPServerHandler.HandleRequestError(Sender: TObject; E: Exception
@@ -251,7 +310,7 @@ begin
   Result:=FServer.LookupHostNames;
 end;
 
-Procedure TFPHTTPServerHandler.SetLookupHostnames(Avalue : Boolean);
+procedure TFPHTTPServerHandler.SetLookupHostnames(Avalue: Boolean);
 
 begin
   FServer.LookupHostNames:=AValue;
@@ -267,6 +326,16 @@ begin
   Result:=FServer.Address;
 end;
 
+function TFPHTTPServerHandler.GetIdle: TNotifyEvent;
+begin
+  Result:=FServer.OnAcceptIdle;
+end;
+
+function TFPHTTPServerHandler.GetIDleTimeOut: Cardinal;
+begin
+  Result:=FServer.AcceptIdleTimeout;
+end;
+
 function TFPHTTPServerHandler.GetPort: Word;
 begin
   Result:=FServer.Port;
@@ -282,6 +351,16 @@ begin
   Result:=FServer.Threaded;
 end;
 
+procedure TFPHTTPServerHandler.SetIdle(AValue: TNotifyEvent);
+begin
+  FServer.OnAcceptIdle:=AValue;
+end;
+
+procedure TFPHTTPServerHandler.SetIDleTimeOut(AValue: Cardinal);
+begin
+  FServer.AcceptIdleTimeOut:=AValue;
+end;
+
 procedure TFPHTTPServerHandler.SetOnAllowConnect(const AValue: TConnectQuery);
 begin
   FServer.OnAllowConnect:=Avalue
diff --git a/packages/fcl-web/src/base/custweb.pp b/packages/fcl-web/src/base/custweb.pp
index ba08b4060f..595d4c5463 100644
--- a/packages/fcl-web/src/base/custweb.pp
+++ b/packages/fcl-web/src/base/custweb.pp
@@ -37,6 +37,7 @@ Type
   TWebHandler = class(TComponent)
   private
     FDefaultModuleName: String;
+    FLegacyRouting: Boolean;
     FOnIdle: TNotifyEvent;
     FOnInitModule: TInitModuleEvent;
     FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
@@ -55,6 +56,9 @@ Type
     FOnTerminate : TNotifyEvent;
     FOnLog : TLogEvent;
     FPreferModuleName : Boolean;
+    procedure DoCallModule(AModule: TCustomHTTPModule; AModuleName: String; ARequest: TRequest; AResponse: TResponse);
+    procedure HandleModuleRequest(Sender: TModuleItem; ARequest: TRequest; AResponse: TResponse);
+    procedure OldHandleRequest(ARequest: TRequest; AResponse: TResponse);
   protected
     Class Procedure DoError(Msg : String; AStatusCode : Integer = 0; AStatusText : String = '');
     Class Procedure DoError(Fmt : String; Const Args : Array of const;AStatusCode : Integer = 0; AStatusText : String = '');
@@ -73,6 +77,7 @@ Type
     property Terminated: boolean read FTerminated;
   Public
     constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
     Procedure Run; virtual;
     Procedure Log(EventType : TEventType; Const Msg : String);
     Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse);
@@ -94,6 +99,7 @@ Type
     Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read FOnUnknownRequestEncoding Write FOnUnknownRequestEncoding;
     Property OnInitModule: TInitModuleEvent Read FOnInitModule write FOnInitModule;
     Property PreferModuleName : Boolean Read FPreferModuleName Write FPreferModuleName;
+    Property LegacyRouting : Boolean Read FLegacyRouting Write FLegacyRouting;
   end;
 
   TCustomWebApplication = Class(TCustomApplication)
@@ -107,6 +113,7 @@ Type
     function GetEmail: String;
     function GetEventLog: TEventLog;
     function GetHandleGetOnPost: Boolean;
+    function GetLegacyRouting: Boolean;
     function GetModuleVar: String;
     function GetOnGetModule: TGetModuleEvent;
     function GetOnShowRequestException: TOnShowRequestException;
@@ -120,6 +127,7 @@ Type
     procedure SetDefaultModuleName(AValue: String);
     procedure SetEmail(const AValue: String);
     procedure SetHandleGetOnPost(const AValue: Boolean);
+    procedure SetLegacyRouting(AValue: Boolean);
     procedure SetModuleVar(const AValue: String);
     procedure SetOnGetModule(const AValue: TGetModuleEvent);
     procedure SetOnShowRequestException(const AValue: TOnShowRequestException);
@@ -155,6 +163,7 @@ Type
     Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read GetOnUnknownRequestEncoding Write SetOnUnknownRequestEncoding;
     Property EventLog: TEventLog read GetEventLog;
     Property PreferModuleName : Boolean Read GetPreferModuleName Write SetPreferModuleName;
+    Property LegacyRouting : Boolean Read GetLegacyRouting Write SetLegacyRouting;
   end;
 
   EFPWebError = Class(EFPHTTPError);
@@ -163,10 +172,12 @@ procedure ExceptionToHTML(S: TStrings; const E: Exception; const Title, Email, A
 
 Implementation
 
-{$ifdef CGIDEBUG}
+
 uses
-  dbugintf;
-{$endif}
+  {$ifdef CGIDEBUG}
+  dbugintf,
+  {$endif}
+  httproute;
 
 resourcestring
   SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
@@ -302,54 +313,89 @@ begin
   Result := FAdministrator;
 end;
 
-Procedure TWebHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+Procedure TWebHandler.DoCallModule(AModule : TCustomHTTPModule; AModuleName : String ; ARequest: TRequest; AResponse: TResponse);
+
+begin
+  SetBaseURL(AModule,AModuleName,ARequest);
+  if (OnInitModule<>Nil) then
+    OnInitModule(Self,AModule);
+  AModule.DoAfterInitModule(ARequest);
+  if AModule.Kind=wkOneShot then
+    begin
+    try
+      AModule.HandleRequest(ARequest,AResponse);
+    finally
+      AModule.Free;
+    end;
+    end
+  else
+    AModule.HandleRequest(ARequest,AResponse);
+end;
+
+Procedure TWebHandler.HandleModuleRequest(Sender : TModuleItem; ARequest: TRequest; AResponse: TResponse);
+
 Var
   MC : TCustomHTTPModuleClass;
   M  : TCustomHTTPModule;
   MN : String;
-  MI : TModuleItem;
+
+begin
+  MC:=Sender.ModuleClass;
+  MN:=Sender.ModuleName;
+  // Modules expect the path info to contain the action name as the first part. (See getmodulename);
+  ARequest.GetNextPathInfo;
+  if Sender.SkipStreaming then
+    M:=MC.CreateNew(Self)
+  else
+    M:=MC.Create(Self);
+  DoCallModule(M,MN,ARequest,AResponse);
+end;
+
+Procedure TWebHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
 
 begin
   try
-    MC:=Nil;
-    M:=NIL;
-    MI:=Nil;
-    If (OnGetModule<>Nil) then
-      OnGetModule(Self,ARequest,MC);
-    If (MC=Nil) then
-      begin
-      MN:=GetModuleName(ARequest);
-      MI:=ModuleFactory.FindModule(MN);
-      if (MI=Nil) then
-        DoError(SErrNoModuleForRequest,[MN],400,'Not found');
-      MC:=MI.ModuleClass;
-      end;
-    M:=FindModule(MC); // Check if a module exists already
-    If (M=Nil) then
-      if assigned(MI) and Mi.SkipStreaming then
-        M:=MC.CreateNew(Self)
-      else
-        M:=MC.Create(Self);
-    SetBaseURL(M,MN,ARequest);
-    if (OnInitModule<>Nil) then
-      OnInitModule(Self,M);
-    M.DoAfterInitModule(ARequest);
-    if M.Kind=wkOneShot then
-      begin
-      try
-        M.HandleRequest(ARequest,AResponse);
-      finally
-        M.Free;
-      end;
-      end
+    if LegacyRouting then
+      OldHandleRequest(ARequest,AResponse)
     else
-      M.HandleRequest(ARequest,AResponse);
+      HTTPRouter.RouteRequest(ARequest,AResponse);
   except
     On E : Exception do
       ShowRequestException(AResponse,E);
   end;
 end;
 
+Procedure TWebHandler.OldHandleRequest(ARequest: TRequest; AResponse: TResponse);
+
+Var
+  MC : TCustomHTTPModuleClass;
+  M  : TCustomHTTPModule;
+  MN : String;
+  MI : TModuleItem;
+
+begin
+  MC:=Nil;
+  M:=NIL;
+  MI:=Nil;
+  If (OnGetModule<>Nil) then
+    OnGetModule(Self,ARequest,MC);
+  If (MC=Nil) then
+    begin
+    MN:=GetModuleName(ARequest);
+    MI:=ModuleFactory.FindModule(MN);
+    if (MI=Nil) then
+      DoError(SErrNoModuleForRequest,[MN],400,'Not found');
+    MC:=MI.ModuleClass;
+    end;
+  M:=FindModule(MC); // Check if a module exists already
+  If (M=Nil) then
+    if assigned(MI) and Mi.SkipStreaming then
+      M:=MC.CreateNew(Self)
+    else
+      M:=MC.Create(Self);
+   DoCallModule(M,MN,ARequest,AResponse);
+end;
+
 function TWebHandler.GetApplicationURL(ARequest: TRequest): String;
 begin
   Result:=FApplicationURL;
@@ -482,6 +528,12 @@ begin
   FHandleGetOnPost := True;
   FRedirectOnError := False;
   FRedirectOnErrorURL := '';
+  ModuleFactory.OnModuleRequest:=@HandleModuleRequest;
+end;
+
+destructor TWebHandler.Destroy;
+begin
+  ModuleFactory.OnModuleRequest:=@HandleModuleRequest;
 end;
 
 { TCustomWebApplication }
@@ -537,6 +589,11 @@ begin
   result := FWebHandler.HandleGetOnPost;
 end;
 
+function TCustomWebApplication.GetLegacyRouting: Boolean;
+begin
+  Result:=FWebHandler.LegacyRouting;
+end;
+
 function TCustomWebApplication.GetModuleVar: String;
 begin
   result := FWebHandler.ModuleVariable;
@@ -602,6 +659,11 @@ begin
   FWebHandler.HandleGetOnPost := AValue;
 end;
 
+procedure TCustomWebApplication.SetLegacyRouting(AValue: Boolean);
+begin
+  FWebHandler.LegacyRouting:=AValue;
+end;
+
 procedure TCustomWebApplication.SetModuleVar(const AValue: String);
 begin
   FWebHandler.ModuleVariable := AValue;
diff --git a/packages/fcl-web/src/base/fphttp.pp b/packages/fcl-web/src/base/fphttp.pp
index de7e608d39..cf420b3d00 100644
--- a/packages/fcl-web/src/base/fphttp.pp
+++ b/packages/fcl-web/src/base/fphttp.pp
@@ -17,7 +17,7 @@ unit fphttp;
 
 Interface
 
-uses sysutils,classes,httpdefs;
+uses sysutils,classes,httpdefs, httproute;
 
 Type
 { TODO : Implement wkSession }
@@ -188,28 +188,40 @@ Type
 
   { TModuleItem }
 
-  TModuleItem = Class(TCollectionItem)
+  TModuleItem = Class(TCollectionItem, IRouteInterface)
   private
     FModuleClass: TCustomHTTPModuleClass;
     FModuleName: String;
     FSkipStreaming: Boolean;
+    FRouteID : Integer;
+  Protected
+    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse);
+    Property RouteID : Integer Read FRouteID;
   Public
+    Destructor Destroy; override;
     Property ModuleClass : TCustomHTTPModuleClass Read FModuleClass Write FModuleClass;
     Property ModuleName : String Read FModuleName Write FModuleName;
     Property SkipStreaming : Boolean Read FSkipStreaming Write FSkipStreaming;
   end;
 
   { TModuleFactory }
+  TOnModuleRequest = Procedure (Sender : TModuleItem; ARequest: TRequest; AResponse: TResponse) of object;
 
   TModuleFactory = Class(TCollection)
   private
+    FOnModuleRequest: TOnModuleRequest;
     function GetModule(Index : Integer): TModuleItem;
     procedure SetModule(Index : Integer; const AValue: TModuleItem);
+  Protected
+    procedure DoHandleRequest(Sender : TModuleItem; ARequest: TRequest; AResponse: TResponse);
   Public
+    Procedure RegisterHTTPModule(Const ModuleName : String; ModuleClass : TCustomHTTPModuleClass; SkipStreaming : Boolean = False);virtual;
+    Procedure RegisterHTTPModule(ModuleClass : TCustomHTTPModuleClass; SkipStreaming : Boolean = False);
     Function FindModule(const AModuleName : String) : TModuleItem;
     Function ModuleByName(const AModuleName : String) : TModuleItem;
     Function IndexOfModule(const AModuleName : String) : Integer;
     Property Modules [Index : Integer]: TModuleItem Read GetModule Write SetModule;default;
+    Property OnModuleRequest : TOnModuleRequest Read FOnModuleRequest Write FOnModuleRequest;
   end;
 
   { EFPHTTPError }
@@ -237,9 +249,9 @@ Resourcestring
 
 Implementation
 
-{$ifdef cgidebug}
-uses dbugintf;
-{$endif}
+
+{$ifdef cgidebug} uses dbugintf; {$endif}
+
 
 Var
   GSM : TSessionFactory;
@@ -256,6 +268,21 @@ begin
   Result:=GSM;
 end;
 
+{ TModuleItem }
+
+procedure TModuleItem.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  if (Collection is TModuleFactory) then
+    (Collection as TModuleFactory).DoHandleRequest(Self,ARequest,AResponse);
+end;
+
+destructor TModuleItem.Destroy;
+begin
+  if (FRouteID>0) then
+    httprouter.DeleteRouteByID(FRouteID-1);
+  inherited Destroy;
+end;
+
 
 { TCustomHTTPModule }
 
@@ -335,6 +362,39 @@ begin
   Items[Index]:=AValue;
 end;
 
+procedure TModuleFactory.DoHandleRequest(Sender: TModuleItem; ARequest: TRequest; AResponse: TResponse);
+begin
+  If Assigned(OnModuleRequest) then
+    OnModuleRequest(Sender,ARequest,AResponse)
+  else
+    Raise EFPHTTPError.Create('Cannot handle module request, OnModuleRequest not set');
+end;
+
+procedure TModuleFactory.RegisterHTTPModule(const ModuleName: String; ModuleClass: TCustomHTTPModuleClass; SkipStreaming: Boolean);
+
+Var
+  I : Integer;
+  MI : TModuleItem;
+
+begin
+  I:=IndexOfModule(ModuleName);
+  If (I=-1) then
+    begin
+    MI:=Add as TModuleItem;
+    MI.ModuleName:=ModuleName;
+    MI.FRouteID:=httprouter.RegisterRoute('/'+MI.FModuleName+'/*', MI as IRouteInterface,False).ID+1;
+    end
+  else
+    MI:=ModuleFactory[I];
+  MI.ModuleClass:=ModuleClass;
+  MI.SkipStreaming:=SkipStreaming;
+end;
+
+procedure TModuleFactory.RegisterHTTPModule(ModuleClass: TCustomHTTPModuleClass; SkipStreaming: Boolean);
+begin
+  RegisterHTTPModule(ModuleClass.DefaultModuleName,ModuleClass,SkipStreaming);
+end;
+
 function TModuleFactory.FindModule(const AModuleName: String): TModuleItem;
 
 Var
@@ -366,27 +426,14 @@ end;
 
 procedure RegisterHTTPModule(ModuleClass: TCustomHTTPModuleClass; SkipStreaming : Boolean = False);
 begin
-  RegisterHTTPModule(ModuleClass.ClassName,ModuleClass,SkipStreaming);
+  ModuleFactory.RegisterHTTPModule(ModuleClass,SkipStreaming);
 end;
 
 procedure RegisterHTTPModule(const ModuleName: String;
   ModuleClass: TCustomHTTPModuleClass; SkipStreaming : Boolean = False);
   
-Var
-  I : Integer;
-  MI : TModuleItem;
-  
 begin
-  I:=ModuleFactory.IndexOfModule(ModuleName);
-  If (I=-1) then
-    begin
-    MI:=ModuleFactory.Add as TModuleItem;
-    MI.ModuleName:=ModuleName;
-    end
-  else
-    MI:=ModuleFactory[I];
-  MI.ModuleClass:=ModuleClass;
-  MI.SkipStreaming:=SkipStreaming;
+  ModuleFactory.RegisterHTTPModule(ModuleName,ModuleClass,SkipStreaming);
 end;
 
 { THTTPContentProducer }
diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp
index bafff68501..22e4ed7269 100644
--- a/packages/fcl-web/src/base/fphttpclient.pp
+++ b/packages/fcl-web/src/base/fphttpclient.pp
@@ -70,6 +70,7 @@ Type
     FDataRead : Int64;
     FContentLength : Int64;
     FAllowRedirect: Boolean;
+    FKeepConnection: Boolean;
     FMaxRedirects: Byte;
     FOnDataReceived: TDataEvent;
     FOnHeaders: TNotifyEvent;
@@ -88,6 +89,7 @@ Type
     FServerHTTPVersion: String;
     FSocket : TInetSocket;
     FBuffer : Ansistring;
+    FTerminated: Boolean;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
     FProxy : TProxyData;
@@ -97,10 +99,26 @@ Type
     function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
+    procedure SetHTTPVersion(const AValue: String);
+    procedure SetKeepConnection(AValue: Boolean);
     procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
+    Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
+    Procedure CheckConnectionCloseHeader;
   protected
+
+    Function NoContentAllowed(ACode : Integer) : Boolean;
+    // Peform a request, close connection.
+    Procedure DoNormalRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Peform a request, try to keep connection.
+    Procedure DoKeepConnectionRequest(const AURI: TURI; const AMethod: string;
+      AStream: TStream; const AAllowedResponseCodes: array of Integer;
+      AHeadersOnly, AIsHttps: Boolean); virtual;
+    // Return True if FSocket is assigned
+    Function IsConnected: Boolean; virtual;
     // True if we need to use a proxy: ProxyData Assigned and Hostname Set
     Function ProxyActive : Boolean;
     // Override this if you want to create a custom instance of proxy.
@@ -112,19 +130,23 @@ Type
     // Construct server URL for use in request line.
     function GetServerURL(URI: TURI): String;
     // Read 1 line of response. Fills FBuffer
-    function ReadString: String;
+    function ReadString(out S: String): Boolean;
     // Check if response code is in AllowedResponseCodes. if not, an exception is raised.
     // If AllowRedirect is true, and the result is a Redirect status code, the result is also true
     // If the OnPassword event is set, then a 401 will also result in True.
     function CheckResponseCode(ACode: Integer;  const AllowedResponseCodes: array of Integer): Boolean; virtual;
     // Read response from server, and write any document to Stream.
-    Procedure ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
+    Function ReadResponse(Stream: TStream;  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
     // Read server response line and headers. Returns status code.
     Function ReadResponseHeaders : integer; virtual;
     // Allow header in request ? (currently checks only if non-empty and contains : token)
     function AllowHeader(var AHeader: String): Boolean; virtual;
+    // Return True if the "connection: close" header is present
+    Function HasConnectionClose: Boolean; virtual;
     // Connect to the server. Must initialize FSocket.
     Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
+    // Re-connect to the server. Must reinitialize FSocket.
+    Procedure ReconnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
     // Disconnect from server. Must free FSocket.
     Procedure DisconnectFromServer; virtual;
     // Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
@@ -145,13 +167,16 @@ Type
     Class Function IndexOfHeader(HTTPHeaders : TStrings; Const AHeader : String) : Integer;
     // Return value of header AHeader from httpheaders. Returns empty if it doesn't exist yet.
     Class Function GetHeader(HTTPHeaders : TStrings; Const AHeader : String) : String;
+    { Terminate the current request.
+      It will stop the client from trying to send and/or receive data after the current chunk is sent/received. }
+    Procedure Terminate;
     // Request Header management
     // Return index of header, -1 if not present.
     Function IndexOfHeader(Const AHeader : String) : Integer;
     // Add header, replacing an existing one if it exists.
     Procedure AddHeader(Const AHeader,AValue : String);
     // Return header value, empty if not present.
-    Function GetHeader(Const AHeader : String) : String;
+    Function  GetHeader(Const AHeader : String) : String;
     // General-purpose call. Handles redirect and authorization retry (OnPassword).
     Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
     // Execute GET on server, store result in Stream, File, StringList or string
@@ -241,6 +266,8 @@ Type
     Procedure StreamFormPost(const AURL: string; FormData: TStrings; const AFieldName, AFileName: string; const AStream: TStream; const Response: TStream);
     // Simple form of Posting a file
     Class Procedure SimpleFileFormPost(const AURL, AFieldName, AFileName: string; const Response: TStream);
+    // Has Terminate been called ?
+    Property Terminated : Boolean Read FTerminated;
   Protected
     // Timeouts
     Property IOTimeout : Integer read FIOTimeout write SetIOTimeout;
@@ -253,7 +280,8 @@ Type
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
     // used HTTP version when constructing the request.
-    Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
+    // Setting this to any other value than 1.1 will set KeepConnection to False.
+    Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
     // After request properties.
     // After request, this contains the headers sent by server.
     Property ResponseHeaders : TStrings Read FResponseHeaders;
@@ -277,6 +305,10 @@ Type
     // They also override any Authenticate: header in Requestheaders.
     Property UserName : String Read FUserName Write FUserName;
     Property Password : String Read FPassword Write FPassword;
+    // Is client connected?
+    Property Connected: Boolean read IsConnected;
+    // Keep-Alive support. Setting to true will set HTTPVersion to 1.1
+    Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
     // If a request returns a 401, then the OnPassword event is fired.
     // It can modify the username/password and set RepeatRequest to true;
     Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
@@ -292,6 +324,8 @@ Type
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
   Published
+    Property KeepConnection;
+    Property Connected;
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestBody;
@@ -457,6 +491,16 @@ begin
     FSocket.IOTimeout:=AValue;
 end;
 
+function TFPCustomHTTPClient.IsConnected: Boolean;
+begin
+  Result := Assigned(FSocket);
+end;
+
+function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
+begin
+  Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
+end;
+
 function TFPCustomHTTPClient.ProxyActive: Boolean;
 begin
   Result:=Assigned(FProxy) and (FProxy.Host<>'') and (FProxy.Port>0);
@@ -513,7 +557,6 @@ begin
       Result:=':'+IntToStr(URI.Port)+Result;
     Result:=URI.Protocol+'://'+URI.Host+Result;
     end;
-  Writeln('Doing URL : ',Result);
 end;
 
 function TFPCustomHTTPClient.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
@@ -539,6 +582,8 @@ Var
 
 
 begin
+  If IsConnected Then
+    DisconnectFromServer; // avoid memory leaks
   if (Aport=0) then
     if UseSSL then
       Aport:=443
@@ -556,6 +601,13 @@ begin
   end;
 end;
 
+Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
+  APort: Integer; UseSSL: Boolean);
+begin
+  DisconnectFromServer;
+  ConnectToServer(AHost, APort, UseSSL);
+end;
+
 procedure TFPCustomHTTPClient.DisconnectFromServer;
 
 begin
@@ -568,6 +620,11 @@ begin
   Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
 end;
 
+Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
+begin
+  Result := CompareText(GetHeader('Connection'), 'close') = 0;
+end;
+
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 
 Var
@@ -602,6 +659,7 @@ begin
   S:=S+CRLF;
   If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
     AddHeader('Content-Length',IntToStr(RequestBody.Size));
+  CheckConnectionCloseHeader;
   For I:=0 to FRequestHeaders.Count-1 do
     begin
     l:=FRequestHeaders[i];
@@ -624,53 +682,60 @@ begin
   FSentCookies:=FCookies;
   FCookies:=Nil;
   S:=S+CRLF;
-  FSocket.WriteBuffer(S[1],Length(S));
-  If Assigned(FRequestBody) then
+  if not Terminated then
+    FSocket.WriteBuffer(S[1],Length(S));
+  If Assigned(FRequestBody) and not Terminated then
     FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
 end;
 
-function TFPCustomHTTPClient.ReadString : String;
+function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
 
-  Procedure FillBuffer;
+  Function FillBuffer: Boolean;
 
   Var
     R : Integer;
 
   begin
+    if Terminated then
+      Exit(False);
     SetLength(FBuffer,ReadBufLen);
     r:=FSocket.Read(FBuffer[1],ReadBufLen);
-    If r<0 then
+    If (r=0) or Terminated Then
+      Exit(False);
+    If (r<0) then
       Raise EHTTPClient.Create(SErrReadingSocket);
     if (r<ReadBuflen) then
       SetLength(FBuffer,r);
     FDataRead:=FDataRead+R;
     DoDataRead;
+    Result:=r>0;
   end;
 
 Var
-  CheckLF,Done : Boolean;
+  CheckLF: Boolean;
   P,L : integer;
 
 begin
-  Result:='';
-  Done:=False;
+  S:='';
+  Result:=False;
   CheckLF:=False;
   Repeat
     if Length(FBuffer)=0 then
-      FillBuffer;
+      if not FillBuffer then
+        Break;
     if Length(FBuffer)=0 then
-      Done:=True
+      Result:=True
     else if CheckLF then
       begin
       If (FBuffer[1]<>#10) then
-        Result:=Result+#13
+        S:=S+#13
       else
         begin
         System.Delete(FBuffer,1,1);
-        Done:=True;
+        Result:=True;
         end;
       end;
-    if not Done then
+    if not Result then
       begin
       P:=Pos(#13#10,FBuffer);
       If P=0 then
@@ -678,20 +743,21 @@ begin
         L:=Length(FBuffer);
         CheckLF:=FBuffer[L]=#13;
         if CheckLF then
-          Result:=Result+Copy(FBuffer,1,L-1)
+          S:=S+Copy(FBuffer,1,L-1)
         else
-          Result:=Result+FBuffer;
+          S:=S+FBuffer;
         FBuffer:='';
         end
       else
         begin
-        Result:=Result+Copy(FBuffer,1,P-1);
+        S:=S+Copy(FBuffer,1,P-1);
         System.Delete(FBuffer,1,P+1);
-        Done:=True;
+        Result:=True;
         end;
       end;
-  until Done;
+  until Result or Terminated;
 end;
+
 Function GetNextWord(Var S : String) : string;
 
 Const
@@ -750,7 +816,7 @@ function TFPCustomHTTPClient.ReadResponseHeaders: integer;
       C:=Trim(Copy(S,1,P-1));
       Cookies.Add(C);
       System.Delete(S,1,P);
-    Until (S='');
+    Until (S='') or Terminated;
   end;
 
 Const
@@ -760,18 +826,18 @@ Var
   StatusLine,S : String;
 
 begin
-  StatusLine:=ReadString;
+  if not ReadString(StatusLine) then
+    Exit(0);
   Result:=ParseStatusLine(StatusLine);
   Repeat
-    S:=ReadString;
-    if (S<>'') then
+    if ReadString(S) and (S<>'') then
       begin
       ResponseHeaders.Add(S);
       If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
         DoCookies(S);
       end
-  Until (S='');
-  If Assigned(FOnHeaders) then
+  Until (S='') or Terminated;
+  If Assigned(FOnHeaders) and not Terminated then
     FOnHeaders(Self);
 end;
 
@@ -872,14 +938,33 @@ begin
   GetCookies.Assign(AValue);
 end;
 
+procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
+begin
+  if FHTTPVersion = AValue then Exit;
+  FHTTPVersion := AValue;
+  if (AValue<>'1.1') then
+    KeepConnection:=False;
+end;
+
+procedure TFPCustomHTTPClient.SetKeepConnection(AValue: Boolean);
+begin
+  if FKeepConnection=AValue then Exit;
+  FKeepConnection:=AValue;
+  if AValue then
+    HTTPVersion:='1.1'
+  else if IsConnected then
+    DisconnectFromServer;
+  CheckConnectionCloseHeader;
+end;
+
 procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
 begin
   if (AValue=FProxy) then exit;
   Proxy.Assign(AValue);
 end;
 
-procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
-  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
+Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
+  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
 
   Function Transfer(LB : Integer) : Integer;
 
@@ -914,6 +999,9 @@ procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
     function FetchData(out Cnt: integer): boolean;
 
     begin
+      Result:=False;
+      If Terminated then
+        exit;
       SetLength(FBuffer,ReadBuflen);
       Cnt:=FSocket.Read(FBuffer[1],length(FBuffer));
       If Cnt<0 then
@@ -962,17 +1050,20 @@ procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
         '0'..'9': ChunkSize:=ChunkSize*16+ord(c)-ord('0');
         'a'..'f': ChunkSize:=ChunkSize*16+ord(c)-ord('a')+10;
         'A'..'F': ChunkSize:=ChunkSize*16+ord(c)-ord('A')+10;
-        else break;
+        else
+          break;
         end;
         if ChunkSize>1000000 then
           Raise EHTTPClient.Create(SErrChunkTooBig);
-      until false;
+      until Terminated;
       // read till line end
-      while (c<>#10) do
+      while (c<>#10) and not Terminated do
         if ReadData(@c,1)<1 then exit;
       if ChunkSize=0 then exit;
       // read data
       repeat
+        if Terminated then
+          exit;
         l:=length(FBuffer)-BufPos+1;
         if l=0 then
           if not FetchData(l) then
@@ -988,14 +1079,18 @@ procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
           end;
       until ChunkSize=0;
       // read #13#10
-      if ReadData(@c,1)<1 then exit;
-      if c<>#13 then
-        Raise EHTTPClient.Create(SErrChunkLineEndMissing);
-      if ReadData(@c,1)<1 then exit;
-      if c<>#10 then
-        Raise EHTTPClient.Create(SErrChunkLineEndMissing);
-      // next chunk
-    until false;
+      if ReadData(@c,1)<1 then
+        exit;
+      if Not Terminated then
+        begin
+        if c<>#13 then
+          Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+        if ReadData(@c,1)<1 then exit;
+        if c<>#10 then
+          Raise EHTTPClient.Create(SErrChunkLineEndMissing);
+        // next chunk
+        end;
+    until Terminated;
   end;
 
 Var
@@ -1007,6 +1102,9 @@ begin
   FContentLength:=0;
   SetLength(FBuffer,0);
   FResponseStatusCode:=ReadResponseHeaders;
+  Result := FResponseStatusCode > 0;
+  if not Result then
+    Exit;
   if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
     Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
   if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
@@ -1033,25 +1131,117 @@ begin
           LB:=L;
         R:=Transfer(LB);
         L:=L-R;
-      until (L=0) or (R=0);
+      until (L=0) or (R=0) or Terminated;
       end
-    else if L<0 then
+    else if (L<0) and (Not NoContentAllowed(ResponseStatusCode)) then
       begin
       // No content-length, so we read till no more data available.
       Repeat
         R:=Transfer(ReadBufLen);
-      until (R=0);
+      until (R=0) or Terminated;
       end;
     end;
 end;
 
-procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
-  Stream: TStream; const AllowedResponseCodes: array of Integer);
+Procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; Out AHost: String;
+  Out APort: Word);
+Begin
+  if ProxyActive then
+    begin
+    AHost:=Proxy.Host;
+    APort:=Proxy.Port;
+    end
+  else
+    begin
+    AHost:=AURI.Host;
+    APort:=AURI.Port;
+    end;
+End;
+
+procedure TFPCustomHTTPClient.CheckConnectionCloseHeader;
 
 Var
-  URI : TURI;
-  P,CHost : String;
-  CPort : Word;
+  I : integer;
+  N,V : String;
+
+begin
+  V:=GetHeader('Connection');
+  If FKeepConnection Then
+    begin
+    I:=IndexOfHeader(FRequestHeaders,'Connection');
+    If i>-1 Then
+      begin
+      // It can be keep-alive, check value
+      FRequestHeaders.GetNameValue(I,N,V);
+      If CompareText(V,'close')=0  then
+        FRequestHeaders.Delete(i);
+      end
+    end
+  Else
+    AddHeader('Connection', 'close');
+end;
+
+Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
+
+Var
+  CHost: string;
+  CPort: Word;
+
+begin
+  ExtractHostPort(AURI, CHost, CPort);
+  ConnectToServer(CHost,CPort,AIsHttps);
+  Try
+    SendRequest(AMethod,AURI);
+    if not Terminated then
+      ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+  Finally
+    DisconnectFromServer;
+  End;
+end;
+
+Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
+  const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer;
+  AHeadersOnly, AIsHttps: Boolean);
+
+Var
+  T: Boolean;
+  CHost: string;
+  CPort: Word;
+
+begin
+  ExtractHostPort(AURI, CHost, CPort);
+  T := False;
+  Repeat
+    If Not IsConnected Then
+      ConnectToServer(CHost,CPort,AIsHttps);
+    Try
+      if not Terminated then
+        SendRequest(AMethod,AURI);
+      if not Terminated then
+        begin
+        T := ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
+        If Not T Then
+          ReconnectToServer(CHost,CPort,AIsHttps);
+        end;
+    Finally
+      // On terminate, we close the request
+      If HasConnectionClose or Terminated Then
+        DisconnectFromServer;
+    End;
+  Until T or Terminated;
+end;
+
+Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
+  Stream: TStream; Const AllowedResponseCodes: Array of Integer);
+
+Var
+  URI: TURI;
+  P: String;
+  IsHttps, HeadersOnly: Boolean;
 
 begin
   ResetResponse;
@@ -1059,23 +1249,12 @@ begin
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  if ProxyActive then
-    begin
-    CHost:=Proxy.Host;
-    CPort:=Proxy.Port;
-    end
+  IsHttps:=P='https';
+  HeadersOnly:=CompareText(AMethod,'HEAD')=0;
+  if FKeepConnection then
+    DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
   else
-    begin
-    CHost:=URI.Host;
-    CPort:=URI.Port;
-    end;
-  ConnectToServer(CHost,CPort,P='https');
-  try
-    SendRequest(AMethod,URI);
-    ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
-  finally
-    DisconnectFromServer;
-  end;
+    DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
 end;
 
 constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
@@ -1084,13 +1263,17 @@ begin
   // Infinite timeout on most platforms
   FIOTimeout:=0;
   FRequestHeaders:=TStringList.Create;
+  FRequestHeaders.NameValueSeparator:=':';
   FResponseHeaders:=TStringList.Create;
-  FHTTPVersion:='1.1';
+  FResponseHeaders.NameValueSeparator:=':';
+  HTTPVersion:='1.1';
   FMaxRedirects:=DefMaxRedirects;
 end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
+  if IsConnected then
+    DisconnectFromServer;
   FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
@@ -1144,6 +1327,11 @@ begin
     end;
 end;
 
+procedure TFPCustomHTTPClient.Terminate;
+begin
+  FTerminated:=True;
+end;
+
 procedure TFPCustomHTTPClient.ResetResponse;
 
 begin
@@ -1164,6 +1352,8 @@ Var
   RR : Boolean; // Repeat request ?
 
 begin
+  // Reset Terminated
+  FTerminated:=False;
   L:=AURL;
   RC:=0;
   RR:=False;
@@ -1174,7 +1364,7 @@ begin
     else
       begin
       DoMethod(M,L,Stream,AllowedResponseCodes);
-      if IsRedirect(FResponseStatusCode) then
+      if IsRedirect(FResponseStatusCode) and not Terminated then
         begin
         Inc(RC);
         if (RC>MaxRedirects) then
@@ -1200,8 +1390,8 @@ begin
         FOnPassword(Self,RR);
       end
     else
-      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
-  until not RR;
+      RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
+  until Terminated or not RR ;
 end;
 
 procedure TFPCustomHTTPClient.Get(const AURL: String; Stream: TStream);
@@ -1268,7 +1458,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,Stream);
     finally
       Free;
@@ -1282,7 +1472,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,LocalFileName);
     finally
       Free;
@@ -1296,7 +1486,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Get(AURL,Response);
     finally
       Free;
@@ -1364,7 +1554,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,Response);
     finally
       Free;
@@ -1378,7 +1568,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,Response);
     finally
       Free;
@@ -1392,7 +1582,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Post(URL,LocalFileName);
     finally
       Free;
@@ -1405,7 +1595,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Post(URL);
     finally
       Free;
@@ -1456,7 +1646,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,Response);
     finally
       Free;
@@ -1469,7 +1659,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,Response);
     finally
       Free;
@@ -1482,7 +1672,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Put(URL,LocalFileName);
     finally
       Free;
@@ -1494,7 +1684,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Put(URL);
     finally
       Free;
@@ -1546,7 +1736,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,Response);
     finally
       Free;
@@ -1559,7 +1749,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,Response);
     finally
       Free;
@@ -1572,7 +1762,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Delete(URL,LocalFileName);
     finally
       Free;
@@ -1584,7 +1774,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Delete(URL);
     finally
       Free;
@@ -1636,7 +1826,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,Response);
     finally
       Free;
@@ -1649,7 +1839,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,Response);
     finally
       Free;
@@ -1662,7 +1852,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Options(URL,LocalFileName);
     finally
       Free;
@@ -1674,7 +1864,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=Options(URL);
     finally
       Free;
@@ -1685,7 +1875,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       HTTPMethod('HEAD', AURL, Nil, [200]);
       Headers.Assign(ResponseHeaders);
     Finally
@@ -1770,7 +1960,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1784,7 +1974,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1798,7 +1988,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1811,7 +2001,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FormPost(URL,FormData,Response);
     Finally
       Free;
@@ -1824,7 +2014,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1837,7 +2027,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       Result:=FormPost(URL,FormData);
     Finally
       Free;
@@ -1916,7 +2106,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
 begin
   With Self.Create(nil) do
     try
-      RequestHeaders.Add('Connection: Close');
+      KeepConnection := False;
       FileFormPost(AURL,AFieldName,AFileName,Response);
     Finally
       Free;
diff --git a/packages/fcl-web/src/base/fphttpserver.pp b/packages/fcl-web/src/base/fphttpserver.pp
index 9cc9cf7999..48be9cf477 100644
--- a/packages/fcl-web/src/base/fphttpserver.pp
+++ b/packages/fcl-web/src/base/fphttpserver.pp
@@ -658,7 +658,7 @@ end;
 
 procedure TFPCustomHttpServer.StopServerSocket;
 begin
-  FServer.StopAccepting(True);
+  FServer.StopAccepting(False);
 end;
 
 procedure TFPCustomHttpServer.SetActive(const AValue: Boolean);
diff --git a/packages/fcl-web/src/base/fphttpwebclient.pp b/packages/fcl-web/src/base/fphttpwebclient.pp
index f91f38e935..50af3c0842 100644
--- a/packages/fcl-web/src/base/fphttpwebclient.pp
+++ b/packages/fcl-web/src/base/fphttpwebclient.pp
@@ -113,9 +113,16 @@ end;
 { TFPHTTPWebClient }
 
 Function TFPHTTPWebClient.DoCreateRequest: TWebClientRequest;
+
+Var
+  C : TFPHTTPClient;
+
 begin
-  Result:=TFPHTTPRequest.Create(TFPHTTPClient.Create(Self));
-  Result.Headers.NameValueSeparator:=':';
+  C:=TFPHTTPClient.Create(Self);
+  C.RequestHeaders.NameValueSeparator:=':';
+  C.ResponseHeaders.NameValueSeparator:=':';
+//  C.HTTPversion:='1.0';
+  Result:=TFPHTTPRequest.Create(C);
 end;
 
 Function TFPHTTPWebClient.DoHTTPMethod(Const AMethod, AURL: String;
@@ -124,7 +131,7 @@ Function TFPHTTPWebClient.DoHTTPMethod(Const AMethod, AURL: String;
 Var
   U,S : String;
   h : TFPHTTPClient;
-  Res : Boolean;
+
 
 begin
   U:=AURL;
@@ -145,7 +152,7 @@ begin
       H.RequestBody:=ARequest.Content;
       H.RequestBody.Position:=0;
       end;
-    H.HTTPMethod(AMethod,U,Result.Content,[]); // Will rais an exception
+    H.HTTPMethod(AMethod,U,Result.Content,[]); // Will raise an exception
   except
     FreeAndNil(Result);
     Raise;
diff --git a/packages/fcl-web/src/base/fpoauth2.pp b/packages/fcl-web/src/base/fpoauth2.pp
index e9cbf3d8e3..6358a4a67c 100644
--- a/packages/fcl-web/src/base/fpoauth2.pp
+++ b/packages/fcl-web/src/base/fpoauth2.pp
@@ -162,31 +162,35 @@ Type
 
   TOAuth2Handler = Class(TAbstractRequestSigner)
   private
-    FAutoStore: Boolean;
+    FAutoConfig: Boolean;
+    FAutoSession: Boolean;
+    FConfigLoaded: Boolean;
+    FSessionLoaded: Boolean;
     FClaimsClass: TClaimsClass;
     FConfig: TOAuth2Config;
-    FConfigLoaded: Boolean;
+    FSession: TOAuth2Session;
     FIDToken: TJWTIDToken;
+    FWebClient: TAbstractWebClient;
+    FStore : TAbstracTOAuth2ConfigStore;
     FOnAuthSessionChange: TOnAuthSessionChangeHandler;
     FOnIDTokenChange: TOnIDTokenChangeHandler;
-    FSession: TOAuth2Session;
+    FOnSignRequest: TOnAuthConfigChangeHandler;
     FOnAuthConfigChange: TOnAuthConfigChangeHandler;
-    FOnSignRequest: TOnAuthSessionChangeHandler;
     FOnUserConsent: TUserConsentHandler;
-    FSessionLoaded: Boolean;
-    FWebClient: TAbstractWebClient;
-    FStore : TAbstracTOAuth2ConfigStore;
+    Function GetAutoStore : Boolean;
+    Procedure SetAutoStore(AValue : Boolean); 
     procedure SetConfig(AValue: TOAuth2Config);
     procedure SetSession(AValue: TOAuth2Session);
     procedure SetStore(AValue: TAbstracTOAuth2ConfigStore);
   Protected
+    function CheckHostedDomain(URL: String): String; virtual;
     Function RefreshToken: Boolean; virtual;
     Function CreateOauth2Config : TOAuth2Config; virtual;
     Function CreateOauth2Session : TOAuth2Session; virtual;
     Function CreateIDToken : TJWTIDToken; virtual;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     Procedure DoAuthConfigChange; virtual;
-    Procedure DoAuthSessionChange; virtual;
+    Procedure DoAuthSessionChange(Const AUser : String = ''); virtual;
     Procedure DoSignRequest(ARequest: TWebClientRequest); override;
     Property ConfigLoaded : Boolean Read FConfigLoaded;
     Property SessionLoaded : Boolean Read FSessionLoaded;
@@ -199,6 +203,8 @@ Type
     // Variable name for AuthScope in authentication URL.
     // Default = scope. Descendents can override this to provide correct behaviour.
     Class Function AuthScopeVariableName : String; virtual;
+    // Default for hosted domain, if any
+    Class function DefaultHostedDomain: String; virtual;
     // Check if config is authenticated.
     Function IsAuthenticated : Boolean; virtual;
     // Generate an authentication URL
@@ -207,11 +213,11 @@ Type
     // Do whatever is necessary to mark the request as 'authenticated'.
     Function Authenticate: TAuthenticateAction; virtual;
     // Load config from store
-    procedure LoadConfig;
+    procedure LoadConfig(Force : Boolean = false);
     // Save config to store
     procedure SaveConfig;
-    // Load Session from store.If AUser is empty, then ID Token.GetUniqueUser is used.
-    procedure LoadSession(Const AUser : String = '');
+    // Load Session from store.If AUser is empty, then ID Token.GetUniqueUser is used. 
+    procedure LoadSession(Const AUser : String = ''; AForce : Boolean = False);
     // Save session in store. If AUser is empty, then ID Token.GetUniqueUser is used. Will call OnAuthSessionChange
     procedure SaveSession(Const AUser : String = '');
     // Refresh ID token from Session.IDToken. Called after token is refreshed or session is loaded.
@@ -237,11 +243,15 @@ Type
     // Called when the IDToken information changes
     Property OnIDTokenChange : TOnIDTokenChangeHandler Read FOnIDTokenChange Write FOnIDTokenChange;
     // Called when a request is signed
-    Property OnSignRequest : TOnAuthSessionChangeHandler Read FOnSignRequest Write FOnSignRequest;
+    Property OnSignRequest : TOnAuthConfigChangeHandler Read FOnSignRequest Write FOnSignRequest;
     // User to load/store parts of the config store.
     Property Store : TAbstracTOAuth2ConfigStore Read FStore Write SetStore;
-    // Call storing automatically when needed.
-    Property AutoStore : Boolean Read FAutoStore Write FAutoStore;
+    // Call storing session/config automatically when needed.
+    Property AutoStore : Boolean Read GetAutoStore Write SetAutoStore;
+    // AutoSession = True makes sure the load/save of the session as needed.
+    Property AutoSession : Boolean Read FAutoSession Write FAutoSession default True;
+    // AutoConfig = True will enable the load of config as needed.
+    Property AutoConfig : Boolean Read FAutoConfig Write FAutoConfig default True;
   end;
   TOAuth2HandlerClass = Class of TOAuth2Handler;
 
@@ -347,13 +357,33 @@ begin
     end;
 end;
 
+function TOAuth2Handler.CheckHostedDomain(URL : String): String;
+
+Var
+  HD : String;
+
+begin
+  HD:=Config.HostedDomain;
+  if (HD='') then
+    Result:=DefaultHostedDomain;
+  Result:=StringReplace(URL,'%HostedDomain%',Config.HostedDomain,[rfIgnoreCase]);
+end;
+
+Class function TOAuth2Handler.DefaultHostedDomain : String;
+
+begin
+  Result:='';
+end;
+
 function TOAuth2Handler.AuthenticateURL: String;
+
 begin
   Result:=Config.AuthURL
         + '?'+ AuthScopeVariableName+'='+HTTPEncode(Config.AuthScope)
         +'&redirect_uri='+HTTPEncode(Config.RedirectUri)
         +'&client_id='+HTTPEncode(Config.ClientID)
         +'&response_type=code'; // Request refresh token.
+  Result:=CheckHostedDomain(Result);
   if Assigned(Session) then
     begin
     if (Session.LoginHint<>'') then
@@ -376,14 +406,15 @@ begin
   FSession.Assign(AValue);
 end;
 
-procedure TOAuth2Handler.LoadConfig;
+procedure TOAuth2Handler.LoadConfig(Force : Boolean = False);
 
 begin
-  if Assigned(Store) and not ConfigLoaded then
-    begin
-    Store.LoadConfig(Config);
-    FConfigLoaded:=True;
-    end;
+  if Assigned(Store) then
+    if Force or not ConfigLoaded then
+      begin
+      Store.LoadConfig(Config);
+      FConfigLoaded:=True;
+      end;
 end;
 
 procedure TOAuth2Handler.SaveConfig;
@@ -395,22 +426,23 @@ begin
     end;
 end;
 
-procedure TOAuth2Handler.LoadSession(const AUser: String);
+procedure TOAuth2Handler.LoadSession(const AUser: String; AForce : Boolean = False);
 
 Var
   U : String;
 
 begin
   if Assigned(Store) then
-    begin
-    U:=AUser;
-    If (U='') and Assigned(FIDToken) then
-      U:=FIDToken.GetUniqueUserID;
-    Store.LoadSession(Session,AUser);
-    FSessionLoaded:=True;
-    if (Session.IDToken<>'') then
-      RefreshIDToken;
-    end;
+    if AForce or Not SessionLoaded then
+      begin
+      U:=AUser;
+      If (U='') and Assigned(FIDToken) then
+        U:=FIDToken.GetUniqueUserID;
+      Store.LoadSession(Session,AUser);
+      FSessionLoaded:=True;
+      if (Session.IDToken<>'') then
+        RefreshIDToken;
+      end;
 end;
 
 procedure TOAuth2Handler.SaveSession(const AUser: String);
@@ -428,6 +460,19 @@ begin
     end;
 end;
 
+Function TOAuth2Handler.GetAutoStore : Boolean;
+
+begin
+  Result:=AutoSession and AutoConfig;
+end;
+
+Procedure TOAuth2Handler.SetAutoStore(AValue : Boolean); 
+
+begin
+  AutoSession:=True;
+  AutoConfig:=True;
+end;
+
 procedure TOAuth2Handler.RefreshIDToken;
 begin
   FreeAndNil(FIDToken);
@@ -449,14 +494,15 @@ Var
   Resp: TWebClientResponse;
 
 begin
-  LoadConfig;
+  if AutoConfig and not ConfigLoaded then
+    LoadConfig;
   Req:=Nil;
   Resp:=Nil;
   D:=Nil;
   try
     Req:=WebClient.CreateRequest;
     Req.Headers.Values['Content-Type']:='application/x-www-form-urlencoded';
-    url:=Config.TOKENURL;
+    url:=CheckHostedDomain(Config.TOKENURL);
     Body:='client_id='+HTTPEncode(Config.ClientID)+
           '&client_secret='+ HTTPEncode(Config.ClientSecret);
     if (Session.RefreshToken<>'') then
@@ -475,10 +521,11 @@ begin
     if Result then
       begin
       Session.LoadTokensFromJSONResponse(Resp.GetContentAsString);
-      If (Session.IDToken)<>'' then
+      If (Session.IDToken<>'') then
         begin
         RefreshIDToken;
-        DoAuthSessionChange;
+        if AutoSession then
+          DoAuthSessionChange(IDToken.GetUniqueUserName);
         end;
       end
     else
@@ -518,9 +565,10 @@ end;
 function TOAuth2Handler.IsAuthenticated: Boolean;
 
 begin
-  LoadConfig;
+  If AutoConfig then
+    LoadConfig;
   // See if we need to load the session
-  if (Session.RefreshToken='') then
+  if (Session.RefreshToken='') and AutoSession then
     LoadSession;
   Result:=(Session.AccessToken<>'');
   If Result then
@@ -553,11 +601,12 @@ begin
   SaveConfig;
 end;
 
-procedure TOAuth2Handler.DoAuthSessionChange;
+procedure TOAuth2Handler.DoAuthSessionChange(Const AUser : String = ''); 
+    
 begin
   If Assigned(FOnAuthSessionChange) then
     FOnAuthSessionChange(Self,Session);
-  SaveSession;
+  SaveSession(AUser);
 end;
 
 procedure TOAuth2Handler.DoSignRequest(ARequest: TWebClientRequest);
@@ -580,6 +629,8 @@ begin
   inherited Create(AOwner);
   FConfig:=CreateOauth2Config;
   FSession:=CreateOauth2Session;
+  FAutoSession:=True;
+  FAutoConfig:=True;
 end;
 
 destructor TOAuth2Handler.Destroy;
diff --git a/packages/fcl-web/src/base/fpoauth2ini.pp b/packages/fcl-web/src/base/fpoauth2ini.pp
index fc303829f0..cc35e903ca 100644
--- a/packages/fcl-web/src/base/fpoauth2ini.pp
+++ b/packages/fcl-web/src/base/fpoauth2ini.pp
@@ -1,16 +1,3 @@
-{ **********************************************************************
-  This file is part of the Free Component Library (FCL)
-  Copyright (c) 2015 by the Free Pascal development team
-        
-  OAuth2 store using an .ini file.
-            
-  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 fpoauth2ini;
 
 {$mode objfpc}{$H+}
@@ -34,13 +21,13 @@ Type
     FUserSection: String;
     procedure EnsureFileName;
     Procedure EnsureConfigSections;
+    procedure SetSessionSectionUser(AUser: String);
   Protected
     Function DetectSessionFileName : String;
     Function EnsureUserSession(ASession: TOAuth2Session): Boolean; virtual;
   Public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
-
     Procedure SaveConfigToIni(AIni : TCustomIniFile;AConfig : TOAuth2Config); virtual;
     Procedure LoadConfigFromIni(AIni : TCustomIniFile;AConfig : TOAuth2Config); virtual;
     Procedure SaveSessionToIni(AIni : TCustomIniFile;ASession : TOAuth2Session); virtual;
@@ -269,6 +256,17 @@ begin
   inherited Destroy;
 end;
 
+procedure TFPOAuth2IniStore.SetSessionSectionUser(AUser : String);
+
+begin
+  If (UserSessionSection='') then
+    begin
+    if (AUser='') then
+       AUser:='anonymous';
+    UserSessionSection:='session_'+AUser;
+    end;
+end;
+
 procedure TFPOAuth2IniStore.LoadSession(ASession: TOAuth2Session;
   const AUser: String);
 
@@ -276,8 +274,8 @@ Var
   Ini : TMemIniFile;
 
 begin
-  Touch('loadsession');
   EnsureFileName;
+  SetSessionSectionUser(AUser);
   If not EnsureUserSession(ASession) then
     Exit;
   Ini:=TMemIniFile.Create(SessionFileName);
@@ -296,6 +294,7 @@ Var
 
 begin
   EnsureFileName;
+  SetSessionSectionUser(AUser);
   If not EnsureUserSession(ASession) then
     Exit;
   Ini:=TMemIniFile.Create(SessionFileName);
diff --git a/packages/fcl-web/src/base/fpweb.pp b/packages/fcl-web/src/base/fpweb.pp
index bbf995f40b..254d9ab0cf 100644
--- a/packages/fcl-web/src/base/fpweb.pp
+++ b/packages/fcl-web/src/base/fpweb.pp
@@ -50,13 +50,20 @@ Type
 
   TFPWebActions = Class(TCustomWebActions)
   private
-    FCurrentAction : TCustomWebAction;
+    FCurrentAction : TFPWebAction;
+    function GetFPWebActions(Index : Integer): TFPWebAction;
+    procedure SetFPWebActions(Index : Integer; const AValue: TFPWebAction);
   protected
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean); virtual;
     Procedure GetContent(ARequest : TRequest; Content : TStream; Var Handled : Boolean); virtual;
+    Function  GetRequestAction(ARequest: TRequest) : TFPWebAction;
   Public
+    Function Add : TFPWebAction;
+    Function ActionByName(const AName : String) : TFPWebAction;
+    Function FindAction(const AName : String): TFPWebAction;
+    Property FPWebActions[Index : Integer] : TFPWebAction Read GetFPWebActions Write SetFPWebActions; Default;
     Property ActionVar;
-    Property CurrentAction: TCustomWebAction read FCurrentAction;
+    Property CurrentAction: TFPWebAction read FCurrentAction;
   end;
 
   { TTemplateVar }
@@ -553,10 +560,40 @@ end;
 
 { TFPWebActions }
 
+Function TFPWebActions.GetRequestAction(ARequest: TRequest) : TFPWebAction;
+begin
+  Result := inherited GetRequestAction(ARequest) as TFPWebAction;
+end;
+
+Function TFPWebActions.Add : TFPWebAction;
+begin
+  Result := inherited Add as TFPWebAction;
+end;
+
+Function TFPWebActions.ActionByName(const AName : String) : TFPWebAction;
+begin
+  Result := inherited ActionByName(AName) as TFPWebAction;
+end;
+
+Function TFPWebActions.FindAction(const AName : String): TFPWebAction;
+begin
+  Result := inherited FindAction(AName) as TFPWebAction;
+end;
+
+function TFPWebActions.GetFPWebActions(Index : Integer): TFPWebAction;
+begin
+  Result := Actions[Index] as TFPWebAction;
+end;
+
+procedure TFPWebActions.SetFPWebActions(Index : Integer; const AValue: TFPWebAction);
+begin
+  Actions[Index] := AValue;
+end;
+
 procedure TFPWebActions.HandleRequest(ARequest: TRequest; AResponse: TResponse; Var Handled : Boolean);
 
 Var
-  A : TCustomWebAction;
+  A : TFPWebAction;
 
 begin
 {$ifdef cgidebug}SendMethodEnter('FPWebActions.handlerequest');{$endif cgidebug}
diff --git a/packages/fcl-web/src/base/fpwebclient.pp b/packages/fcl-web/src/base/fpwebclient.pp
index 6c7cf3497d..4946fae2d4 100644
--- a/packages/fcl-web/src/base/fpwebclient.pp
+++ b/packages/fcl-web/src/base/fpwebclient.pp
@@ -21,13 +21,21 @@ uses
   Classes, SysUtils;
 
 Type
+
   { TRequestResponse }
+  
+  // Some IIS servers react badly to svAny. So we set up a system where you can set a min/max SSL version.
+  
+  TSSLVersion = (svNone,svAny,svSSLv2,svSSLv3,svTLSv1,svTLSv11,svTLSv12,svTLSv13);
+  TSSLVersions = Set of TSSLVersion;
+  TSSLVersionArray = Array of TSSLVersion;
 
   TRequestResponse = Class(TObject)
   private
     FHeaders : TStrings;
     FStream : TStream;
     FOwnsStream : Boolean;
+    FSSLVersion : TSSLVersion;
   Protected
     function GetHeaders: TStrings;virtual;
     function GetStream: TStream;virtual;
@@ -39,6 +47,8 @@ Type
     Property Headers : TStrings Read GetHeaders;
     // Request content or response content
     Property Content: TStream Read GetStream;
+    // SSLVersion : Which version to use
+    Property SSLVersion : TSSLVersion Read FSSLVersion Write FSSLVersion;
   end;
 
   { TWebClientRequest }
@@ -95,9 +105,6 @@ Type
 
   { TAbstractWebClient }
 
-  TSSLVersion = (svAny,svSSLv2,svSSLv3,svTLSv1,svTLSv11,svTLSv12,svTLSv13);
-  TSSLVersions = Set of TSSLVersion;
-  TSSLVersionArray = Array of TSSLVersion;
 
   TAbstractWebClient = Class(TComponent)
   private
@@ -105,14 +112,19 @@ Type
     FSigner: TAbstractRequestSigner;
     FLogFile : String;
     FLogStream : TStream;
-    FTrySSLVersion: TSSLVersion;
+    FMinSSLVersion: TSSLVersion;
+    FMaxSSLVersion: TSSLVersion;
     Procedure LogRequest(AMethod, AURL: String; ARequest: TWebClientRequest);
     Procedure LogResponse(AResponse: TWebClientResponse);
     procedure SetLogFile(AValue: String);
+    procedure SetSSLVersion(AValue : TSSLVersion);
+    Function GetSSLVersion : TSSLVersion;
   protected
+    // Determine min/max version to try
+    procedure GetVersionLimits(out PMin, PMax: TSSLVersion);
     // Write a string to the log file
     procedure StringToStream(str: string);
-    // Must execute the requested method using request/response. Must take ResponseCOntent stream into account
+    // Must execute the requested method using request/response. Must take ResponseContent stream into account
     Function DoHTTPMethod(Const AMethod,AURL : String; ARequest : TWebClientRequest) : TWebClientResponse; virtual; abstract;
     // Must create a request.
     Function DoCreateRequest : TWebClientRequest; virtual; abstract;
@@ -130,7 +142,12 @@ Type
     Property RequestSigner : TAbstractRequestSigner Read FSigner Write FSigner;
     Property ResponseExaminer : TAbstractResponseExaminer Read FExaminer Write FExaminer;
     Property LogFile : String Read FLogFile Write SetLogFile;
-    property SSLVersion : TSSLVersion Read FTrySSLVersion Write FTrySSLVersion;
+    // This will set MinSSLversion and MaxSSLversion
+    property SSLVersion : TSSLVersion Read GetSSLVersion Write SetSSLVersion;
+    // Minimum Version to try. If spNone is set, all should be tried in succession from high to MinSSLVersion.
+    Property MinSSLVersion : TSSLVersion Read FMinSSLVersion Write FMinSSLVersion default svAny;
+    // Maximum Version to try. If spNone is set, all should be tried in succession from MaxSSLVersion to low.
+    Property MaxSSLVersion : TSSLVersion Read FMaxSSLVersion Write FMaxSSLVersion default svAny;
   end;
   TAbstractWebClientClass = Class of TAbstractWebClient;
 
@@ -211,6 +228,18 @@ end;
 
 { TAbstractWebClient }
 
+procedure TAbstractWebClient.SetSSLVersion(AValue : TSSLVersion);
+
+begin
+  MinSSLVersion:=AValue;
+  MaxSSLVersion:=AValue;
+end;
+
+Function TAbstractWebClient.GetSSLVersion : TSSLVersion;
+
+begin
+  Result:=MinSSLVersion;
+end;
 
 procedure TAbstractWebClient.SetLogFile(AValue: String);
 begin
@@ -220,7 +249,10 @@ begin
   FLogFile:=AValue;
   if (FLogFile<>'') then
     if FileExists(FLogFile) then
-      FLogStream:=TFileStream.Create(FLogFile,fmOpenWrite or fmShareDenyWrite)
+      begin
+      FLogStream:=TFileStream.Create(FLogFile,fmOpenWrite or fmShareDenyWrite);
+      FLogStream.Seek(0,soFromEnd);
+      end
     else
       FLogStream:=TFileStream.Create(FLogFile,fmCreate or fmShareDenyWrite);
 end;
@@ -277,19 +309,61 @@ begin
   StringToStream('');
 end;
 
+procedure TAbstractWebClient.GetVersionLimits(out PMin, PMax: TSSLVersion);
+
+begin
+  if MinSSLVersion=svNone then
+    PMin:=Succ(Low(TSSLVersion))
+  else
+    PMin:=MinSSLVersion;
+  if MaxSSLVersion=svNone then
+    PMax:=High(TSSLVersion)
+  else
+    PMax:=MaxSSLVersion;
+  if PMax<PMin then
+    PMax:=PMin;
+end;
+
 function TAbstractWebClient.ExecuteRequest(const AMethod, AURL: String;
   ARequest: TWebClientRequest): TWebClientResponse;
+  
+Var
+  P,PMax,PMin : TSSLVersion;
+  S: String;
+
 begin
   if Assigned(FLogStream) then
     LogRequest(AMethod,AURL,ARequest);
   Result:=DoHTTPMethod(AMethod,AURL,ARequest);
+  GetVersionLimits(PMin,PMax);
+  if PMin<>PMax then
+    StringToStream('Trying multiple protocols.');
+  P:=PMax;
+  While (Not Assigned(Result)) and (P>=PMin) do
+    begin
+    Str(P,S);
+    StringToStream('Trying protocol: '+S);
+    Result:=Nil;
+    ARequest.SSLVersion:=P;
+    if Assigned(FLogStream) then
+      LogRequest(AMethod,AURL,ARequest);
+    try
+      Result:=DoHTTPMethod(AMethod,AURL,ARequest);
+    except
+      if (P=PMin) then
+        Raise;
+    end;
+    P:=Pred(P);
+    end;
   if Assigned(Result) then
     begin
     if Assigned(FLogStream) then
       LogResponse(Result);
     If Assigned(FExaminer) then
       FExaminer.ExamineResponse(Result);
-    end;
+    end
+  else
+    StringToStream('Request generated no response');
 end;
 
 function TAbstractWebClient.ExecuteSignedRequest(const AMethod, AURL: String;
diff --git a/packages/fcl-web/src/base/httpdefs.pp b/packages/fcl-web/src/base/httpdefs.pp
index 0fc92ff5af..59c634c5bd 100644
--- a/packages/fcl-web/src/base/httpdefs.pp
+++ b/packages/fcl-web/src/base/httpdefs.pp
@@ -287,7 +287,6 @@ type
     FContentFields: TStrings;
     FCookieFields: TStrings;
     FHTTPVersion: String;
-    FHTTPXRequestedWith: String;
     FFields : THeadersArray;
     FVariables : THTTPVariables;
     FQueryFields: TStrings;
@@ -299,7 +298,7 @@ type
     Function GetFieldCount : Integer;
     Function GetContentLength : Integer;
     Procedure SetContentLength(Value : Integer);
-    Function GetFieldOrigin(AIndex : Integer; Out H : THeader; V : THTTPVAriableType) : Boolean;
+    Function GetFieldOrigin(AIndex : Integer; Out H : THeader; Out V : THTTPVAriableType) : Boolean;
     Function GetServerPort : Word;
     Procedure SetServerPort(AValue : Word);
     Function GetSetFieldValue(Index : Integer) : String; virtual;
@@ -383,7 +382,7 @@ type
     Property ProtocolVersion : String Index ord(hvHTTPVErsion) Read GetHTTPVariable Write SetHTTPVariable;
     // Specials, mostly from CGI protocol/Apache.
     Property PathInfo : String index Ord(hvPathInfo) read GetHTTPVariable Write SetHTTPVariable;
-    Property PathTranslated : String index Ord(hvPathInfo) read GetHTTPVariable Write SetHTTPVariable;
+    Property PathTranslated : String index Ord(hvPathTranslated) read GetHTTPVariable Write SetHTTPVariable;
     Property RemoteAddress : String Index Ord(hvRemoteAddress) read GetHTTPVariable Write SetHTTPVariable;
     Property RemoteAddr : String Index Ord(hvRemoteAddress) read GetHTTPVariable Write SetHTTPVariable; // Alias, Delphi-compat
     Property RemoteHost : String Index Ord(hvRemoteHost) read  GetHTTPVariable Write SetHTTPVariable;
@@ -412,11 +411,12 @@ type
     FFiles : TUploadedFiles;
     FReturnedPathInfo : String;
     FLocalPathPrefix : string;
-    FServerPort : String;
     FContentRead : Boolean;
-    FContent : String;
+    FRouteParams : TStrings;
     function GetLocalPathPrefix: string;
     function GetFirstHeaderLine: String;
+    function GetRP(AParam : String): String;
+    procedure SetRP(AParam : String; AValue: String);
   Protected
     Function AllowReadContent : Boolean; virtual;
     Function CreateUploadedFiles : TUploadedFiles; virtual;
@@ -441,6 +441,7 @@ type
     constructor Create; override;
     destructor destroy; override;
     Function GetNextPathInfo : String;
+    Property RouteParams[AParam : String] : String Read GetRP Write SetRP;
     Property ReturnedPathInfo : String Read FReturnedPathInfo Write FReturnedPathInfo;
     Property LocalPathPrefix : string Read GetLocalPathPrefix;
     Property CommandLine : String Read FCommandLine;
@@ -602,9 +603,7 @@ Resourcestring
   SErrInternalUploadedFileError = 'Internal uploaded file configuration error';
   SErrNoSuchUploadedFile        = 'No such uploaded file : "%s"';
   SErrUnknownCookie             = 'Unknown cookie: "%s"';
-  SErrUnsupportedContentType    = 'Unsupported content type: "%s"';
   SErrNoRequestMethod           = 'No REQUEST_METHOD passed from server.';
-  SErrInvalidRequestMethod      = 'Invalid REQUEST_METHOD passed from server: %s.';
 
 const
    hexTable = '0123456789ABCDEF';
@@ -812,7 +811,7 @@ end;
 
 
 function THTTPHeader.GetFieldOrigin(AIndex: Integer; out H: THeader;
-  V: THTTPVAriableType): Boolean;
+  Out V: THTTPVAriableType): Boolean;
 
 
 begin
@@ -1237,10 +1236,9 @@ end;
 procedure TMimeItems.CreateUploadFiles(Files: TUploadedFiles; Vars : TStrings);
 
 Var
-  I,j : Integer;
+  I : Integer;
   P : TMimeItem;
-  LFN,Name,Value : String;
-  U : TUploadedFile;
+  Name,Value : String;
 
 begin
   For I:=Count-1 downto 0 do
@@ -1453,6 +1451,7 @@ end;
 
 destructor TRequest.destroy;
 begin
+  FreeAndNil(FRouteParams);
   FreeAndNil(FFiles);
   inherited destroy;
 end;
@@ -1534,6 +1533,22 @@ begin
     Result := Result + ' HTTP/' + HttpVersion;
 end;
 
+function TRequest.GetRP(AParam : String): String;
+begin
+  if Assigned(FRouteParams) then
+    Result:=FRouteParams.Values[AParam]
+  else
+    Result:='';
+end;
+
+procedure TRequest.SetRP(AParam : String; AValue: String);
+begin
+  if (AValue<>GetRP(AParam)) And ((AValue<>'')<>Assigned(FRouteParams)) then
+    FRouteParams:=TStringList.Create;
+  if (AValue<>'') and Assigned(FRouteParams) then
+    FRouteParams.Values[AParam]:=AValue;
+end;
+
 function TRequest.AllowReadContent: Boolean;
 begin
   Result:=True;
@@ -1777,10 +1792,8 @@ procedure TRequest.ProcessMultiPart(Stream: TStream; const Boundary: String;
 Var
   L : TMimeItems;
   B : String;
-  I,J : Integer;
-  S,FF,key, Value : String;
-  FI : TMimeItem;
-  F : TStream;
+  I : Integer;
+  S : String;
 
 begin
 {$ifdef CGIDEBUG} SendMethodEnter('ProcessMultiPart');{$endif CGIDEBUG}
@@ -1915,9 +1928,6 @@ end;
 
 procedure TUploadedFile.DeleteTempUploadedFile;
 
-Var
-  s: String;
-
 begin
   if (FStream is TFileStream) then
     FreeStream;
diff --git a/packages/fcl-web/src/base/httproute.pp b/packages/fcl-web/src/base/httproute.pp
new file mode 100644
index 0000000000..15bd8485e1
--- /dev/null
+++ b/packages/fcl-web/src/base/httproute.pp
@@ -0,0 +1,790 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2017 by the Free Pascal development team
+
+    HTTPRoute: HTTP request router
+
+    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.
+}
+
+{
+  Note:
+  The MatchPattern routine was taken from Brook Framework's router unit, by Silvio Clecio.
+}
+
+{$mode objfpc}
+{$H+}
+
+unit httproute;
+
+interface
+
+uses
+  Classes, SysUtils, httpdefs;
+
+Type
+  EHTTPRoute = Class(EHTTP);
+
+  // Forward definitions;
+
+  THTTPRouter = Class;
+  THTTPRouterClass = Class of THTTPRouter;
+  // Some common HTTP methods.
+
+  TRouteMethod = (rmUnknown,rmAll,rmGet,rmPost,rmPut,rmDelete,rmOptions,rmHead, rmTrace);
+
+  { THTTPRoute }
+
+  THTTPRoute = Class(TCollectionItem)
+  private
+    FDefault: Boolean;
+    FMethod: TRouteMethod;
+    FURLPattern: String;
+    procedure SetURLPattern(AValue: String);
+  Protected
+    Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
+  Public
+    Destructor Destroy; override;
+    Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse);
+    Function Matches(Const APattern : String; AMethod : TRouteMethod) : Boolean;
+    Function MatchPattern(Const Path : String; L : TStrings) : Boolean;
+    Function MatchMethod(Const AMethod : TRouteMethod) : Boolean;
+  Published
+    Property Default : Boolean Read FDefault Write FDefault;
+    Property URLPattern : String Read FURLPattern Write SetURLPattern;
+    Property Method : TRouteMethod Read FMethod Write FMethod;
+  end;
+  THTTPRouteClass = Class of THTTPRoute;
+
+  { THTTPRouteList }
+
+  THTTPRouteList = Class (TCollection)
+  private
+    function GetR(AIndex : Integer): THTTPRoute;
+    procedure SetR(AIndex : Integer; AValue: THTTPRoute);
+  Public
+    Property Routes[AIndex : Integer] : THTTPRoute Read GetR Write SetR; default;
+  end;
+
+  TRouteCallBack = Procedure (ARequest: TRequest; AResponse: TResponse);
+
+  { THTTPRouteCallback }
+
+  THTTPRouteCallback = Class(THTTPRoute)
+  private
+    FCallBack: TRouteCallBack;
+  Protected
+    Procedure DoHandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  Public
+    Property CallBack : TRouteCallBack Read FCallBack Write FCallback;
+  end;
+
+  TRouteCallBackEx = Procedure (AData : Pointer; ARequest: TRequest; AResponse: TResponse);
+
+  { THTTPRouteCallbackex }
+
+  THTTPRouteCallbackEx = Class(THTTPRoute)
+  private
+    FCallBack: TRouteCallBackex;
+    FData: Pointer;
+  Protected
+    Procedure DoHandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  Public
+    Property CallBack : TRouteCallBackex Read FCallBack Write FCallback;
+    Property Data : Pointer Read FData Write FData;
+  end;
+
+  TRouteEvent = Procedure (ARequest: TRequest; AResponse: TResponse) of object;
+
+  { THTTPRouteEvent }
+
+  THTTPRouteEvent = Class(THTTPRoute)
+  private
+    FEvent: TRouteEvent;
+  Protected
+    Procedure DoHandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  Public
+    Property Event : TRouteEvent Read FEvent Write FEvent;
+  end;
+
+{$INTERFACES CORBA}
+  IRouteInterface = Interface ['{10115353-10BA-4B00-FDA5-80B69AC4CAD0}']
+    Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse);
+  end;
+
+  { THTTPRouteInterface }
+
+  THTTPRouteInterface = Class(THTTPRoute)
+  private
+    FIntf: IRouteInterface;
+  Protected
+    Procedure DoHandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  Public
+    Property Intf : IRouteInterface Read FIntf Write FIntf;
+  end;
+
+  TRouteObject = Class(TObject,IRouteInterface)
+  Public
+    Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); virtual; abstract;
+  end;
+  TRouteObjectClass = Class of TRouteObject;
+
+  { THTTPRouteObject }
+
+  THTTPRouteObject = Class(THTTPRoute)
+  private
+    FClass: TRouteObjectClass;
+  Protected
+    Procedure DoHandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  Public
+    Property ObjectCLass : TRouteObjectClass Read FClass Write FClass;
+  end;
+
+  THTTPRouteRequestEvent = Procedure (Sender : TObject; ARequest : TRequest; AResponse : TResponse) of object;
+
+  { THTTPRouter }
+
+  THTTPRouter = Class(TComponent)
+  private
+    FAfterRequest: THTTPRouteRequestEvent;
+    FBeforeRequest: THTTPRouteRequestEvent;
+    FRoutes : THTTPRouteList;
+    function GetR(AIndex : Integer): THTTPRoute;
+    Class Procedure DoneService;
+    Class
+      Var FService : THTTPRouter;
+          FServiceClass : THTTPRouterClass;
+    function GetRouteCount: Integer;
+  Protected
+    // Return an instance of given class with Pattern, Method, IsDefault filled in.
+    function CreateHTTPRoute(AClass: THTTPRouteClass; const APattern: String; AMethod: TRouteMethod; IsDefault: Boolean ): THTTPRoute; virtual;
+    // Override this if you want to use another collection class.
+    Function CreateRouteList : THTTPRouteList; virtual;
+    Procedure CheckDuplicate(APattern : String; AMethod : TRouteMethod; isDefault : Boolean);
+    // Actually route request. Override this for customized behaviour.
+    Procedure DoRouteRequest(ARequest : TRequest; AResponse : TResponse); virtual;
+    // Extract route from request. This is PathInfo by default (sanitized);
+    Function GetRequestPath(ARequest : TRequest) : String; virtual;
+  Public
+    Constructor Create(AOwner: TComponent); override;
+    Destructor Destroy; override;
+    // Delete given route by index.
+    Procedure DeleteRoute(AIndex : Integer);
+    // Delete given route by index.
+    Procedure DeleteRouteByID(AID : Integer);
+    // Delete given route by index. The route object will be freed.
+    Procedure DeleteRoute(ARoute : THTTPRoute);
+    // Sanitize route path. Strips of query parameters and makes sure it ends in /
+    class function SanitizeRoute(const Path: String): String;
+    // Global instance.
+    Class Function Service : THTTPRouter;
+    // Class for global instance when it is created;
+    Class Function ServiceClass : THTTPRouterClass;
+    // This will destroy the service
+    Class Procedure SetServiceClass(AClass : THTTPRouterClass);
+    // Convert string to HTTP Route method
+    Class Function StringToRouteMethod(Const S : String) : TRouteMethod;
+    // Register event based route
+    Function RegisterRoute(Const APattern : String; AEvent: TRouteEvent; IsDefault : Boolean = False) : THTTPRoute;overload;
+    Function RegisterRoute(Const APattern : String; AMethod : TRouteMethod; AEvent: TRouteEvent; IsDefault : Boolean = False): THTTPRoute;overload;
+    // Register interface based route. Programmer is responsible for the lifetime of the interface.
+    Function RegisterRoute(Const APattern : String; const AIntf: IRouteInterface; IsDefault : Boolean = False) : THTTPRoute; overload;
+    Function RegisterRoute(Const APattern : String; AMethod : TRouteMethod; const AIntf: IRouteInterface; IsDefault : Boolean = False): THTTPRoute; overload;
+    // Object class based route. The router is responsible for the lifetime of the object instance
+    Function RegisterRoute(Const APattern : String; const AObjectClass: TRouteObjectClass; IsDefault : Boolean = False) : THTTPRoute; overload;
+    Function RegisterRoute(Const APattern : String; AMethod : TRouteMethod; const AobjectClass: TRouteObjectClass; IsDefault : Boolean = False): THTTPRoute; overload;
+    // Register callback based route
+    Function RegisterRoute(Const APattern : String; AData : Pointer; ACallBack: TRouteCallBackex; IsDefault : Boolean = False) : THTTPRoute;overload;
+    Function RegisterRoute(Const APattern : String; AData : Pointer; AMethod : TRouteMethod; ACallBack: TRouteCallBackEx; IsDefault : Boolean = False): THTTPRoute;overload;
+    // Register callbackEx based route
+    Function RegisterRoute(Const APattern : String; ACallBack: TRouteCallBack; IsDefault : Boolean = False) : THTTPRoute;overload;
+    Function RegisterRoute(Const APattern : String; AMethod : TRouteMethod; ACallBack: TRouteCallBack; IsDefault : Boolean = False): THTTPRoute;overload;
+    // Find route. Matches Path on the various patterns. If a pattern is found, then the method is tested.
+    // Returns the route that matches the pattern and method.
+    function FindHTTPRoute(const Path: String; AMethod: TRouteMethod; Params: TStrings; out MethodMismatch: Boolean): THTTPRoute;
+    function GetHTTPRoute(const Path: String; AMethod: TRouteMethod; Params: TStrings): THTTPRoute;
+    // Do actual routing. Exceptions raised will not be caught. Request must be initialized
+    Procedure RouteRequest(ARequest : TRequest; AResponse : TResponse);
+    // Indexed access to the registered routes.
+    Property Routes [AIndex : Integer]  : THTTPRoute Read GetR; Default;
+    // Number of registered routes.
+    Property RouteCount : Integer Read GetRouteCount;
+    // Called before the request is routed.
+    Property BeforeRequest : THTTPRouteRequestEvent Read FBeforeRequest Write FBeforeRequest;
+    // Called after the request is routed, if no exception was raised during or before the request.
+    Property AfterRequest : THTTPRouteRequestEvent Read FAfterRequest Write FAfterRequest;
+  end;
+
+Function RouteMethodToString (R : TRouteMethod)  : String;
+// Shortcut for THTTPRouter.Service;
+Function HTTPRouter : THTTPRouter;
+
+Const
+  RouteMethodNames : Array[TRouteMethod] of String = ('','','GET','POST','PUT','DELETE','OPTIONS','HEAD','TRACE');
+
+implementation
+
+uses strutils, typinfo;
+
+Resourcestring
+  EDuplicateRoute = 'Duplicate route pattern: %s and method: %s';
+  EDuplicateDefaultRoute = 'Duplicate default route registered with pattern: %s and method: %s';
+
+function RouteMethodToString(R: TRouteMethod): String;
+
+begin
+  if R=rmUnknown then
+    Result:=''
+  else if R=rmAll then
+    Result:='*'
+  else
+    Result:=GetEnumName(TypeInfo(TRouteMethod),Ord(R));
+end;
+
+function HTTPRouter: THTTPRouter;
+begin
+  Result:=THTTPRouter.Service;
+end;
+
+{ THTTPRouteCallback }
+
+procedure THTTPRouteCallback.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  CallBack(ARequest, AResponse);
+end;
+
+{ THTTPRouteObject }
+
+procedure THTTPRouteObject.DoHandleRequest(ARequest: TRequest;
+  AResponse: TResponse);
+Var
+  O : TRouteObject;
+
+begin
+  O:=ObjectClass.Create;
+  try
+    O.HandleRequest(ARequest,AResponse);
+  finally
+    O.Free;
+  end;
+end;
+
+{ THTTPRouter }
+
+function THTTPRouter.GetR(AIndex : Integer): THTTPRoute;
+begin
+  Result:=FRoutes[AIndex]
+end;
+
+class procedure THTTPRouter.DoneService;
+begin
+  FreeAndNil(FService);
+end;
+
+function THTTPRouter.GetRouteCount: Integer;
+begin
+  Result:=FRoutes.Count;
+end;
+
+function THTTPRouter.CreateRouteList: THTTPRouteList;
+begin
+  Result:=THTTPRouteList.Create(THTTPRoute);
+end;
+
+procedure THTTPRouter.CheckDuplicate(APattern: String; AMethod: TRouteMethod;
+  isDefault: Boolean);
+Var
+  I,DI : Integer;
+  R : THTTPRoute;
+
+begin
+  DI:=-1;
+  For I:=0 to FRoutes.Count-1 do
+    begin
+    R:=FRoutes[I];
+    if R.Default then
+      DI:=I;
+    if R.Matches(APattern,AMethod) then
+      Raise EHTTPRoute.CreateFmt(EDuplicateRoute,[APattern,RouteMethodToString(AMethod)]);
+    end;
+  if isDefault and (DI<>-1) then
+    Raise EHTTPRoute.CreateFmt(EDuplicateDefaultRoute,[APattern,RouteMethodToString(AMethod)]);
+end;
+
+procedure THTTPRouter.DoRouteRequest(ARequest: TRequest; AResponse: TResponse);
+
+Var
+  APath : String;
+  AMethod : TRouteMethod;
+  R : THTTPRoute;
+  L : TStrings;
+  I : Integer;
+  N,V : string;
+
+begin
+  APath:=GetRequestPath(ARequest);
+  AMethod:=StringToRouteMethod(ARequest.Method);
+  L:=TStringList.Create;
+  try
+    R:=GetHTTPRoute(APath,AMethod,L);
+    For I:=0 to L.Count-1 do
+      begin
+      L.GetNameValue(I,N,V);
+      if (N<>'') then
+        ARequest.RouteParams[N]:=V;
+      end;
+    R.HandleRequest(ARequest,AResponse);
+  finally
+    L.Free;
+  end;
+end;
+
+function THTTPRouter.GetRequestPath(ARequest: TRequest): String;
+begin
+  Result:=SanitizeRoute(ARequest.PathInfo);
+end;
+
+constructor THTTPRouter.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  froutes:=CreateRouteList;
+end;
+
+destructor THTTPRouter.Destroy;
+begin
+  FreeAndNil(FRoutes);
+  inherited Destroy;
+end;
+
+procedure THTTPRouter.DeleteRoute(AIndex: Integer);
+begin
+  FRoutes.Delete(Aindex)
+end;
+
+procedure THTTPRouter.DeleteRouteByID(AID: Integer);
+begin
+  FRoutes.FindItemID(AID).Free;
+end;
+
+procedure THTTPRouter.DeleteRoute(ARoute: THTTPRoute);
+begin
+  ARoute.Free;
+end;
+
+class function THTTPRouter.Service: THTTPRouter;
+begin
+  if FService=Nil then
+    FService:=ServiceClass.Create(Nil);
+  Result:=FService;
+end;
+
+class function THTTPRouter.ServiceClass: THTTPRouterClass;
+begin
+  If FServiceClass=nil then
+    FServiceClass:=THTTPRouter;
+  Result:=FServiceClass;
+end;
+
+class procedure THTTPRouter.SetServiceClass(AClass: THTTPRouterClass);
+begin
+  if Assigned(FService) then
+    FreeAndNil(FService);
+  FServiceClass:=AClass;
+end;
+
+class function THTTPRouter.StringToRouteMethod(const S: String): TRouteMethod;
+
+
+Var
+  MN : String;
+
+begin
+  Result:=High(TRouteMethod);
+  MN:=Uppercase(S);
+  While (Result>=Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
+    Result:=Pred(Result);
+  if Result=rmAll then Result:=rmUnknown;
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String;AData : Pointer;
+  ACallBack: TRouteCallBackEx; IsDefault: Boolean): THTTPRoute;
+begin
+  Result:= RegisterRoute(APattern,AData,rmAll,ACallBack,IsDefault);
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String;AData : Pointer;
+  AMethod: TRouteMethod; ACallBack: TRouteCallBackEx; IsDefault: Boolean
+  ): THTTPRoute;
+
+begin
+  Result:=CreateHTTPRoute(THTTPRouteCallbackex,APattern,AMethod,IsDefault);
+  THTTPRouteCallbackex(Result).CallBack:=ACallBack;
+  THTTPRouteCallbackex(Result).Data:=AData;
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String; ACallBack: TRouteCallBack; IsDefault: Boolean
+  ): THTTPRoute;
+begin
+  Result:= RegisterRoute(APattern,rmAll,ACallBack,IsDefault);
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String; AMethod: TRouteMethod; ACallBack: TRouteCallBack;
+  IsDefault: Boolean): THTTPRoute;
+begin
+  Result:=CreateHTTPRoute(THTTPRouteCallback,APattern,AMethod,IsDefault);
+  THTTPRouteCallback(Result).CallBack:=ACallBack;
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String; AEvent: TRouteEvent;
+  IsDefault: Boolean): THTTPRoute;
+begin
+  Result:= RegisterRoute(APattern,rmAll,AEvent,IsDefault);
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String;
+  AMethod: TRouteMethod; AEvent: TRouteEvent; IsDefault: Boolean): THTTPRoute;
+
+begin
+  Result:=CreateHTTPRoute(THTTPRouteEvent,APattern,AMethod,IsDefault);
+  THTTPRouteEvent(Result).Event:=AEvent;
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String;
+  const AIntf: IRouteInterface; IsDefault: Boolean): THTTPRoute;
+begin
+  Result:=RegisterRoute(APattern,rmAll,AIntf,IsDefault);
+end;
+
+function THTTPRouter.CreateHTTPRoute(AClass : THTTPRouteClass; const APattern: String;AMethod: TRouteMethod; IsDefault: Boolean) : THTTPRoute;
+
+begin
+  CheckDuplicate(APattern,AMethod,isDefault);
+  Result:=AClass.Create(FRoutes);
+  With Result do
+    begin
+    URLPattern:=APattern;
+    Default:=IsDefault;
+    Method:=AMethod;
+    end;
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String;AMethod: TRouteMethod; const AIntf: IRouteInterface; IsDefault: Boolean ): THTTPRoute;
+
+begin
+  Result:=CreateHTTPRoute(THTTPRouteInterface,APattern,AMethod,IsDefault);
+  THTTPRouteInterface(Result).Intf:=AIntf;
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String; const AObjectClass: TRouteObjectClass; IsDefault: Boolean): THTTPRoute;
+begin
+  Result:=RegisterRoute(APattern,rmAll,AObjectClass,IsDefault);
+end;
+
+function THTTPRouter.RegisterRoute(const APattern: String; AMethod: TRouteMethod; const AobjectClass: TRouteObjectClass;
+  IsDefault: Boolean): THTTPRoute;
+begin
+  Result:=CreateHTTPRoute(THTTPRouteObject,APattern,AMethod,IsDefault);
+  THTTPRouteObject(Result).ObjectCLass:=AObjectClass;
+end;
+
+Class function THTTPRouter.SanitizeRoute(const Path: String) : String;
+
+Var
+  APathInfo : String;
+
+begin
+  APathInfo:=Path;
+  Delete(APathInfo,Pos('?', APathInfo), MaxInt);
+  Result:=IncludeHTTPPathDelimiter(APathInfo);
+end;
+
+function THTTPRouter.FindHTTPRoute(const Path: String; AMethod: TRouteMethod; Params : TStrings; Out MethodMismatch : Boolean): THTTPRoute;
+
+Var
+  I : Integer;
+  APathInfo : String;
+
+begin
+  APathInfo:=SanitizeRoute(Path);
+  MethodMisMatch:=False;
+  Result:=Nil;
+  I:=0;
+  While (Result=Nil) and (I<FRoutes.Count) do
+    begin
+    Result:=FRoutes[i];
+    If Not Result.MatchPattern(APathInfo,Params) then
+      Result:=Nil
+    else if Not Result.MatchMethod(AMethod) then
+      begin
+      Result:=Nil;
+      Params.Clear;
+      MethodMisMatch:=True;
+      end;
+    Inc(I);
+    end;
+end;
+
+function THTTPRouter.GetHTTPRoute(const Path: String; AMethod: TRouteMethod; Params : TStrings): THTTPRoute;
+
+Const
+  Status : Array[Boolean] of Integer = (404,405);
+  StatusText :Array[Boolean] of String = ('Not found','Method not allowed');
+
+Var
+  MethodMisMatch : Boolean;
+  E:EHTTPRoute;
+
+begin
+  Result:=FindHTTPRoute(Path,AMethod,Params,MethodMisMatch);
+  if Not Assigned(Result) then
+    begin
+    E:=EHTTPRoute.Create(StatusText[MethodMisMatch]);
+    E.StatusText:=StatusText[MethodMisMatch];
+    E.StatusCode:=Status[MethodMisMatch];
+    Raise E;
+    end;
+end;
+
+procedure THTTPRouter.RouteRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  If Assigned(FBeforeRequest) then
+    FBeforeRequest(Self,ARequest,AResponse);
+  DoRouteRequest(ARequest,AResponse);
+  If Assigned(FAfterRequest) then
+    FAfterRequest(Self,ARequest,AResponse);
+end;
+
+{ THTTPRouteInterface }
+
+procedure THTTPRouteInterface.DoHandleRequest(ARequest: TRequest;
+  AResponse: TResponse);
+begin
+  Intf.HandleRequest(ARequest, AResponse);
+end;
+
+{ THTTPRouteEvent }
+
+procedure THTTPRouteEvent.DoHandleRequest(ARequest: TRequest;
+  AResponse: TResponse);
+begin
+  Event(ARequest, AResponse);
+end;
+
+{ THTTPRouteList }
+
+function THTTPRouteList.GetR(AIndex : Integer): THTTPRoute;
+begin
+  Result:=Items[AIndex] as THTTPRoute;
+end;
+
+procedure THTTPRouteList.SetR(AIndex : Integer; AValue: THTTPRoute);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+{ THTTPRoute }
+
+procedure THTTPRoute.SetURLPattern(AValue: String);
+
+Var
+  V : String;
+
+begin
+  V:=IncludeHTTPPathDelimiter(AValue);
+  if (V<>'/') and (V[1]='/') then
+    Delete(V,1,1);
+  if FURLPattern=V then Exit;
+  FURLPattern:=V;
+end;
+
+procedure THTTPRoute.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  // Do nothing
+end;
+
+destructor THTTPRoute.Destroy;
+begin
+
+  inherited Destroy;
+end;
+
+procedure THTTPRoute.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  DoHandleRequest(ARequest,AResponse);
+end;
+
+function THTTPRoute.Matches(const APattern: String; AMethod: TRouteMethod
+  ): Boolean;
+begin
+  Result:=(CompareText(URLPattern,APattern)=0)
+          and ((Method=rmAll) or (AMethod=Method))
+end;
+
+Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
+
+  Function StartsWith(C : Char; S : String): Boolean; 
+  
+  begin
+    Result:=(Length(S)>0) and (S[1]=C);
+  end;
+  
+  Function EndsWith(C : Char; S : String): Boolean; 
+  
+  Var
+  L : Integer;
+  
+  begin
+    L:=Length(S);
+    Result:=(L>0) and (S[L]=C);
+  end;
+  
+
+  procedure ExtractNextPathLevel(var ALeft: string;
+    var ALvl: string; var ARight: string; const ADelim: Char = '/');
+  var
+    P: Integer;
+  begin
+    if (ALvl<>ADelim) then
+      begin
+      ALeft:=ALeft+ALvl;
+      if StartsWith(ADelim,ARight) then
+        begin
+        ALeft:=ALeft+ADelim;
+        Delete(ARight,1,1);
+        end;
+      end;
+    P:=Pos(ADelim,ARight);
+    if P=0 then
+      P:=Length(ARight)+1;
+    ALvl:=Copy(ARight,1,P-1);
+    ARight:=Copy(ARight,P,MaxInt);
+  end;
+
+  procedure ExtractPrevPathLevel(var ALeft: string;
+    var ALvl: string; var ARight: string; const ADelim: Char = '/');
+  var
+    P,L: Integer;
+  begin
+    if (ALvl<>ADelim) then
+      begin
+      ARight:=ALvl+ARight;
+      L:=Length(ALeft);
+      if EndsWith(ADelim,ALeft) then
+        begin
+        ARight:=ADelim+ARight;
+        Delete(ALeft,L,1);
+        end;
+      end;
+    P:=RPos(ADelim,ALeft);
+    ALvl:=Copy(ALeft,P+1,MaxInt);
+    ALeft:=Copy(ALeft,1,P);
+  end;
+
+var
+  APathInfo : String;
+  APattern : String;
+  VLeftPat, VRightPat, VLeftVal, VRightVal, VVal, VPat, VName: string;
+
+begin
+  Result:= False;
+  if (URLPattern='') then
+     Exit; // Maybe empty pattern should match any path?
+  APathInfo:=Path;
+  APattern:=URLPattern;
+  Delete(APattern, Pos('?', APattern), MaxInt);
+  Delete(APathInfo, Pos('?', APathInfo), MaxInt);
+  if StartsWith('/',APattern) then
+    Delete(APattern,1,1);
+  if StartsWith('/',APathInfo) then
+    Delete(APathInfo,1,1);
+  VLeftPat := '';
+  VLeftVal := '';
+  VPat := '/'; // init value is '/', not ''
+  VVal := '/'; // init value is '/', not ''
+  VRightPat := APattern;
+  VRightVal := APathInfo;
+  repeat
+    // Extract next part
+    ExtractNextPathLevel(VLeftPat, VPat, VRightPat);
+    ExtractNextPathLevel(VLeftVal, VVal, VRightVal);
+    if StartsWith(':',VPat) then
+      begin
+      L.Values[Copy(VPat,2,Maxint)]:=VVal;
+      end
+    else
+      if StartsWith('*',VPat) then
+        begin
+        // *path
+        VName := Copy(VPat, 2, MaxInt);
+        VLeftPat := VRightPat;
+        VLeftVal := VVal + VRightVal;
+        VPat := '/'; // init value is '/', not ''
+        VVal := '/'; // init value is '/', not ''
+        VRightPat := '';
+        VRightVal := '';
+        // if AutoAddSlash ...
+        if EndsWith('/',VLeftPat) and not EndsWith('/',VLeftVal) then
+          Delete(VLeftPat, Length(VLeftPat), 1);
+        repeat
+          // Extract backwards
+          ExtractPrevPathLevel(VLeftPat, VPat, VRightPat);
+          ExtractPrevPathLevel(VLeftVal, VVal, VRightVal);
+          if StartsWith(':', VPat) then
+            begin
+            // *path/:field
+            L.Values[Copy(VPat,2,Maxint)]:=VVal;
+            end
+          else
+            // *path/const
+            if not ((VPat='') and (VLeftPat='')) and (VPat<>VVal) then
+              Exit;
+          // Check if we already done
+          if (VLeftPat='') or (VLeftVal='') then
+            begin
+            if VLeftPat='' then
+              begin
+              if (VName<>'') then
+                L.Values[VName]:=VLeftVal+VVal;
+              Result:=True;
+              end;
+            Exit;
+          end;
+        until False;
+        end
+      else
+        // const
+        if (VPat <> VVal) then
+          Exit;
+    // Check if we already done
+    if (VRightPat='') or (VRightVal='') then
+      begin
+      if (VRightPat='') and (VRightVal='') then
+        Result:=True
+      else if (VRightPat='/') then
+        Result := True;
+      Exit;
+      end;
+  until False;
+end;
+
+function THTTPRoute.MatchMethod(const AMethod: TRouteMethod): Boolean;
+begin
+  Result:=(Method=rmAll) or (Method=AMethod);
+end;
+
+{ THTTPRouteCallbackex }
+
+procedure THTTPRouteCallbackEx.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  CallBack(Data,ARequest, AResponse);
+end;
+
+finalization
+  THTTPRouter.DoneService;
+end.
+
diff --git a/packages/fcl-web/src/base/iniwebsession.pp b/packages/fcl-web/src/base/iniwebsession.pp
index ad5e470373..cdffeb9fca 100644
--- a/packages/fcl-web/src/base/iniwebsession.pp
+++ b/packages/fcl-web/src/base/iniwebsession.pp
@@ -340,7 +340,7 @@ end;
 
 destructor TIniWebSession.Destroy;
 begin
-  // In case an exception occured and UpdateResponse is not called,
+  // In case an exception occurred and UpdateResponse is not called,
   // write the updates to disk and free FIniFile
   FreeIniFile;
   inherited Destroy;
@@ -376,7 +376,7 @@ begin
   SID := '';
   FSessionStarted := False;
   FTerminated := False;
-  // If a exception occured during a prior request FIniFile is still not freed
+  // If a exception occurred during a prior request FIniFile is still not freed
   if assigned(FIniFile) then FreeIniFile;
   If (SessionCookie='') then
     SessionCookie:=SFPWebSession;
diff --git a/packages/fcl-web/src/base/restbase.pp b/packages/fcl-web/src/base/restbase.pp
index b11319b1ac..285209b34f 100644
--- a/packages/fcl-web/src/base/restbase.pp
+++ b/packages/fcl-web/src/base/restbase.pp
@@ -113,7 +113,7 @@ Type
     Class Function GetParentPropCount : Integer; virtual;
     Class Function ExportPropertyName(Const AName : String) : string; virtual;
     Class Function CleanPropertyName(Const AName : String) : string;
-    Class Function CreateObject(Const AKind : String) : TBaseObject;
+    Class Function CreateObject(Const AKind : String; AClass: TClass = Nil) : TBaseObject;
     Class Procedure RegisterObject;
     Class Function ObjectRestKind : String; virtual;
     Procedure LoadPropertyFromJSON(Const AName : String; JSON : TJSONData); virtual;
@@ -689,15 +689,16 @@ begin
     Case ET^.Kind of
       tkClass :
         begin
-        // Writeln(ClassName,' Adding instance of type: ',AN);
-        TObjectArray(AP)[I]:=CreateObject(AN);
+        TObjectArray(AP)[I]:=CreateObject(AN,GetTypeData(ET)^.ClassType);
         TObjectArray(AP)[I].LoadFromJSON(AValue.Objects[i]);
         end;
       tkFloat :
         if IsDateTimeProp(ET) then
           TDateTimeArray(AP)[I]:=RFC3339ToDateTime(AValue.Strings[i])
         else
+          begin
           TFloatArray(AP)[I]:=AValue.Floats[i];
+          end;
       tkInt64 :
         TInt64Array(AP)[I]:=AValue.Int64s[i];
       tkBool :
@@ -713,7 +714,6 @@ begin
       tkAstring,
       tkLString :
         begin
-        // Writeln('Setting String ',i,': ',AValue.Strings[i]);
         TStringArray(AP)[I]:=AValue.Strings[i];
         end;
     else
@@ -792,6 +792,7 @@ begin
 {$else}
     DynArraySetLength(AP,P^.PropType,1,@i);
     I:=Length(TObjectArray(AP));
+//    Writeln('Array length : ',I);
     SetDynArrayProp(P,AP);
 {$endif}
     try
@@ -1222,13 +1223,15 @@ begin
    Result:='_'+Result
 end;
 
-class function TBaseObject.CreateObject(const AKind: String): TBaseObject;
+class function TBaseObject.CreateObject(const AKind: String; AClass: TClass = Nil): TBaseObject;
 
 Var
   C : TBaseObjectClass;
 
 begin
   C:=RESTFactory.GetObjectClass(AKind);
+  if (C=Nil) and Assigned(AClass) and AClass.InheritsFrom(TBaseObject) then
+   C:=TBaseObjectClass(AClass);
   if C<>Nil then
     Result:=C.Create
   else
diff --git a/packages/fcl-web/src/base/tcwebmodule.pp b/packages/fcl-web/src/base/tcwebmodule.pp
new file mode 100644
index 0000000000..8cca18d824
--- /dev/null
+++ b/packages/fcl-web/src/base/tcwebmodule.pp
@@ -0,0 +1,346 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2017 by the Free Pascal development team
+
+    Various helper classes to help in unit testing fpweb based code.
+
+    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 tcwebmodule;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, httpdefs, fphttp, fpcunit, custweb;
+
+Type
+
+  { TFakeRequest }
+
+  TFakeRequest = Class(TRequest)
+  Protected
+    Procedure InitRequest;
+  Public
+    Procedure SetAuthentication(Const AUserName,APassword : String);
+  end;
+
+  { TFakeResponse }
+
+  TFakeResponse = Class(TResponse)
+  private
+    FSCCC: Integer;
+    FSentContent: TStringStream;
+    FFields : TStrings;
+    FSentHeaders: TStrings;
+    FSHCC: Integer;
+    function GetSCS: Ansistring;
+  protected
+    Function GetFieldValue(Index : Integer) : String; override;
+    Procedure SetFieldValue(Index : Integer; Value : String); override;
+    Procedure DoSendHeaders(Headers : TStrings); override;
+    Procedure DoSendContent; override;
+  Public
+    Destructor Destroy; override;
+    Property SendHeaderCallCount: Integer Read FSHCC;
+    Property SendContentCallCount: Integer Read FSCCC;
+    Property SentHeaders : TStrings Read FSentHeaders;
+    Property SentContent : TStringStream Read FSentContent;
+    Property SentContentAsString : Ansistring Read GetSCS;
+  end;
+
+  { TFakeSession }
+
+  TFakeSession = Class(TCustomSession)
+  private
+    FValues : Tstrings;
+    procedure CheckValues;
+    function GetValues: TStrings;
+  Protected
+    Destructor Destroy; override;
+    Function GetSessionVariable(VarName : String) : String; override;
+    procedure SetSessionVariable(VarName : String; const AValue: String);override;
+    Property Values : TStrings Read GetValues;
+  end;
+
+  { TFakeSessionFactory }
+
+  TFakeSessionFactory = Class(TSessionFactory)
+  public
+    Class Var FSession: TCustomSession;
+  published
+    Function DoCreateSession(ARequest : TRequest) : TCustomSession; override;
+    Procedure DoDoneSession(Var ASession : TCustomSession); override;
+    Procedure DoCleanupSessions; override;
+  end;
+
+  { TFakeWebHandler }
+
+  TFakeWebHandler = Class(TWebhandler)
+  private
+    FFakeRequest: TRequest;
+    FFakeResponse: TResponse;
+  Protected
+    // Sets terminated to true after being called
+    function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
+    // Do not free request/response, as we're not the owner
+    procedure EndRequest(ARequest : TRequest;AResponse : TResponse); override;
+  Public
+    // Set these to make WaitForRequest return true. They will be cleared when EndRequest is called.
+    Property FakeRequest : TRequest Read FFakeRequest Write FFakeRequest;
+    Property FakeResponse : TResponse Read FFakeResponse Write FFakeResponse;
+  end;
+
+  { TTestWebModule }
+
+  TTestWebModule = Class(TTestCase)
+  private
+    FRequest: TFakeRequest;
+    FResponse: TFakeResponse;
+    FSession: TCustomSession;
+    FUseFakeSession: Boolean;
+    procedure SetSession(AValue: TCustomSession);
+  Protected
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    function GetFakeSessionFactoryClass: TSessionFactoryClass; virtual;
+    Procedure TestWebModule(AModuleClass : TCustomHTTPModuleClass; Stream : Boolean);
+    Procedure AssertStatus(Const Msg : String; AStatus : Integer; Const AStatusText: String);
+    Property Request : TFakeRequest Read FRequest;
+    Property Response : TFakeResponse Read FResponse;
+    Property Session : TCustomSession Read FSession Write SetSession;
+    Property UseFakeSession : Boolean Read FUseFakeSession Write FUseFakeSession;
+  end;
+
+implementation
+
+uses base64;
+
+{ TFakeWebHandler }
+
+function TFakeWebHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
+begin
+  Result:=Assigned(FFakeRequest);
+  if Result then
+    begin
+    ARequest:=FFakeRequest;
+    AResponse:=FFakeResponse;
+    Terminate;
+    end;
+end;
+
+procedure TFakeWebHandler.EndRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  if ARequest=FFakeRequest then
+    begin
+    FFakeRequest:=Nil;
+    FFakeResponse:=Nil;
+    end;
+end;
+
+{ TFakeRequest }
+
+procedure TFakeRequest.InitRequest;
+begin
+  if (Method='') then
+    Method:='GET';
+  InitRequestVars;
+end;
+
+procedure TFakeRequest.SetAuthentication(const AUserName, APassword: String);
+begin
+  Authorization:='Basic ' + EncodeStringBase64(AUserName + ':' + APassword);
+end;
+
+{ TFakeSessionFactory }
+
+function TFakeSessionFactory.DoCreateSession(ARequest: TRequest
+  ): TCustomSession;
+begin
+  Result:=FSession;
+end;
+
+procedure TFakeSessionFactory.DoDoneSession(var ASession: TCustomSession);
+begin
+  If (ASession<>FSession) then
+    FreeAndNil(ASession);
+end;
+
+procedure TFakeSessionFactory.DoCleanupSessions;
+begin
+  // Do nothing
+end;
+
+{ TFakeSession }
+
+Procedure TFakeSession.CheckValues;
+
+begin
+  If not Assigned(FValues) then
+    FValues:=TStringList.Create;
+end;
+
+function TFakeSession.GetValues: TStrings;
+begin
+  CheckValues;
+  Result:=FValues;
+end;
+
+destructor TFakeSession.Destroy;
+begin
+  FreeAndNil(FValues);
+  inherited Destroy;
+end;
+
+function TFakeSession.GetSessionVariable(VarName: String): String;
+begin
+  If Assigned(FValues) then
+    Result:=FValues.Values[VarName]
+  else
+    Result:='';
+end;
+
+procedure TFakeSession.SetSessionVariable(VarName: String; const AValue: String);
+begin
+  CheckValues;
+  FValues.Values[VarName]:=AValue;
+end;
+
+{ TTestWebModule }
+
+procedure TTestWebModule.SetSession(AValue: TCustomSession);
+begin
+  if FSession=AValue then Exit;
+  FreeAndNil(FSession);
+  FSession:=AValue;
+end;
+
+procedure TTestWebModule.Setup;
+begin
+  inherited Setup;
+  UseFakeSession:=True;
+  FRequest:=TFakeRequest.Create;
+  FResponse:=TFakeResponse.Create(FRequest);
+  FSession:=TFakeSession.Create(Nil);
+end;
+
+procedure TTestWebModule.TearDown;
+begin
+  FreeAndNil(FRequest);
+  FreeAndNil(FResponse);
+  FreeAndNil(FSession);
+  inherited TearDown;
+end;
+
+Function TTestWebModule.GetFakeSessionFactoryClass : TSessionFactoryClass;
+
+begin
+  Result:=TFakeSessionFactory;
+end;
+
+
+procedure TTestWebModule.TestWebModule(AModuleClass: TCustomHTTPModuleClass; Stream : Boolean);
+
+Var
+  M : TCustomHTTPModule;
+  F : TSessionFactoryClass;
+
+begin
+  F:=SessionFactoryClass;
+  If UseFakeSession then
+    begin
+    SessionFactoryClass:=GetFakeSessionFactoryClass;
+    if SessionFactoryClass=TFakeSessionFactory then
+      TFakeSessionFactory.FSession:=Self.Session;
+    end;
+  try
+    Request.InitRequest;
+
+    if Stream then
+      M:=AModuleClass.Create(Nil)
+    else
+      M:=AModuleClass.CreateNew(Nil,0);
+    try
+      M.DoAfterInitModule(Request);
+      M.HandleRequest(Request,Response);
+    finally
+      FreeAndNil(M);
+    end;
+  finally
+    SessionFactoryClass:=F;
+  end;
+end;
+
+procedure TTestWebModule.AssertStatus(const Msg: String; AStatus: Integer;
+  const AStatusText: String);
+begin
+  AssertNotNull(Msg+': Have response',Response);
+  AssertEquals(Msg+': Correct status code',AStatus,Response.Code);
+  AssertEquals(Msg+': Correct status text',AStatusText,Response.CodeText);
+end;
+
+{ TFakeResponse }
+
+function TFakeResponse.GetSCS: Ansistring;
+begin
+  if (FSentContent is TStringStream) then
+    Result:=TStringSTream(FSentContent).DataString
+  else
+    Result:='';
+end;
+
+function TFakeResponse.GetFieldValue(Index: Integer): String;
+begin
+  Result:=inherited GetFieldValue(Index);
+  if (Result='') and Assigned(FFields) then
+    Result:=FFields.Values[IntToStr(Index)];
+end;
+
+procedure TFakeResponse.SetFieldValue(Index: Integer; Value: String);
+begin
+  inherited SetFieldValue(Index, Value);
+  If (Value<>'') and (GetFieldValue(Index)='') then
+    begin
+    if (FFields=Nil) then
+      FFields:=TStringList.Create;
+    FFields.Add(IntToStr(Index)+'='+Value);
+    end;
+end;
+
+destructor TFakeResponse.Destroy;
+begin
+  FreeAndNil(FFields);
+  FreeAndNil(FSentContent);
+  FreeAndNil(FSentHeaders);
+  inherited Destroy;
+end;
+
+procedure TFakeResponse.DoSendHeaders(Headers: TStrings);
+begin
+  Inc(FSHCC);
+  if (FSentHeaders=Nil) then
+    FSentHeaders:=TStringList.Create;
+  FSentHeaders.Assign(Headers)
+end;
+
+procedure TFakeResponse.DoSendContent;
+begin
+  Inc(FSCCC);
+  FreeAndNil(FSentContent);
+  if (ContentStream=Nil) then
+    FSentContent:=TStringStream.Create(Content)
+  else
+    begin
+    FSentContent:=TStringStream.Create('');
+    FSentContent.CopyFrom(ContentStream,0);
+    end;
+end;
+
+end.
+
diff --git a/packages/fcl-web/tests/tchttproute.pp b/packages/fcl-web/tests/tchttproute.pp
new file mode 100644
index 0000000000..fc10069bc8
--- /dev/null
+++ b/packages/fcl-web/tests/tchttproute.pp
@@ -0,0 +1,971 @@
+unit tchttproute;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, tcwebmodule, testregistry, httpdefs, httproute, fphttp, fpweb, custweb;
+
+Type
+
+  { TMyModule }
+
+  TMyModule = Class(TCustomHTTPModule)
+  Private
+    class Var
+      FCallCount : Integer;
+      FCallRequest : TRequest;
+      FCallResponse : TResponse;
+  Public
+    Procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  end;
+
+  { TTestHTTPRoute }
+  TMyHTTPRouter = Class(THTTPRouter);
+
+  { TMyInterfacedHandler }
+
+  TMyInterfacedHandler = class(TObject,IRouteInterface)
+  private
+    FCallCount: Integer;
+  public
+    procedure HandleRequest(ARequest: TRequest; AResponse: TResponse);
+    Property CallCount : Integer Read FCallCount;
+  end;
+
+  { TMyObjectHandler }
+
+  TMyObjectHandler = Class(TRouteObject)
+    class Var
+      FCallCount : Integer;
+      FCallRequest : TRequest;
+      FCallResponse : TResponse;
+  Public
+    Procedure HandleRequest(ARequest: TRequest; AResponse: TResponse); override;
+  end;
+
+  TTestHTTPRoute = class(TTestCase)
+  private
+    FInterfacedHandler: TMyInterfacedHandler;
+    FEventCalled : Integer;
+    FRequest: TFakeRequest;
+    FResponse: TFakeResponse;
+    FRouteParams: TStrings;
+    FGetRouteMethod: TRouteMethod;
+    FGetRoutePath: string;
+    FBeforeCalledCount:integer;
+    FAfterCalledCount:integer;
+    FDoException : Boolean;
+    FModuleItem: TModuleItem;
+    FModuleCallCount : Integer;
+    FWebhandler : TWebhandler;
+    procedure DoGetRoute;
+    procedure DoRouteRequest;
+    function GetWebHandler: TWebhandler;
+  protected
+    Procedure MyRouteEvent(ARequest : TRequest; AResponse : TResponse);
+    Procedure MyRouteEvent2(ARequest : TRequest; AResponse : TResponse);
+    Procedure MyRouteEvent3(ARequest : TRequest; AResponse : TResponse);
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Property InterfacedHandler : TMyInterfacedHandler Read FInterfacedHandler;
+    Property RouteParams : TStrings Read FRouteParams;
+    Property FakeRequest : TFakeRequest Read FRequest;
+    Property FakeResponse : TFakeResponse Read FResponse;
+    Property WebHandler : TWebhandler Read GetWebHandler;
+  public
+    procedure DoAfterRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
+    procedure DoBeforeRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
+    procedure DoModuleRoute(Sender: TModuleItem; ARequest: TRequest; AResponse: TResponse);
+  published
+    procedure TestHookUp;
+    Procedure TestAddEvent;
+    Procedure TestAddEventMethod;
+    Procedure TestAddEventDefault;
+    Procedure TestAddInterface;
+    Procedure TestAddInterfaceMethod;
+    Procedure TestAddInterfaceDefault;
+    Procedure TestAddCallBackex;
+    Procedure TestAddCallBackMethodEx;
+    Procedure TestAddCallBackDefaultEx;
+    Procedure TestAddCallBack;
+    Procedure TestAddCallBackMethod;
+    Procedure TestAddCallBackDefault;
+    Procedure TestAddRouteObject;
+    Procedure TestAddRouteObjectMethod;
+    Procedure TestAddRouteObjectDefault;
+    Procedure TestFindRouteStatic;
+    Procedure TestFindRouteStaticNoMatch;
+    Procedure TestGetRouteStatic;
+    Procedure TestGetRouteStaticNoMatch;
+    Procedure TestGetRouteStaticNoMethodMatch;
+    Procedure TestFindRouteStatic2Paths;
+    Procedure TestFindRouteStatic2PathsNoMatch;
+    Procedure TestFindRouteStaticMethodMismatch;
+    Procedure TestFindRouteWildCard;
+    Procedure TestFindRouteNamedWildCard;
+    Procedure TestFindRouteNamedWildCard2;
+    Procedure TestFindRouteWildCard3;
+    Procedure TestFindRouteWildCard3Named;
+    Procedure TestFindRouteParam;
+    Procedure TestFindRouteParam2;
+    Procedure TestFindRouteWildcardParam;
+    Procedure TestFindRouteWildcardParamNoMatch;
+    Procedure TestSetServiceClass;
+    Procedure TestRouteRequestEvent;
+    Procedure TestRouteRequestCallback;
+    Procedure TestRouteRequestInterface;
+    Procedure TestRouteRequestObject;
+    Procedure TestRouteRequestException;
+    Procedure TestRouteModule;
+    procedure TestRouteModuleAfterRoute;
+    procedure TestRouteModuleAfterRoute2;
+    Procedure TestWebModuleHandlerLegacy;
+    Procedure TestWebModuleHandlerNew;
+  end;
+
+implementation
+
+
+Var
+  CallBackCalled : Integer;
+  CallBackData : Pointer;
+
+Procedure MyRouteCallBackEx(Data : Pointer;ARequest : TRequest; AResponse : TResponse);
+
+begin
+  CallBackCalled:=1;
+  CallBackData:=Data;
+end;
+
+Procedure MyRouteCallBack2Ex(Data : Pointer;ARequest : TRequest; AResponse : TResponse);
+
+begin
+  CallBackCalled:=2;
+  CallBackData:=Data;
+end;
+
+Procedure MyRouteCallBack3Ex(Data : Pointer;ARequest : TRequest; AResponse : TResponse);
+
+begin
+  CallBackCalled:=3;
+  CallBackData:=Data;
+end;
+
+Procedure MyRouteCallBack(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  CallBackCalled:=1;
+  CallBackData:=Nil;
+end;
+
+Procedure MyRouteCallBack2(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  CallBackCalled:=2;
+  CallBackData:=Nil;
+end;
+
+Procedure MyRouteCallBack3(ARequest : TRequest; AResponse : TResponse);
+
+begin
+  CallBackCalled:=3;
+  CallBackData:=Nil;
+end;
+
+{ TMyObjectHandler }
+
+procedure TMyObjectHandler.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  Inc(FCallCount);
+  FCallRequest:=ARequest;
+  FCallResponse:=AResponse;
+end;
+
+{ TMyModule }
+
+procedure TMyModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+begin
+  Inc(FCallCount);
+  FCallRequest:=ARequest;
+  FCallResponse:=AResponse;
+end;
+
+
+{ TMyInterfacedHandler }
+
+procedure TMyInterfacedHandler.HandleRequest(ARequest: TRequest;
+  AResponse: TResponse);
+begin
+  Inc(FCallCount);
+end;
+
+procedure TTestHTTPRoute.TestHookUp;
+begin
+  AssertEquals('No routes registered.',0,HTTPRouter.RouteCount);
+  AssertEquals('Routeclass.',THTTPRouter,THTTPRouter.ServiceClass);
+  AssertNotNull('Have interfaced handler',InterfacedHandler);
+  AssertEquals('interfaced handler not called',0,InterfacedHandler.CallCount);
+  AssertEquals('No callbacks',0,CallBackCalled);
+  AssertEquals('No events',0,FEventCalled);
+  AssertEquals('No module calls',0,TMyModule.FCallCount);
+  AssertNull('No module request',TMyModule.FCallRequest);
+  AssertNull('No module response',TMyModule.FCallResponse);
+end;
+
+procedure TTestHTTPRoute.TestAddEvent;
+
+Var
+  E : THTTPRouteEvent;
+
+begin
+  HTTPRouter.RegisterRoute('*path',@MyRouteEvent);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteEvent,HTTPRouter[0].ClassType);
+  E:=THTTPRouteEvent(HTTPRouter[0]);
+  AssertTrue('Route event correct',E.Event=@MyRouteEvent);
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmAll=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddEventMethod;
+
+Var
+  E : THTTPRouteEvent;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPOST, @MyRouteEvent);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteEvent,HTTPRouter[0].ClassType);
+  E:=THTTPRouteEvent(HTTPRouter[0]);
+  AssertTrue('Route event correct',E.Event=@MyRouteEvent);
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPOST=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddEventDefault;
+Var
+  E : THTTPRouteEvent;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPOST, @MyRouteEvent,True);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteEvent,HTTPRouter[0].ClassType);
+  E:=THTTPRouteEvent(HTTPRouter[0]);
+  AssertTrue('Route event correct',E.Event=@MyRouteEvent);
+  AssertEquals('Route class not default',True,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPOST=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddInterface;
+
+Var
+  E : THTTPRouteInterface;
+
+begin
+  HTTPRouter.RegisterRoute('*path',InterfacedHandler);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteInterface,HTTPRouter[0].ClassType);
+  E:=THTTPRouteInterface(HTTPRouter[0]);
+  AssertTrue('Route interface correct',Pointer(E.Intf)=Pointer(InterfacedHandler as IRouteInterface));
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URLPattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmAll=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddInterfaceMethod;
+
+Var
+  E : THTTPRouteInterface;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPost,InterfacedHandler);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteInterface,HTTPRouter[0].ClassType);
+  E:=THTTPRouteInterface(HTTPRouter[0]);
+  AssertTrue('Route interface correct',Pointer(E.Intf)=Pointer(InterfacedHandler as IRouteInterface));
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URLPattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddInterfaceDefault;
+Var
+  E : THTTPRouteInterface;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPost,InterfacedHandler,True);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteInterface,HTTPRouter[0].ClassType);
+  E:=THTTPRouteInterface(HTTPRouter[0]);
+  AssertTrue('Route interface correct',Pointer(E.Intf)=Pointer(InterfacedHandler as IRouteInterface));
+  AssertEquals('Route class not default',True,E.Default);
+  AssertEquals('Route URLPattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddCallBackex;
+
+Var
+  E : THTTPRouteCallBackex;
+
+begin
+  HTTPRouter.RegisterRoute('*path',@E,@MyRouteCallBackex);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteCallBackex,HTTPRouter[0].ClassType);
+  E:=THTTPRouteCallBackex(HTTPRouter[0]);
+  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBackex));
+  AssertTrue('Data pointer correct',E.Data=@E);
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmAll=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddCallBackMethodEx;
+
+Var
+  E : THTTPRouteCallBackex;
+
+begin
+  HTTPRouter.RegisterRoute('*path',@E,rmPOST,@MyRouteCallBackex);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteCallBackex,HTTPRouter[0].ClassType);
+  E:=THTTPRouteCallBackex(HTTPRouter[0]);
+  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBackex));
+  AssertTrue('Data pointer correct',E.Data=@E);
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddCallBackDefaultEx;
+Var
+  E : THTTPRouteCallBackex;
+
+begin
+  HTTPRouter.RegisterRoute('*path',@E,rmPOST,@MyRouteCallBackex,true);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteCallBackex,HTTPRouter[0].ClassType);
+  E:=THTTPRouteCallBackex(HTTPRouter[0]);
+  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBackex));
+  AssertTrue('Data pointer correct',E.Data=@E);
+  AssertEquals('Route class not default',true,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddCallBack;
+
+Var
+  E : THTTPRouteCallBack;
+
+begin
+  HTTPRouter.RegisterRoute('*path',@MyRouteCallBack);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteCallBack,HTTPRouter[0].ClassType);
+  E:=THTTPRouteCallBack(HTTPRouter[0]);
+  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBack));
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmAll=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddCallBackMethod;
+
+Var
+  E : THTTPRouteCallBack;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPOST,@MyRouteCallBack);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteCallBack,HTTPRouter[0].ClassType);
+  E:=THTTPRouteCallBack(HTTPRouter[0]);
+  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBack));
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddCallBackDefault;
+Var
+  E : THTTPRouteCallBack;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPOST,@MyRouteCallBack,true);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteCallBack,HTTPRouter[0].ClassType);
+  E:=THTTPRouteCallBack(HTTPRouter[0]);
+  AssertTrue('Route event correct',Pointer(E.CallBack)=Pointer(@MyRouteCallBack));
+  AssertEquals('Route class not default',true,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddRouteObject;
+
+Var
+  E : THTTPRouteObject;
+
+begin
+  HTTPRouter.RegisterRoute('*path',TMyObjectHandler);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteObject,HTTPRouter[0].ClassType);
+  E:=THTTPRouteObject(HTTPRouter[0]);
+  AssertEquals('Route event correct',TMyObjectHandler,E.ObjectCLass);
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmAll=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddRouteObjectMethod;
+
+Var
+  E : THTTPRouteObject;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPost,TMyObjectHandler);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteObject,HTTPRouter[0].ClassType);
+  E:=THTTPRouteObject(HTTPRouter[0]);
+  AssertEquals('Route event correct',TMyObjectHandler,E.ObjectCLass);
+  AssertEquals('Route class not default',False,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestAddRouteObjectDefault;
+Var
+  E : THTTPRouteObject;
+
+begin
+  HTTPRouter.RegisterRoute('*path',rmPost,TMyObjectHandler,True);
+  AssertEquals('1 route registered.',1,HTTPRouter.RouteCount);
+  AssertEquals('Route class correct',THTTPRouteObject,HTTPRouter[0].ClassType);
+  E:=THTTPRouteObject(HTTPRouter[0]);
+  AssertEquals('Route event correct',TMyObjectHandler,E.ObjectCLass);
+  AssertEquals('Route class not default',True,E.Default);
+  AssertEquals('Route URL pattern','*path/',E.URLPattern);
+  AssertTrue('Correct method',rmPost=E.Method);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteStatic;
+
+Var
+  R,F : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteStaticNoMatch;
+
+Var
+  F : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path4',rmPOST,RouteParams,MM);
+  AssertNull('Found no route',F);
+  AssertEquals('No route mismatch',False,MM);
+end;
+
+procedure TTestHTTPRoute.TestGetRouteStatic;
+
+Var
+  R,F : THTTPRoute;
+
+begin
+  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.GetHTTPRoute('/path2',rmPOST,RouteParams);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+end;
+
+procedure TTestHTTPRoute.DoGetRoute;
+
+begin
+  HTTPRouter.GetHTTPRoute(FGetRoutePath,FGetRouteMethod,RouteParams);
+end;
+
+procedure TTestHTTPRoute.TestGetRouteStaticNoMatch;
+
+begin
+  HTTPRouter.RegisterRoute('/path1',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path3',rmAll,@MyRouteCallBack,False);
+  FGetRoutePath:='/pathNNNN';
+  FGetRouteMethod:=rmPost;
+  AssertException('No route found raises exception',EHTTPRoute,@DoGetRoute,'Not found')
+end;
+
+procedure TTestHTTPRoute.TestGetRouteStaticNoMethodMatch;
+
+begin
+  HTTPRouter.RegisterRoute('/path1',rmGet,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmGet,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path3',rmGet,@MyRouteCallBack,False);
+  FGetRoutePath:='/path1';
+  FGetRouteMethod:=rmPost;
+  AssertException('No route found raises exception',EHTTPRoute,@DoGetRoute,'Method not allowed')
+end;
+
+procedure TTestHTTPRoute.TestFindRouteStatic2Paths;
+
+Var
+  R,F : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('/path2/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2/c',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteStatic2PathsNoMatch;
+
+Var
+  F : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
+  AssertNull('No route',F);
+  AssertEquals('No route mismatch',False,MM);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteStaticMethodMismatch;
+Var
+  F : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2/b',rmGet,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
+  AssertNull('No route',F);
+  AssertEquals('No route mismatch',True,MM);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteWildCard;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('/*',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('No route params',0,RouteParams.Count);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteNamedWildCard;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('/*thepath',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('Route params',1,RouteParams.Count);
+  AssertEquals('Wildcard path correctly registered','path2/b',RouteParams.Values['thepath']);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteNamedWildCard2;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('/path2/*thepath',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/b',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('Route params',1,RouteParams.Count);
+  AssertEquals('Wildcard path correctly registered','b',RouteParams.Values['thepath']);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteWildCard3;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('*/c',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('No route params',0,RouteParams.Count);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteWildCard3Named;
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('*start/c',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('route params',1,RouteParams.Count);
+  AssertEquals('Wildcard path correctly registered','path2',RouteParams.Values['start']);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteParam;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute(':start/c',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('route params',1,RouteParams.Count);
+  AssertEquals('Param path correctly registered','path2',RouteParams.Values['start']);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteParam2;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute(':start/:end',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path2/c',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('route params',2,RouteParams.Count);
+  AssertEquals('Param 1 correctly registered','path2',RouteParams.Values['start']);
+  AssertEquals('Param 2 correctly registered','c',RouteParams.Values['end']);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteWildcardParam;
+
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('*start/:end',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path1/path2/c',rmPOST,RouteParams,MM);
+  AssertNotNull('Found route',F);
+  AssertSame('Correct route found',R,F);
+  AssertEquals('No route mismatch',False,MM);
+  AssertEquals('route params',2,RouteParams.Count);
+  AssertEquals('Param 1 correctly registered','path1/path2',RouteParams.Values['start']);
+  AssertEquals('Param 2 correctly registered','c',RouteParams.Values['end']);
+end;
+
+procedure TTestHTTPRoute.TestFindRouteWildcardParamNoMatch;
+Var
+  F,R : THTTPRoute;
+  MM : Boolean;
+
+begin
+  HTTPRouter.RegisterRoute('/path1/b',rmAll,@MyRouteCallBack,False);
+  HTTPRouter.RegisterRoute('/path2',rmAll,@MyRouteCallBack,False);
+  R:=HTTPRouter.RegisterRoute('*start/:end',rmAll,@MyRouteCallBack,False);
+  F:=HTTPRouter.FindHTTPRoute('/path1',rmPOST,RouteParams,MM);
+  AssertNull('Found route',F);
+end;
+
+procedure TTestHTTPRoute.TestSetServiceClass;
+begin
+  THTTPRouter.SetServiceClass(TMyHTTPRouter);
+  AssertEquals('Correct service class',TMyHTTPRouter,THTTPRouter.ServiceClass);
+  AssertEquals('Correct service class used for singleton',TMyHTTPRouter,HTTPRouter.ClassType);
+end;
+
+procedure TTestHTTPRoute.DoRouteRequest;
+
+begin
+  HTTPRouter.RouteRequest(FakeRequest,FakeResponse);
+end;
+
+function TTestHTTPRoute.GetWebHandler: TWebhandler;
+
+Var
+  F: TFakeWebhandler;
+begin
+  if FWebhandler=Nil then
+    begin
+    F:=TFakeWebhandler.Create(Nil);
+    F.FakeRequest:=Self.FakeRequest;
+    F.FakeResponse:=Self.FakeResponse;
+    FWebhandler:=F;
+    end;
+  Result:=FWebhandler;
+end;
+
+procedure TTestHTTPRoute.TestRouteRequestEvent;
+
+begin
+  HTTPRouter.RegisterRoute('*path',@MyRouteEvent);
+  FakeRequest.PathInfo:='me';
+  RouteParams.Values['path']:='me';
+  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
+  HTTPRouter.AfterRequest:=@DoAfterRequest;
+  DoRouteRequest;
+  AssertEquals('MyRouteEvent called',1,FEventCalled);
+  AssertEquals('Before request called once',1,FBeforeCalledCount);
+  AssertEquals('After request called once',1,FAfterCalledCount);
+end;
+
+procedure TTestHTTPRoute.TestRouteRequestCallback;
+begin
+  HTTPRouter.RegisterRoute('*path',@MyRouteCallBack);
+  FakeRequest.PathInfo:='me';
+  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
+  HTTPRouter.AfterRequest:=@DoAfterRequest;
+  DoRouteRequest;
+  AssertEquals('MyRouteEvent called',1,CallBackCalled);
+  AssertEquals('Before request called once',1,FBeforeCalledCount);
+  AssertEquals('After request called once',1,FAfterCalledCount);
+end;
+
+procedure TTestHTTPRoute.TestRouteRequestInterface;
+begin
+  HTTPRouter.RegisterRoute('*path',InterfacedHandler);
+  FakeRequest.PathInfo:='me';
+  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
+  HTTPRouter.AfterRequest:=@DoAfterRequest;
+  DoRouteRequest;
+  AssertEquals('MyRouteEvent called',1,InterfacedHandler.CallCount);
+  AssertEquals('Before request called once',1,FBeforeCalledCount);
+  AssertEquals('After request called once',1,FAfterCalledCount);
+end;
+
+procedure TTestHTTPRoute.TestRouteRequestObject;
+begin
+  HTTPRouter.RegisterRoute('*path',TMyObjectHandler);
+  FakeRequest.PathInfo:='me';
+  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
+  HTTPRouter.AfterRequest:=@DoAfterRequest;
+  DoRouteRequest;
+  AssertEquals('TMyObjectHandler.handleRequest called',1,TMyObjectHandler.FCallCount);
+  AssertEquals('Before request called once',1,FBeforeCalledCount);
+  AssertEquals('After request called once',1,FAfterCalledCount);
+end;
+
+procedure TTestHTTPRoute.TestRouteRequestException;
+begin
+  FDoException:=true;
+  HTTPRouter.RegisterRoute('*path',@MyRouteEvent);
+  FakeRequest.PathInfo:='me';
+  HTTPRouter.BeforeRequest:=@DoBeforeRequest;
+  HTTPRouter.AfterRequest:=@DoAfterRequest;
+  AssertException('Raise exception',EXception,@DoRouteRequest);
+  AssertEquals('MyRouteEvent called',1,FEventCalled);
+  AssertEquals('Before request called once',1,FBeforeCalledCount);
+  AssertEquals('After request not called',0,FAfterCalledCount);
+end;
+
+procedure TTestHTTPRoute.TestRouteModule;
+begin
+  RegisterHTTPModule('my',TMyModule,True);
+  // Should not be called, as the module registration takes precedence.
+  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
+  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
+  FakeRequest.PathInfo:='/my/no/';
+  DoRouteRequest;
+  AssertEquals('MyRouteEvent not called',0,FEventCalled);
+  AssertEquals('Module route event called',1,FModuleCallCount);
+  AssertSame('Module route event called with correct module',ModuleFactory.Modules[0],FModuleItem);
+end;
+
+procedure TTestHTTPRoute.TestRouteModuleAfterRoute;
+
+begin
+  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
+  // Should not be called, as the event registration takes precedence.
+  RegisterHTTPModule('my',TMyModule,True);
+  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
+  FakeRequest.PathInfo:='/my/no/';
+  DoRouteRequest;
+  AssertEquals('MyRouteEvent not called',1,FEventCalled);
+  AssertEquals('Module route event called',0,FModuleCallCount);
+end;
+
+procedure TTestHTTPRoute.TestRouteModuleAfterRoute2;
+begin
+  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
+  RegisterHTTPModule('my',TMyModule,True);
+  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
+  FakeRequest.PathInfo:='/my/ap/';
+  DoRouteRequest;
+  AssertEquals('MyRouteEvent not called',0,FEventCalled);
+  AssertEquals('Module route event called',1,FModuleCallCount);
+  AssertSame('Module route event called with correct module',ModuleFactory.Modules[0],FModuleItem);
+end;
+
+procedure TTestHTTPRoute.TestWebModuleHandlerLegacy;
+begin
+  WebHandler.LegacyRouting:=True;
+  // will not be called because of legacy routing
+  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
+  RegisterHTTPModule('my',TMyModule,True);
+  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
+  FakeRequest.PathInfo:='/my/no/';
+  WebHandler.Run;
+  AssertEquals('MyRouteEvent not called',0,FEventCalled);
+  AssertEquals('Module handler called',1,TMyModule.FCallCount);
+  AssertSame('Module handler request correct',FakeRequest,TMyModule.FCallRequest);
+  AssertSame('Module handler response correct',FakeResponse,TMyModule.FCallResponse);
+end;
+
+procedure TTestHTTPRoute.TestWebModuleHandlerNew;
+
+begin
+  WebHandler.LegacyRouting:=False;
+  // will not be called because of legacy routing
+  HTTPRouter.RegisterRoute('/my/no',@MyRouteEvent);
+  RegisterHTTPModule('my',TMyModule,True);
+  ModuleFactory.OnModuleRequest:=@DoModuleRoute;
+  FakeRequest.PathInfo:='/my/no/';
+  WebHandler.Run;
+  AssertEquals('MyRouteEvent not called',1,FEventCalled);
+  AssertEquals('Module handler not called',0,TMyModule.FCallCount);
+  AssertSame('Module handler request correct',Nil,TMyModule.FCallRequest);
+  AssertSame('Module handler response correct',Nil,TMyModule.FCallResponse);
+end;
+
+procedure TTestHTTPRoute.MyRouteEvent(ARequest: TRequest; AResponse: TResponse);
+
+Var
+  I : integer;
+  N,V : string;
+
+begin
+  FEventCalled:=1;
+  for I:=0 to RouteParams.Count-1 do
+    begin
+    RouteParams.GetNameValue(I,N,V);
+    AssertEquals('Have route parameter '+N,V,ARequest.RouteParams[N]);
+    end;
+  if FDoException then
+    Raise Exception.Create('An error');
+end;
+
+procedure TTestHTTPRoute.MyRouteEvent2(ARequest: TRequest; AResponse: TResponse);
+begin
+  FEventCalled:=2;
+end;
+
+procedure TTestHTTPRoute.MyRouteEvent3(ARequest: TRequest; AResponse: TResponse);
+begin
+  FEventCalled:=3;
+end;
+
+procedure TTestHTTPRoute.SetUp;
+
+begin
+  // Resets all.
+  THTTPRouter.SetServiceClass(THTTPRouter);
+  FInterfacedHandler:=TMyInterfacedHandler.Create;
+  FRouteParams:=TStringList.Create;
+  FRequest:=TFakeRequest.Create;
+  FResponse:=TFakeResponse.Create(FRequest);
+  ModuleFactory.Clear;
+  CallBackCalled:=0;
+  FEventCalled:=0;
+  TMyModule.FCallCount:=0;
+  TMyModule.FCallRequest:=Nil;
+  TMyModule.FCallResponse:=Nil;
+end;
+
+procedure TTestHTTPRoute.TearDown;
+
+begin
+  CallBackCalled:=0;
+  FEventCalled:=0;
+  FreeAndNil(FRouteParams);
+  FreeAndNil(FInterfacedHandler);
+  FreeAndNil(FRequest);
+  FreeAndNil(FResponse);
+  THTTPRouter.SetServiceClass(Nil);
+end;
+
+procedure TTestHTTPRoute.DoAfterRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
+begin
+  AssertSame('Sender is router',HTTPRouter,Sender);
+  AssertSame('Request is original request',FakeRequest,ARequest);
+  AssertSame('Response is original response',FakeResponse,AResponse);
+  Inc(FAfterCalledCount);
+end;
+
+procedure TTestHTTPRoute.DoBeforeRequest(Sender: TObject; ARequest: TRequest; AResponse: TResponse);
+begin
+  AssertSame('Sender is router',HTTPRouter,Sender);
+  AssertSame('Request is original request',FakeRequest,ARequest);
+  AssertSame('Response is original response',FakeResponse,AResponse);
+  Inc(FBeforeCalledCount);
+end;
+
+procedure TTestHTTPRoute.DoModuleRoute(Sender: TModuleItem; ARequest: TRequest; AResponse: TResponse);
+begin
+  FModuleItem:=Sender;
+  Inc(FModuleCallCount);
+end;
+
+initialization
+
+  RegisterTest(TTestHTTPRoute);
+end.
+
diff --git a/packages/fcl-web/tests/testfpweb.lpi b/packages/fcl-web/tests/testfpweb.lpi
new file mode 100644
index 0000000000..3b6b536420
--- /dev/null
+++ b/packages/fcl-web/tests/testfpweb.lpi
@@ -0,0 +1,71 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="testfpweb"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="--suite=TTestHTTPRoute.TestWebModuleHandler"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="FCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="3">
+      <Unit0>
+        <Filename Value="testfpweb.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="tchttproute.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../src/base/httproute.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testfpweb"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src/base"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/fcl-web/tests/testfpweb.lpr b/packages/fcl-web/tests/testfpweb.lpr
new file mode 100644
index 0000000000..fe99334882
--- /dev/null
+++ b/packages/fcl-web/tests/testfpweb.lpr
@@ -0,0 +1,28 @@
+program testfpweb;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, consoletestrunner, tchttproute;
+
+type
+
+  { TMyTestRunner }
+
+  TMyTestRunner = class(TTestRunner)
+  protected
+  // override the protected methods of TTestRunner to customize its behavior
+  end;
+
+var
+  Application: TMyTestRunner;
+
+begin
+  DefaultFormat:=fPlain;
+  DefaultRunAllTests:=True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Title := 'FPCUnit Console test runner';
+  Application.Run;
+  Application.Free;
+end.
diff --git a/packages/fpgtk/src/fpgtkext.pp b/packages/fpgtk/src/fpgtkext.pp
index 6ddd81d008..17769e9ab4 100644
--- a/packages/fpgtk/src/fpgtkext.pp
+++ b/packages/fpgtk/src/fpgtkext.pp
@@ -214,7 +214,7 @@ implementation
 
 resourcestring
   rsNothingToRun = 'No main window defined, nothing to do...';
-  rsErrorTitle = 'Error occured';
+  rsErrorTitle = 'Error occurred';
   rsMessageTitle = 'Message';
   sErrWrongItemType = 'Items in list are not from TFPgtkMenuItem class.';
 
diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp
index 544e52b415..1938f2aa45 100644
--- a/packages/fpmkunit/src/fpmkunit.pp
+++ b/packages/fpmkunit/src/fpmkunit.pp
@@ -51,6 +51,10 @@ Interface
  {$DEFINE NO_THREADING}
 {$ENDIF GO32V2}
 
+{$IFDEF NDS}
+ {$DEFINE NO_THREADING}
+{$ENDIF NDS}
+
 {$IFDEF NETBSD}
  { NetBSD pthreads are not yet working, try to use fpmake without threads }
   {$DEFINE NO_THREADING}
@@ -2798,11 +2802,19 @@ procedure TCompileWorkerThread.execute;
 begin
   while not Terminated do
     begin
+    { Make sure all of our results are committed before we set (F)Done to true.
+      While RTLeventSetEvent implies a barrier, once the main thread is notified
+      it will walk over all threads and look for those that have Done=true -> it
+      can look at a thread between that thread setting FDone to true and it
+      calling RTLEventSetEvent }
+    WriteBarrier;
     FDone:=true;
     RTLeventSetEvent(FNotifyMainThreadEvent);
     RTLeventWaitFor(FNotifyStartTask,500);
     if not FDone then
       begin
+      { synchronise with WriteBarrier in mainthread for same reason as above }
+      ReadBarrier;
       FBuildEngine.log(vlInfo,'Compiling: '+APackage.Name);
       FCompilationOK:=false;
       try
@@ -7418,12 +7430,14 @@ Var
   begin
     if AThread.Done then
       begin
+        { synchronise with the WriteBarrier in the thread }
+        ReadBarrier;
         if assigned(AThread.APackage) then
           begin
             // The thread has completed compiling the package
             if AThread.CompilationOK then
               AThread.APackage.FTargetState:=tsCompiled
-            else // A problem occured, stop the compilation
+            else // A problem occurred, stop the compilation
               begin
               ErrorState:=true;
               ErrorMessage:=AThread.ErrorMessage;
@@ -7449,6 +7463,11 @@ Var
           // Instruct thread to compile package
           AThread.APackage := CompilePackage;
           AThread.APackage.FProcessing := true;
+          { Commit changes before setting FDone to false, because the threads
+            only wait for an event 500ms at a time and hence way wake up
+            and see that FDone=false before the event is sent and the changes
+            are all committed by the event code }
+          WriteBarrier;
           AThread.FDone:=False;
           RTLeventSetEvent(AThread.NotifyStartTask);
           end;
diff --git a/packages/fppkg/fpmake.pp b/packages/fppkg/fpmake.pp
index f9267581d0..bfa1d87f37 100644
--- a/packages/fppkg/fpmake.pp
+++ b/packages/fppkg/fpmake.pp
@@ -45,6 +45,8 @@ begin
     P.Description := 'Libraries to create fppkg package managers.';
     P.NeedLibC:= false;
     P.OSes := P.OSes - [embedded,nativent,msdos];
+    if Defaults.CPU = powerpc then
+      P.OSes := P.OSes - [amiga];
 
     P.SourcePath.Add('src');
     P.IncludePath.Add('src');
diff --git a/packages/fppkg/src/pkgdownload.pp b/packages/fppkg/src/pkgdownload.pp
index 90634c0de2..321256d434 100644
--- a/packages/fppkg/src/pkgdownload.pp
+++ b/packages/fppkg/src/pkgdownload.pp
@@ -148,7 +148,7 @@ begin
   P:=URI.Protocol;
   If CompareText(P,'ftp')=0 then
     FTPDownload(URL,Dest)
-  else if CompareText(P,'http')=0 then
+  else if (CompareText(P,'http')=0) or (CompareText(P,'https')=0) then
     HTTPDownload(URL,Dest)
   else if CompareText(P,'file')=0 then
     FileDownload(URL,Dest)
diff --git a/packages/fv/examples/testapp.lpi b/packages/fv/examples/testapp.lpi
index db391bbc2a..2b5b3736e7 100644
--- a/packages/fv/examples/testapp.lpi
+++ b/packages/fv/examples/testapp.lpi
@@ -45,6 +45,7 @@
     <Version Value="5"/>
     <PathDelim Value="\"/>
     <SearchPaths>
+      <IncludeFiles Value="..\src"/>
       <OtherUnitFiles Value="..\"/>
     </SearchPaths>
     <CodeGeneration>
diff --git a/packages/fv/fpmake.pp b/packages/fv/fpmake.pp
index 14b77684a2..9e347a192e 100644
--- a/packages/fv/fpmake.pp
+++ b/packages/fv/fpmake.pp
@@ -21,6 +21,8 @@ begin
     P.License := 'LGPL with modification, ';
     P.HomepageURL := 'www.freepascal.org';
     P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,os2,emx,netware,netwlibc,go32v2,aix,dragonfly]+AllAmigaLikeOSes;
+    if Defaults.CPU = powerpc then
+      P.OSes := P.OSes - [amiga];
     P.Email := '';
     P.Description := 'Free Vision, a portable Turbo Vision clone.';
     P.NeedLibC:= false;
diff --git a/packages/fv/src/w32smsg.inc b/packages/fv/src/w32smsg.inc
index 8c2fbd1894..877b83f77b 100644
--- a/packages/fv/src/w32smsg.inc
+++ b/packages/fv/src/w32smsg.inc
@@ -145,7 +145,7 @@ begin
   EnterCriticalSection(ChangeSystemEvents);
   SystemEvent:=PendingSystemHead^;
   inc(PendingSystemHead);
-  if longint(PendingSystemHead)=longint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
+  if ptrint(PendingSystemHead)=ptrint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
    PendingSystemHead:=@PendingSystemEvent;
   dec(PendingSystemEvents);
   LastSystemEvent:=SystemEvent;
diff --git a/packages/googleapi/fpmake.pp b/packages/googleapi/fpmake.pp
index 26b403a718..e27fef2c32 100644
--- a/packages/googleapi/fpmake.pp
+++ b/packages/googleapi/fpmake.pp
@@ -31,6 +31,8 @@ begin
     P.Description := 'Google API client libraries.';
     P.NeedLibC:= false;
     P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros,dragonfly];
+    if Defaults.CPU = powerpc then
+      P.OSes := P.OSes - [amiga];
     P.Directory:=ADirectory;
     P.Version:='3.1.1';
     P.Dependencies.Add('fcl-base');
diff --git a/packages/googleapi/src/googlebase.pp b/packages/googleapi/src/googlebase.pp
index a8e2415eb0..c5e121b03e 100644
--- a/packages/googleapi/src/googlebase.pp
+++ b/packages/googleapi/src/googlebase.pp
@@ -25,7 +25,7 @@
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 unit googlebase;
diff --git a/packages/googleapi/src/googlediscoverytopas.pp b/packages/googleapi/src/googlediscoverytopas.pp
index 3e1a2bf6bc..6f12dc4b73 100644
--- a/packages/googleapi/src/googlediscoverytopas.pp
+++ b/packages/googleapi/src/googlediscoverytopas.pp
@@ -25,7 +25,7 @@
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 unit googlediscoverytopas;
diff --git a/packages/graph/src/inc/gtext.inc b/packages/graph/src/inc/gtext.inc
index 7e3f46cbfc..cf0af80196 100644
--- a/packages/graph/src/inc/gtext.inc
+++ b/packages/graph/src/inc/gtext.inc
@@ -492,7 +492,7 @@ end;
                                   PutPixel(xpos+k,j+y,CurrentColor)
                                 else if DrawTextBackground then
                                   PutPixel(xpos+k,j+y,CurrentBkColor);
-                                fontbitmapbyte:=fontbitmapbyte shl 1;
+                                fontbitmapbyte:=byte(fontbitmapbyte shl 1);
                               end;
                           end;
                       end
@@ -521,7 +521,7 @@ end;
                                     end;
                                   Inc(k);
                                   Inc(cnt2,charsize);
-                                  fontbitmapbyte:=fontbitmapbyte shl 1;
+                                  fontbitmapbyte:=byte(fontbitmapbyte shl 1);
                                 end;
                            end;
                           Inc(j);
@@ -552,7 +552,7 @@ end;
                              PutPixel(xpos+j,ypos-k,CurrentColor)
                            else if DrawTextBackground then
                              PutPixel(xpos+j,ypos-k,CurrentBkColor);
-                           fontbitmapbyte:=fontbitmapbyte shl 1;
+                           fontbitmapbyte:=byte(fontbitmapbyte shl 1);
                          end;
                      end;
                  end
@@ -581,7 +581,7 @@ end;
                                end;
                              Inc(k);
                              Inc(cnt2,charsize);
-                             fontbitmapbyte:=fontbitmapbyte shl 1;
+                             fontbitmapbyte:=byte(fontbitmapbyte shl 1);
                            end;
                       end;
                      Inc(j);
diff --git a/packages/graph/src/ptcgraph/ptccrt.pp b/packages/graph/src/ptcgraph/ptccrt.pp
index cae870aea5..f579a88073 100644
--- a/packages/graph/src/ptcgraph/ptccrt.pp
+++ b/packages/graph/src/ptcgraph/ptccrt.pp
@@ -1,6 +1,6 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 2010, 2011, 2013 by Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (c) 2010, 2011, 2013, 2017 by Nikolay Nikolov (nickysn@users.sourceforge.net)
 
     This file implements keyboard input support for ptcgraph
 
@@ -35,10 +35,12 @@ type
 {$ELSE HasCRT}
   tcrtcoord = 1..255;
 {$ENDIF HasCRT}
+  tkeymode = (kmTP7, kmGO32, kmFPWINCRT);
 
 var
   DirectVideo: Boolean {$IFDEF HasCRT}absolute crt.DirectVideo{$ENDIF HasCRT};
   TextAttr: Byte {$IFDEF HasCRT}absolute crt.TextAttr{$ENDIF HasCRT};
+  KeyMode: TKeyMode = kmTP7;
 
 function KeyPressed: Boolean;
 function ReadKey: Char;
@@ -132,6 +134,9 @@ begin
               if KeyEv.Alt then
               begin
                 case KeyEv.Code of
+                  PTCKEY_ESCAPE:
+                    if KeyMode = kmGO32 then
+                      KeyBufAdd(#0#1);
                   PTCKEY_F1:     KeyBufAdd(#0#104);
                   PTCKEY_F2:     KeyBufAdd(#0#105);
                   PTCKEY_F3:     KeyBufAdd(#0#106);
@@ -142,6 +147,12 @@ begin
                   PTCKEY_F8:     KeyBufAdd(#0#111);
                   PTCKEY_F9:     KeyBufAdd(#0#112);
                   PTCKEY_F10:    KeyBufAdd(#0#113);
+                  PTCKEY_F11:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#139);
+                  PTCKEY_F12:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#140);
                   PTCKEY_ONE:    KeyBufAdd(#0#120);
                   PTCKEY_TWO:    KeyBufAdd(#0#121);
                   PTCKEY_THREE:  KeyBufAdd(#0#122);
@@ -180,6 +191,89 @@ begin
                   PTCKEY_B:      KeyBufAdd(#0#48);
                   PTCKEY_N:      KeyBufAdd(#0#49);
                   PTCKEY_M:      KeyBufAdd(#0#50);
+                  PTCKEY_BACKQUOTE:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#41);
+                  PTCKEY_BACKSPACE:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#14);
+                  PTCKEY_TAB:
+                    if KeyMode = kmGO32 then
+                      KeyBufAdd(#0#165);
+                  PTCKEY_OPENBRACKET:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#26);
+                  PTCKEY_CLOSEBRACKET:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#27);
+                  PTCKEY_BACKSLASH:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#43);
+                  PTCKEY_SEMICOLON:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#39);
+                  PTCKEY_QUOTE:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#40);
+                  PTCKEY_ENTER:
+                    if KeyMode = kmGO32 then
+                      if pmkNumPadKey in KeyEv.ModifierKeys then
+                        KeyBufAdd(#0#166)
+                      else
+                        KeyBufAdd(#0#28);
+                  PTCKEY_COMMA:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#51);
+                  PTCKEY_PERIOD:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#52);
+                  PTCKEY_SLASH:
+                    if KeyMode = kmFPWINCRT then
+                      KeyBufAdd(#0#164)
+                    else if KeyMode = kmGO32 then
+                      KeyBufAdd(#0#53);
+                  PTCKEY_INSERT:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#162);
+                  PTCKEY_DELETE:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#163);
+                  PTCKEY_HOME:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#151);
+                  PTCKEY_END:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#159);
+                  PTCKEY_PAGEUP:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#153);
+                  PTCKEY_PAGEDOWN:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#161);
+                  PTCKEY_UP:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#152);
+                  PTCKEY_LEFT:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#155);
+                  PTCKEY_RIGHT:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#157);
+                  PTCKEY_DOWN:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#160);
+                  PTCKEY_DIVIDE:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#164);
+                  PTCKEY_MULTIPLY:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#55);
+                  PTCKEY_SUBTRACT:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#74);
+                  PTCKEY_ADD:
+                    if KeyMode in [kmGO32, kmFPWINCRT] then
+                      KeyBufAdd(#0#78);
                 end;
               end
               else
@@ -197,7 +291,50 @@ begin
                     PTCKEY_F8:            KeyBufAdd(#0#101);
                     PTCKEY_F9:            KeyBufAdd(#0#102);
                     PTCKEY_F10:           KeyBufAdd(#0#103);
+                    PTCKEY_F11:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#137);
+                    PTCKEY_F12:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#138);
+                    PTCKEY_ONE:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#2);
                     PTCKEY_TWO:           KeyBufAdd(#0#3);
+                    PTCKEY_THREE:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#4);
+                    PTCKEY_FOUR:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#5);
+                    PTCKEY_FIVE:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#6);
+                    PTCKEY_SIX:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#7)
+                      else
+                        KeyBufAdd(#30);
+                    PTCKEY_SEVEN:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#8);
+                    PTCKEY_EIGHT:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#9);
+                    PTCKEY_NINE:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#10);
+                    PTCKEY_ZERO:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#11);
+                    PTCKEY_MINUS:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#12)
+                      else
+                        KeyBufAdd(#31);
+                    PTCKEY_EQUALS:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#13);
                     PTCKEY_BACKSPACE:     KeyBufAdd(#127);
                     PTCKEY_A:             KeyBufAdd(#1);
                     PTCKEY_B:             KeyBufAdd(#2);
@@ -228,8 +365,6 @@ begin
                     PTCKEY_OPENBRACKET:   KeyBufAdd(#27);
                     PTCKEY_BACKSLASH:     KeyBufAdd(#28);
                     PTCKEY_CLOSEBRACKET:  KeyBufAdd(#29);
-                    PTCKEY_SIX:           KeyBufAdd(#30);
-                    PTCKEY_MINUS:         KeyBufAdd(#31);
                     PTCKEY_ENTER:         KeyBufAdd(#10);
                     PTCKEY_LEFT:          KeyBufAdd(#0#115);
                     PTCKEY_RIGHT:         KeyBufAdd(#0#116);
@@ -237,6 +372,57 @@ begin
                     PTCKEY_END:           KeyBufAdd(#0#117);
                     PTCKEY_PAGEUP:        KeyBufAdd(#0#132);
                     PTCKEY_PAGEDOWN:      KeyBufAdd(#0#118);
+                    PTCKEY_BACKQUOTE:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#41);
+                    PTCKEY_TAB:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#148);
+                    PTCKEY_SEMICOLON:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#39);
+                    PTCKEY_QUOTE:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#40);
+                    PTCKEY_COMMA:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#51);
+                    PTCKEY_PERIOD:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#52);
+                    PTCKEY_SLASH:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#149);
+                    PTCKEY_INSERT:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#146);
+                    PTCKEY_DELETE:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#147);
+                    PTCKEY_UP:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#141);
+                    PTCKEY_DOWN:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#145);
+                    PTCKEY_DIVIDE:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#149);
+                    PTCKEY_MULTIPLY:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#150);
+                    PTCKEY_SUBTRACT:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#142);
+                    PTCKEY_ADD:
+                      if KeyMode = kmFPWINCRT then
+                        KeyBufAdd(#0#78)
+                      else if KeyMode = kmGO32 then
+                        KeyBufAdd(#0#144);
+                    PTCKEY_CLEAR,
+                    PTCKEY_NUMPAD5:
+                      if KeyMode in [kmGO32, kmFPWINCRT] then
+                        KeyBufAdd(#0#143);
                   end;
                 end
                 else
@@ -254,6 +440,12 @@ begin
                       PTCKEY_F8:        KeyBufAdd(#0#91);
                       PTCKEY_F9:        KeyBufAdd(#0#92);
                       PTCKEY_F10:       KeyBufAdd(#0#93);
+                      PTCKEY_F11:
+                        if KeyMode in [kmGO32, kmFPWINCRT] then
+                          KeyBufAdd(#0#135);
+                      PTCKEY_F12:
+                        if KeyMode in [kmGO32, kmFPWINCRT] then
+                          KeyBufAdd(#0#136);
                       PTCKEY_BACKSPACE: KeyBufAdd(#8);
                       PTCKEY_TAB:       KeyBufAdd(#0#15);
                       PTCKEY_ENTER:     KeyBufAdd(#13);
@@ -286,6 +478,12 @@ begin
                       PTCKEY_F8:        KeyBufAdd(#0#66);
                       PTCKEY_F9:        KeyBufAdd(#0#67);
                       PTCKEY_F10:       KeyBufAdd(#0#68);
+                      PTCKEY_F11:
+                        if KeyMode in [kmGO32, kmFPWINCRT] then
+                          KeyBufAdd(#0#133);
+                      PTCKEY_F12:
+                        if KeyMode in [kmGO32, kmFPWINCRT] then
+                          KeyBufAdd(#0#134);
                       PTCKEY_BACKSPACE: KeyBufAdd(#8);
                       PTCKEY_TAB:       KeyBufAdd(#9);
                       PTCKEY_ENTER:     KeyBufAdd(#13);
@@ -299,6 +497,9 @@ begin
                       PTCKEY_END:       KeyBufAdd(#0#79);
                       PTCKEY_PAGEUP:    KeyBufAdd(#0#73);
                       PTCKEY_PAGEDOWN:  KeyBufAdd(#0#81);
+                      PTCKEY_CLEAR:
+                        if KeyMode in [kmGO32, kmFPWINCRT] then
+                          KeyBufAdd(#0#76);
                       else
                         if (KeyEv.Unicode >= 32) and (KeyEv.Unicode <= 127) then
                           KeyBufAdd(Chr(KeyEv.Unicode));
diff --git a/packages/graph/src/ptcgraph/ptcgraph.pp b/packages/graph/src/ptcgraph/ptcgraph.pp
index 7b6d128cbd..fac60d5893 100644
--- a/packages/graph/src/ptcgraph/ptcgraph.pp
+++ b/packages/graph/src/ptcgraph/ptcgraph.pp
@@ -120,6 +120,7 @@ const
   FullscreenGraph: Boolean = False;
 
 var
+  WindowTitle: AnsiString;
   PTCWrapperObject: TPTCWrapperThread;
 
 {******************************************************************************}
@@ -128,6 +129,8 @@ var
 
 const
   InternalDriverName = 'PTCPas';
+  FirstNonStandardModeNumber = $200;
+  NonStandardModeNumberMaxLimit = $7FFF;
 
 var
   Has320x200: Boolean;
@@ -617,7 +620,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 16 colours');
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat8, Pages);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -642,7 +645,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 256 colours');
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat8, Pages);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -657,7 +660,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 4 colours, palette ' + strf(CGAPalette));
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, 1);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat8, 1);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -672,7 +675,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 2 colours');
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat8, Pages);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -687,7 +690,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 2 colours');
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat8, Pages);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat8, Pages);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -702,7 +705,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 32768 colours');
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat15, Pages);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat15, Pages);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -715,7 +718,7 @@ begin
   LogLn('Initializing mode ' + strf(XResolution) + ', ' + strf(YResolution) + ' 65536 colours');
 {$ENDIF logging}
   { open the console }
-  ptc_InternalOpen(ParamStr(0), XResolution, YResolution, PTCFormat16, Pages);
+  ptc_InternalOpen(WindowTitle, XResolution, YResolution, PTCFormat16, Pages);
   PTCWidth := XResolution;
   PTCHeight := YResolution;
   CurrentActivePage := 0;
@@ -869,6 +872,26 @@ begin
   ptc_InitMode64k(1280, 1024, 2);
 end;
 
+procedure ptc_InitNonStandard16;
+begin
+  ptc_InitMode16(MaxX + 1, MaxY + 1, 2);
+end;
+
+procedure ptc_InitNonStandard256;
+begin
+  ptc_InitMode256(MaxX + 1, MaxY + 1, 2);
+end;
+
+procedure ptc_InitNonStandard32k;
+begin
+  ptc_InitMode32k(MaxX + 1, MaxY + 1, 2);
+end;
+
+procedure ptc_InitNonStandard64k;
+begin
+  ptc_InitMode64k(MaxX + 1, MaxY + 1, 2);
+end;
+
 procedure ptc_SetVisualPage(page: word);
 begin
   if page > HardwarePages then
@@ -1409,8 +1432,64 @@ end;
       ContainsAtLeast := False;
     end;
 
+    function IsNonStandardResolution(AWidth, AHeight: Integer): Boolean;
+    begin
+      IsNonStandardResolution :=
+            not ((AWidth =  320) and (AHeight =  200))
+        and not ((AWidth =  640) and (AHeight =  200))
+        and not ((AWidth =  640) and (AHeight =  350))
+        and not ((AWidth =  640) and (AHeight =  400))
+        and not ((AWidth =  640) and (AHeight =  480))
+        and not ((AWidth =  720) and (AHeight =  348))
+        and not ((AWidth =  800) and (AHeight =  600))
+        and not ((AWidth = 1024) and (AHeight =  768))
+        and not ((AWidth = 1280) and (AHeight = 1024));
+    end;
+
+    function CompareModes(AMode1, AMode2: IPTCMode): Boolean;
+    begin
+      if AMode1.Width <> AMode2.Width then
+        CompareModes := AMode1.Width < AMode2.Width
+      else if AMode1.Height <> AMode2.Height then
+        CompareModes := AMode1.Height < AMode2.Height
+      else if AMode1.Format.Bits <> AMode2.Format.Bits then
+        CompareModes := AMode1.Format.Bits < AMode2.Format.Bits
+      else
+        CompareModes := PtrUInt(AMode1) < PtrUInt(AMode2);
+    end;
+
+    procedure SortModes(l,r: longint);
+      var
+         i,j: longint;
+         x,y: IPTCMode;
+      begin
+         i:=l;
+         j:=r;
+         x:=PTCModeList[(l+r) div 2];
+         repeat
+           while CompareModes(PTCModeList[i], x) do
+            inc(i);
+           while CompareModes(x, PTCModeList[j]) do
+            dec(j);
+           if not(i>j) then
+             begin
+                y:=PTCModeList[i];
+                PTCModeList[i]:=PTCModeList[j];
+                PTCModeList[j]:=y;
+                inc(i);
+                j:=j-1;
+             end;
+         until i>j;
+         if l<j then
+           SortModes(l,j);
+         if i<r then
+           SortModes(i,r);
+      end;
+
    var
     graphmode:Tmodeinfo;
+    I: Integer;
+    NextNonStandardModeNumber: SmallInt;
    begin
      QueryAdapterInfo := ModeList;
      { If the mode listing already exists... }
@@ -1419,7 +1498,8 @@ end;
      if assigned(ModeList) then
        exit;
 
-     PTCModeList := PTCWrapperObject.Modes;
+     PTCModeList := Copy(PTCWrapperObject.Modes);
+     SortModes(Low(PTCModeList), High(PTCModeList));
 
      Has320x200 := ContainsExactResolution(320, 200);
      Has320x240 := ContainsExactResolution(320, 240);
@@ -2567,9 +2647,147 @@ end;
        end;
        AddMode(graphmode);
      end;
+
+     { finally, add all the non-standard (i.e. not VESA or classic PC) modes }
+     NextNonStandardModeNumber := FirstNonStandardModeNumber;
+     for I := Low(PTCModeList) to High(PTCModeList) do
+       with PTCModeList[I] do
+         if IsNonStandardResolution(Width, Height) and
+            ((I = Low(PTCModeList)) or ((Width <> PTCModeList[I-1].Width) or (Height <> PTCModeList[I-1].Height))) then
+         begin
+           InitMode(graphmode);
+           with graphmode do
+           begin
+             ModeNumber := NextNonStandardModeNumber;
+             DriverNumber := VESA;
+             HardwarePages := 1;
+             WriteStr(ModeName, Width, ' x ', Height, ' VESA');
+             MaxColor := 16;
+             DirectColor := FALSE;
+             PaletteSize := MaxColor;
+             MaxX := Width - 1;
+             MaxY := Height - 1;
+             InitMode       := @ptc_InitNonStandard16;
+             DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+             PutPixel       := @ptc_PutPixelProc_8bpp;
+             GetPixel       := @ptc_GetPixelProc_8bpp;
+             SetRGBPalette  := @ptc_SetRGBPaletteProc;
+             GetRGBPalette  := @ptc_GetRGBPaletteProc;
+
+             HLine          := @ptc_HLineProc_8bpp;
+             VLine          := @ptc_VLineProc_8bpp;
+
+             SetVisualPage  := @ptc_SetVisualPage;
+             SetActivePage  := @ptc_SetActivePage;
+
+             XAspect := 10000;
+             YAspect := 10000;
+           end;
+           AddMode(graphmode);
+           Inc(NextNonStandardModeNumber);
+           if NextNonStandardModeNumber > NonStandardModeNumberMaxLimit then
+             break;
+
+           InitMode(graphmode);
+           with graphmode do
+           begin
+             ModeNumber := NextNonStandardModeNumber;
+             DriverNumber := VESA;
+             HardwarePages := 1;
+             WriteStr(ModeName, Width, ' x ', Height, ' VESA');
+             MaxColor := 256;
+             DirectColor := FALSE;
+             PaletteSize := MaxColor;
+             MaxX := Width - 1;
+             MaxY := Height - 1;
+             InitMode       := @ptc_InitNonStandard256;
+             DirectPutPixel := @ptc_DirectPixelProc_8bpp;
+             PutPixel       := @ptc_PutPixelProc_8bpp;
+             GetPixel       := @ptc_GetPixelProc_8bpp;
+             SetRGBPalette  := @ptc_SetRGBPaletteProc;
+             GetRGBPalette  := @ptc_GetRGBPaletteProc;
+             //SetAllPalette  := @ptc_SetRGBAllPaletteProc;
+
+             HLine          := @ptc_HLineProc_8bpp;
+             VLine          := @ptc_VLineProc_8bpp;
+
+             SetVisualPage  := @ptc_SetVisualPage;
+             SetActivePage  := @ptc_SetActivePage;
+
+             XAspect := 10000;
+             YAspect := 10000;
+           end;
+           AddMode(graphmode);
+           Inc(NextNonStandardModeNumber);
+           if NextNonStandardModeNumber > NonStandardModeNumberMaxLimit then
+             break;
+
+           InitMode(graphmode);
+           with graphmode do
+           begin
+             ModeNumber := NextNonStandardModeNumber;
+             DriverNumber := VESA;
+             HardwarePages := 1;
+             WriteStr(ModeName, Width, ' x ', Height, ' VESA');
+             MaxColor := 32768;
+             DirectColor := TRUE;
+             PaletteSize := MaxColor;
+             MaxX := Width - 1;
+             MaxY := Height - 1;
+             InitMode       := @ptc_InitNonStandard32k;
+             DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+             PutPixel       := @ptc_PutPixelProc_16bpp;
+             GetPixel       := @ptc_GetPixelProc_16bpp;
+             SetRGBPalette  := @ptc_SetRGBPaletteProc;
+             GetRGBPalette  := @ptc_GetRGBPaletteProc;
+             HLine          := @ptc_HLineProc_16bpp;
+             VLine          := @ptc_VLineProc_16bpp;
+             SetVisualPage  := @ptc_SetVisualPage;
+             SetActivePage  := @ptc_SetActivePage;
+
+             XAspect := 10000;
+             YAspect := 10000;
+           end;
+           AddMode(graphmode);
+           Inc(NextNonStandardModeNumber);
+           if NextNonStandardModeNumber > NonStandardModeNumberMaxLimit then
+             break;
+
+           InitMode(graphmode);
+           with graphmode do
+           begin
+             ModeNumber := NextNonStandardModeNumber;
+             DriverNumber := VESA;
+             HardwarePages := 1;
+             WriteStr(ModeName, Width, ' x ', Height, ' VESA');
+             MaxColor := 65536;
+             DirectColor := TRUE;
+             PaletteSize := MaxColor;
+             MaxX := Width - 1;
+             MaxY := Height - 1;
+             InitMode       := @ptc_InitNonStandard64k;
+             DirectPutPixel := @ptc_DirectPixelProc_16bpp;
+             PutPixel       := @ptc_PutPixelProc_16bpp;
+             GetPixel       := @ptc_GetPixelProc_16bpp;
+             SetRGBPalette  := @ptc_SetRGBPaletteProc;
+             GetRGBPalette  := @ptc_GetRGBPaletteProc;
+             HLine          := @ptc_HLineProc_16bpp;
+             VLine          := @ptc_VLineProc_16bpp;
+             SetVisualPage  := @ptc_SetVisualPage;
+             SetActivePage  := @ptc_SetActivePage;
+
+             XAspect := 10000;
+             YAspect := 10000;
+           end;
+           AddMode(graphmode);
+           Inc(NextNonStandardModeNumber);
+           if NextNonStandardModeNumber > NonStandardModeNumberMaxLimit then
+             break;
+         end;
   end;
 
 initialization
+  WindowTitle := ParamStr(0);
   PTCFormat8 := TPTCFormatFactory.CreateNew(8);
   PTCFormat15 := TPTCFormatFactory.CreateNew(16, $7C00, $03E0, $001F);
   PTCFormat16 := TPTCFormatFactory.CreateNew(16, $F800, $07E0, $001F);
diff --git a/packages/gtk2/src/glib/gparamspecs.inc b/packages/gtk2/src/glib/gparamspecs.inc
index 928cc82862..89b05c253b 100644
--- a/packages/gtk2/src/glib/gparamspecs.inc
+++ b/packages/gtk2/src/glib/gparamspecs.inc
@@ -24,8 +24,8 @@ Type
 
    You should have received a copy of the GNU Lesser General
    Public License along with this library; if not, write to the
-   Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-   Boston, MA 02111-1307, USA.
+   Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.
 
    gparamspecs.h: GLib default param specs
   }
diff --git a/packages/gtk2/src/gtk+/gdk/gdki18n.inc b/packages/gtk2/src/gtk+/gdk/gdki18n.inc
index 3a2b2a2f72..9f9ccb2ca9 100644
--- a/packages/gtk2/src/gtk+/gdk/gdki18n.inc
+++ b/packages/gtk2/src/gtk+/gdk/gdki18n.inc
@@ -24,8 +24,8 @@ Type
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the
-   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-   Boston, MA 02111-1307, USA.
+   Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.
   }
 {
    Modified by the GTK+ Team and others 1997-2000.  See the AUTHORS
diff --git a/packages/gtk2/src/gtk+/gdk/gdkprivate.inc b/packages/gtk2/src/gtk+/gdk/gdkprivate.inc
index 4e08e88fc1..aad750e107 100644
--- a/packages/gtk2/src/gtk+/gdk/gdkprivate.inc
+++ b/packages/gtk2/src/gtk+/gdk/gdkprivate.inc
@@ -24,8 +24,8 @@ Type
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the
-   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-   Boston, MA 02111-1307, USA.
+   Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.
   }
 {
    Modified by the GTK+ Team and others 1997-2000.  See the AUTHORS
diff --git a/packages/gtk2/src/gtk+/gtk/gtkhsv.inc b/packages/gtk2/src/gtk+/gtk/gtkhsv.inc
index 0c79c38f26..4b7e2e98b5 100644
--- a/packages/gtk2/src/gtk+/gtk/gtkhsv.inc
+++ b/packages/gtk2/src/gtk+/gtk/gtkhsv.inc
@@ -29,8 +29,8 @@ Type
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the
-   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-   Boston, MA 02111-1307, USA.
+   Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.
   }
 {$ifndef __GTK_HSV_H__}
 {$define __GTK_HSV_H__}
diff --git a/packages/gtk2/src/gtk+/gtk/gtkicontheme.inc b/packages/gtk2/src/gtk+/gtk/gtkicontheme.inc
index fb06242436..202112386e 100644
--- a/packages/gtk2/src/gtk+/gtk/gtkicontheme.inc
+++ b/packages/gtk2/src/gtk+/gtk/gtkicontheme.inc
@@ -32,6 +32,12 @@ type
      gtk_icon_theme_lookup_icon() includes builtin icons
      as well as files. For a builtin icon, gdk_icon_info_get_filename()
      returns %NULL and you need to call gdk_icon_info_get_builtin_pixbuf().
+   @GTK_ICON_LOOKUP_GENERIC_FALLBACK
+     Try to shorten icon name at '-' characters before looking at inherited
+     themes. For more general fallback, seegtk_icon_theme_choose_icon().
+     Since 2.12.
+	 @GTK_ICON_LOOKUP_FORCE_SIZE
+	   Always return the icon scaled to the requested size. Since 2.14.
 
    Used to specify options for gtk_icon_theme_lookup_icon()
    }
@@ -39,7 +45,10 @@ type
    PGtkIconLookupFlags = ^TGtkIconLookupFlags;
    TGtkIconLookupFlags = (GTK_ICON_LOOKUP_NO_SVG := 1 shl 0,
                           GTK_ICON_LOOKUP_FORCE_SVG := 1 shl 1,
-                          GTK_ICON_LOOKUP_USE_BUILTIN := 1 shl 2);
+                          GTK_ICON_LOOKUP_USE_BUILTIN := 1 shl 2,
+                          GTK_ICON_LOOKUP_GENERIC_FALLBACK := 1 shl 3,
+                          GTK_ICON_LOOKUP_FORCE_SIZE := 1 shl 4
+                          );
 
 {
    GtkIconThemeError:
diff --git a/packages/gtk2/src/gtk+/gtk/gtkkeyhash.inc b/packages/gtk2/src/gtk+/gtk/gtkkeyhash.inc
index 0fb4fe559a..f03367498f 100644
--- a/packages/gtk2/src/gtk+/gtk/gtkkeyhash.inc
+++ b/packages/gtk2/src/gtk+/gtk/gtkkeyhash.inc
@@ -26,8 +26,8 @@ Type
 
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the
-   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-   Boston, MA 02111-1307, USA.
+   Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.
   }
 {$ifndef __GTK_KEY_HASH_H__}
 {$define __GTK_KEY_HASH_H__}
diff --git a/packages/gtk2/src/gtkext/gtkstatusiconh.inc b/packages/gtk2/src/gtkext/gtkstatusiconh.inc
index c546917bc1..1ebcf8bdd3 100644
--- a/packages/gtk2/src/gtkext/gtkstatusiconh.inc
+++ b/packages/gtk2/src/gtkext/gtkstatusiconh.inc
@@ -15,8 +15,8 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the
- * Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- * Boston, MA 02111-1307, USA.
+ * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
  *
  * Authors:
  *      Mark McLoughlin <mark@skynet.ie>
diff --git a/packages/hash/src/md5.pp b/packages/hash/src/md5.pp
index 3bba93add1..1a7b4156d2 100644
--- a/packages/hash/src/md5.pp
+++ b/packages/hash/src/md5.pp
@@ -15,6 +15,33 @@
 
  **********************************************************************}
 
+
+{
+
+Original implementor copyright:
+
+Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
+rights reserved.
+
+License to copy and use this software is granted provided that it
+is identified as the "RSA Data Security, Inc. MD5 Message-Digest
+Algorithm" in all material mentioning or referencing this software
+or this function.
+
+License is also granted to make and use derivative works provided
+that such works are identified as "derived from the RSA Data
+Security, Inc. MD5 Message-Digest Algorithm" in all material
+mentioning or referencing the derived work.
+
+RSA Data Security, Inc. makes no representations concerning either
+the merchantability of this software or the suitability of this
+software for any particular purpose. It is provided "as is"
+without express or implied warranty of any kind.
+
+These notices must be retained in any copies of any part of this
+documentation and/or software.
+}
+
 // Define to use original MD5 code on i386 processors.
 // Undefine to use original implementation.
 { the assembler implementation does not work on Darwin }
diff --git a/packages/hermes/src/d_32.inc b/packages/hermes/src/d_32.inc
index 47ba90e338..0af06bf6f7 100644
--- a/packages/hermes/src/d_32.inc
+++ b/packages/hermes/src/d_32.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/factconv.inc b/packages/hermes/src/factconv.inc
index 74d7cbf741..757ec3892e 100644
--- a/packages/hermes/src/factconv.inc
+++ b/packages/hermes/src/factconv.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/headp.inc b/packages/hermes/src/headp.inc
index c13a619e33..1cd2c6969d 100644
--- a/packages/hermes/src/headp.inc
+++ b/packages/hermes/src/headp.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { This little definition makes everything much nicer below here }
diff --git a/packages/hermes/src/hermconf.inc b/packages/hermes/src/hermconf.inc
index a908434f0c..9a2c56fcbc 100644
--- a/packages/hermes/src/hermconf.inc
+++ b/packages/hermes/src/hermconf.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/hermdef.inc b/packages/hermes/src/hermdef.inc
index dfc326f874..fd55ff1933 100644
--- a/packages/hermes/src/hermdef.inc
+++ b/packages/hermes/src/hermdef.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/hermes.pp b/packages/hermes/src/hermes.pp
index 70eb1ab657..ebd21f04d6 100644
--- a/packages/hermes/src/hermes.pp
+++ b/packages/hermes/src/hermes.pp
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 unit Hermes;
diff --git a/packages/hermes/src/hermes_clearer.inc b/packages/hermes/src/hermes_clearer.inc
index f5343e74f8..4ec349c48f 100644
--- a/packages/hermes/src/hermes_clearer.inc
+++ b/packages/hermes/src/hermes_clearer.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/hermes/src/hermes_converter.inc b/packages/hermes/src/hermes_converter.inc
index 65986dede0..13174a9742 100644
--- a/packages/hermes/src/hermes_converter.inc
+++ b/packages/hermes/src/hermes_converter.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function Hermes_ConverterInstance(flags: DWord): THermesConverterHandle;
diff --git a/packages/hermes/src/hermes_debug.inc b/packages/hermes/src/hermes_debug.inc
index 536b474e8d..276f14e512 100644
--- a/packages/hermes/src/hermes_debug.inc
+++ b/packages/hermes/src/hermes_debug.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function C2Str(Q: Integer): string;
diff --git a/packages/hermes/src/hermes_dither.inc b/packages/hermes/src/hermes_dither.inc
index 0d74bb68ab..3bed85dfc1 100644
--- a/packages/hermes/src/hermes_dither.inc
+++ b/packages/hermes/src/hermes_dither.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { Everything in here (C)1998 The Rasterman }
diff --git a/packages/hermes/src/hermes_factory.inc b/packages/hermes/src/hermes_factory.inc
index 09afe3777e..af17bf187a 100644
--- a/packages/hermes/src/hermes_factory.inc
+++ b/packages/hermes/src/hermes_factory.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 var
diff --git a/packages/hermes/src/hermes_format.inc b/packages/hermes/src/hermes_format.inc
index 132ed454fb..f09b490d53 100644
--- a/packages/hermes/src/hermes_format.inc
+++ b/packages/hermes/src/hermes_format.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {function Hermes_FormatNewEmpty: PHermesFormat;
diff --git a/packages/hermes/src/hermes_list.inc b/packages/hermes/src/hermes_list.inc
index 3eda205b27..8d7d972f76 100644
--- a/packages/hermes/src/hermes_list.inc
+++ b/packages/hermes/src/hermes_list.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/hermes/src/hermes_palette.inc b/packages/hermes/src/hermes_palette.inc
index 706f90b8ad..a2c7be4f6c 100644
--- a/packages/hermes/src/hermes_palette.inc
+++ b/packages/hermes/src/hermes_palette.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/hermes/src/hermes_utility.inc b/packages/hermes/src/hermes_utility.inc
index 0f1ac59fcb..ea96d5d68f 100644
--- a/packages/hermes/src/hermes_utility.inc
+++ b/packages/hermes/src/hermes_utility.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {procedure Hermes_Calculate_Generic_Info(s_r, s_g, s_b, s_a,
diff --git a/packages/hermes/src/i386/headi386.inc b/packages/hermes/src/i386/headi386.inc
index 318348fe48..2d820e1a27 100644
--- a/packages/hermes/src/i386/headi386.inc
+++ b/packages/hermes/src/i386/headi386.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$I x8616lut.inc}
diff --git a/packages/hermes/src/i386/headmmx.inc b/packages/hermes/src/i386/headmmx.inc
index 83651a8c50..61a206a916 100644
--- a/packages/hermes/src/i386/headmmx.inc
+++ b/packages/hermes/src/i386/headmmx.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$I mmx_main.inc}
diff --git a/packages/hermes/src/i386/mmx_clr.inc b/packages/hermes/src/i386/mmx_clr.inc
index a8a21c8536..5ee14d74fa 100644
--- a/packages/hermes/src/i386/mmx_clr.inc
+++ b/packages/hermes/src/i386/mmx_clr.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$ASMMODE att}
diff --git a/packages/hermes/src/i386/mmx_main.inc b/packages/hermes/src/i386/mmx_main.inc
index a0e9b33fa1..6e9c05d290 100644
--- a/packages/hermes/src/i386/mmx_main.inc
+++ b/packages/hermes/src/i386/mmx_main.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 label
diff --git a/packages/hermes/src/i386/mmxp2_32.inc b/packages/hermes/src/i386/mmxp2_32.inc
index 486fd9643e..01418233f3 100644
--- a/packages/hermes/src/i386/mmxp2_32.inc
+++ b/packages/hermes/src/i386/mmxp2_32.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
     COPYRIGHT NOTICE
 
diff --git a/packages/hermes/src/i386/mmxp_32.inc b/packages/hermes/src/i386/mmxp_32.inc
index e34e0aff6e..438fe69e3f 100644
--- a/packages/hermes/src/i386/mmxp_32.inc
+++ b/packages/hermes/src/i386/mmxp_32.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
     COPYRIGHT NOTICE
 
diff --git a/packages/hermes/src/i386/x8616lut.inc b/packages/hermes/src/i386/x8616lut.inc
index 2426ec928a..c090502693 100644
--- a/packages/hermes/src/i386/x8616lut.inc
+++ b/packages/hermes/src/i386/x8616lut.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 const
diff --git a/packages/hermes/src/i386/x86_clr.inc b/packages/hermes/src/i386/x86_clr.inc
index 48c8743264..5dc03a0cdf 100644
--- a/packages/hermes/src/i386/x86_clr.inc
+++ b/packages/hermes/src/i386/x86_clr.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
     (04/10/99)    Modified ClearX86_8             <Mikko.Tiihonen@hut.fi>
 }
diff --git a/packages/hermes/src/i386/x86_main.inc b/packages/hermes/src/i386/x86_main.inc
index d68ea88bac..b7ba62ec52 100644
--- a/packages/hermes/src/i386/x86_main.inc
+++ b/packages/hermes/src/i386/x86_main.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 label
diff --git a/packages/hermes/src/i386/x86p_16.inc b/packages/hermes/src/i386/x86p_16.inc
index ebc977fe7c..9341ba2f42 100644
--- a/packages/hermes/src/i386/x86p_16.inc
+++ b/packages/hermes/src/i386/x86p_16.inc
@@ -28,7 +28,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/i386/x86p_32.inc b/packages/hermes/src/i386/x86p_32.inc
index 5249ae5e12..93691e251a 100644
--- a/packages/hermes/src/i386/x86p_32.inc
+++ b/packages/hermes/src/i386/x86p_32.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/i386/x86p_cpy.inc b/packages/hermes/src/i386/x86p_cpy.inc
index a9b2afee40..9495790ccb 100644
--- a/packages/hermes/src/i386/x86p_cpy.inc
+++ b/packages/hermes/src/i386/x86p_cpy.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/i386/x86p_i8.inc b/packages/hermes/src/i386/x86p_i8.inc
index d507757dcf..9385cbaafb 100644
--- a/packages/hermes/src/i386/x86p_i8.inc
+++ b/packages/hermes/src/i386/x86p_i8.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/i386/x86p_s32.inc b/packages/hermes/src/i386/x86p_s32.inc
index 33cf2fcc09..72f68a91f3 100644
--- a/packages/hermes/src/i386/x86p_s32.inc
+++ b/packages/hermes/src/i386/x86p_s32.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/hermes/src/i386/x86pscpy.inc b/packages/hermes/src/i386/x86pscpy.inc
index bb770a3ddd..719798740e 100644
--- a/packages/hermes/src/i386/x86pscpy.inc
+++ b/packages/hermes/src/i386/x86pscpy.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { _Copy*
diff --git a/packages/hermes/src/p_16.inc b/packages/hermes/src/p_16.inc
index a0ed189faf..6b04216156 100644
--- a/packages/hermes/src/p_16.inc
+++ b/packages/hermes/src/p_16.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_24.inc b/packages/hermes/src/p_24.inc
index cd6050cd18..26924caa55 100644
--- a/packages/hermes/src/p_24.inc
+++ b/packages/hermes/src/p_24.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_32.inc b/packages/hermes/src/p_32.inc
index 57a116f911..4cc8cfa9f7 100644
--- a/packages/hermes/src/p_32.inc
+++ b/packages/hermes/src/p_32.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_clr.inc b/packages/hermes/src/p_clr.inc
index 41480b22c8..130b639cec 100644
--- a/packages/hermes/src/p_clr.inc
+++ b/packages/hermes/src/p_clr.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_cnv.inc b/packages/hermes/src/p_cnv.inc
index 13e11dd9f8..121b5fd34e 100644
--- a/packages/hermes/src/p_cnv.inc
+++ b/packages/hermes/src/p_cnv.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_cpy.inc b/packages/hermes/src/p_cpy.inc
index db8cd62a9c..50807f079f 100644
--- a/packages/hermes/src/p_cpy.inc
+++ b/packages/hermes/src/p_cpy.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_g.inc b/packages/hermes/src/p_g.inc
index d15dac645f..9cda91d77a 100644
--- a/packages/hermes/src/p_g.inc
+++ b/packages/hermes/src/p_g.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_ga.inc b/packages/hermes/src/p_ga.inc
index f414b080d6..a8affb23ed 100644
--- a/packages/hermes/src/p_ga.inc
+++ b/packages/hermes/src/p_ga.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_gac.inc b/packages/hermes/src/p_gac.inc
index 02c9ce486f..1dd43da34c 100644
--- a/packages/hermes/src/p_gac.inc
+++ b/packages/hermes/src/p_gac.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_gca.inc b/packages/hermes/src/p_gca.inc
index 4d05e6c35f..b4f2958105 100644
--- a/packages/hermes/src/p_gca.inc
+++ b/packages/hermes/src/p_gca.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_gcc.inc b/packages/hermes/src/p_gcc.inc
index 942a41afe8..ee822d9c8b 100644
--- a/packages/hermes/src/p_gcc.inc
+++ b/packages/hermes/src/p_gcc.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_i8.inc b/packages/hermes/src/p_i8.inc
index 404c7cab75..0c1573a28f 100644
--- a/packages/hermes/src/p_i8.inc
+++ b/packages/hermes/src/p_i8.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/p_muhmu.inc b/packages/hermes/src/p_muhmu.inc
index 5e0d2afe0c..b33a94f5f0 100644
--- a/packages/hermes/src/p_muhmu.inc
+++ b/packages/hermes/src/p_muhmu.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {
diff --git a/packages/hermes/src/x86_64/x86_64_i8.inc b/packages/hermes/src/x86_64/x86_64_i8.inc
index 249f45d98c..a2768ed04c 100644
--- a/packages/hermes/src/x86_64/x86_64_i8.inc
+++ b/packages/hermes/src/x86_64/x86_64_i8.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$ASMMODE intel}
diff --git a/packages/iconvenc/src/iconvenc.pas b/packages/iconvenc/src/iconvenc.pas
index e0aac343c5..9780ac7d78 100644
--- a/packages/iconvenc/src/iconvenc.pas
+++ b/packages/iconvenc/src/iconvenc.pas
@@ -72,7 +72,7 @@ function iconv_close (__cd: iconv_t): cint; cdecl; external libiconvname name ic
 var
   IconvLibFound: boolean = False;
 
-function Iconvert(s: string; var res: string; FromEncoding, ToEncoding: string): cint;
+function Iconvert(s: string; var res: string; const  FromEncoding, ToEncoding: string): cint;
 function InitIconv(var error: string): boolean;
 
 implementation
diff --git a/packages/iconvenc/src/iconvenc_dyn.pas b/packages/iconvenc/src/iconvenc_dyn.pas
index 57aad86c11..a97927d0ba 100644
--- a/packages/iconvenc/src/iconvenc_dyn.pas
+++ b/packages/iconvenc/src/iconvenc_dyn.pas
@@ -47,7 +47,7 @@ var
   IconvLibFound: boolean = False;
 
 function TryLoadLib(LibName: string; var error: string): boolean; // can be used to load non standard libname
-function Iconvert(s: string; var res: string; FromEncoding, ToEncoding: string): cint;
+function Iconvert(s: string; var res: string; const FromEncoding, ToEncoding: string): cint;
 function InitIconv(var error: string): boolean;
 
 implementation
diff --git a/packages/iconvenc/src/iconvert.inc b/packages/iconvenc/src/iconvert.inc
index 8707b123b2..d4428a8cf6 100644
--- a/packages/iconvenc/src/iconvert.inc
+++ b/packages/iconvenc/src/iconvert.inc
@@ -3,7 +3,7 @@
  {$define noerrnoiconv}
 {$endif}
 
-function Iconvert(S: string; var Res: string; FromEncoding, ToEncoding: string): cint;
+function Iconvert(S: string; var Res: string; const FromEncoding, ToEncoding: string): cint;
 var
   InLen, OutLen, Offset: size_t;
   Src, Dst: pchar;
diff --git a/packages/libgd/src/gd.pas b/packages/libgd/src/gd.pas
index a39bf0bb3d..028ebcfa39 100644
--- a/packages/libgd/src/gd.pas
+++ b/packages/libgd/src/gd.pas
@@ -28,6 +28,9 @@ unit gd;
 {$IFDEF GBA}
   {$UNDEF FPC_TARGET_SUPPORTS_DYNLIBS}
 {$ENDIF GBA}
+{$IFDEF NDS}
+  {$UNDEF FPC_TARGET_SUPPORTS_DYNLIBS}
+{$ENDIF NDS}
 
 interface
 
@@ -100,7 +103,11 @@ uses
   {$DEFINE gdlib := }
   {$DEFINE clib := }
 {$ENDIF GBA}
-
+{$IFDEF NDS}
+  {$UNDEF LOAD_DYNAMICALLY}
+  {$DEFINE gdlib := }
+  {$DEFINE clib := }
+{$ENDIF NDS}
 
 {$IFNDEF LOAD_DYNAMICALLY}
   {$IFDEF darwin}
diff --git a/packages/libtar/src/libtar.pp b/packages/libtar/src/libtar.pp
index 10d8d9693f..c1a092da7d 100644
--- a/packages/libtar/src/libtar.pp
+++ b/packages/libtar/src/libtar.pp
@@ -977,6 +977,13 @@ VAR
 BEGIN
   FillChar (Rec, SizeOf (Rec), 0);
   FStream.Write (Rec, RECORDSIZE);
+  {
+    Avoid warning: 'tar: A lone zero block at *'
+    The reason for this message is that GNU tar format has been changed
+    to require TWO zero blocks marking the end of the archive.
+    Thus write a second zero block.
+  }
+  FStream.Write (Rec, RECORDSIZE);
   FFinalized := TRUE;
 END;
 
diff --git a/packages/libvlc/src/libvlc.pp b/packages/libvlc/src/libvlc.pp
index a8a3000ec7..1aaf7bf854 100644
--- a/packages/libvlc/src/libvlc.pp
+++ b/packages/libvlc/src/libvlc.pp
@@ -71,35 +71,38 @@ Const
   Plibvlc_media_track_info_t  = ^libvlc_media_track_info_t;
   Plibvlc_module_description_t  = ^libvlc_module_description_t;
   Plibvlc_track_description_t  = ^libvlc_track_description_t;
-
+  
+  
   int8_t = cschar;
   int16_t = csint;
   int32_t = cint;
-  int64_t = clong;
+  int64_t = cint64;
   uint8_t = cuchar;
   uint16_t = csint;
   uint32_t = cuint;
-  uint64_t = culong;
+  uint64_t = cuint64;
   int_least8_t = cschar;
   int_least16_t = csint;
   int_least32_t = cint;
-  int_least64_t = clong;
+  int_least64_t = cint64;
   uint_least8_t = cuchar;
   uint_least16_t = csint;
   uint_least32_t = cuint;
-  uint_least64_t = culong;
+  uint_least64_t = cuint64;
   int_fast8_t = cschar;
   int_fast16_t = clong;
   int_fast32_t = clong;
-  int_fast64_t = clong;
+  int_fast64_t = cint64;
   uint_fast8_t = cuchar;
   uint_fast16_t = culong;
   uint_fast32_t = culong;
-  uint_fast64_t = culong;
-  intptr_t = clong;
-  uintptr_t = culong;
-  intmax_t = clong;
-  uintmax_t = culong;
+  uint_fast64_t = cuint64;
+
+  intptr_t = PtrInt;
+  uintptr_t = PtrUInt;
+  intmax_t = cint64;
+  uintmax_t = cuint64;
+
 
   libvlc_time_t = int64_t;
   libvlc_log_message_t = record
diff --git a/packages/matroska/src/matroska.pas b/packages/matroska/src/matroska.pas
index fedf9eff5e..bf3c088ce0 100644
--- a/packages/matroska/src/matroska.pas
+++ b/packages/matroska/src/matroska.pas
@@ -24,7 +24,7 @@
 ** 
 ** You should have received a copy of the GNU Lesser General Public
 ** License along with this library; if not, write to the Free Software
-** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+** Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 **
 ** See http://www.matroska.org/license/lgpl/ for LGPL licensing information.**
 ** Contact license@matroska.org if any conditions of this licensing are
diff --git a/packages/mysql/src/mysql.inc b/packages/mysql/src/mysql.inc
index 1de2d85e73..7fe5e4ad1c 100644
--- a/packages/mysql/src/mysql.inc
+++ b/packages/mysql/src/mysql.inc
@@ -89,7 +89,7 @@ uses
   
      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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  }
+     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA  }
 
     type
        my_bool = cchar;
@@ -1871,6 +1871,7 @@ begin
     pointer(mysql_affected_rows) := GetProcedureAddress(MysqlLibraryHandle,'mysql_affected_rows');
     pointer(mysql_autocommit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_autocommit');
     pointer(mysql_change_user) := GetProcedureAddress(MysqlLibraryHandle,'mysql_change_user');
+    pointer(mysql_character_set_name) := GetProcedureAddress(MysqlLibraryHandle,'mysql_character_set_name');
     pointer(mysql_close) := GetProcedureAddress(MysqlLibraryHandle,'mysql_close');
     pointer(mysql_commit) := GetProcedureAddress(MysqlLibraryHandle,'mysql_commit');
     pointer(mysql_data_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_data_seek');
@@ -1889,6 +1890,9 @@ begin
     pointer(mysql_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_count');
     pointer(mysql_field_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_field_tell');
     pointer(mysql_free_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_free_result');
+{$IFDEF mysql50}
+    pointer(mysql_get_character_set_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_character_set_info');
+{$ENDIF}
     pointer(mysql_get_client_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_client_info');
     pointer(mysql_get_client_version) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_client_version');
     pointer(mysql_get_host_info) := GetProcedureAddress(MysqlLibraryHandle,'mysql_get_host_info');
@@ -1914,8 +1918,14 @@ begin
     pointer(mysql_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_query');
     pointer(mysql_real_connect) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_connect');
     pointer(mysql_real_escape_string) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_string');
+{$IFDEF mysql57}
+    pointer(mysql_real_escape_string_quote) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_string_quote');
+{$ENDIF}
     pointer(mysql_real_query) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_query');
     pointer(mysql_refresh) := GetProcedureAddress(MysqlLibraryHandle,'mysql_refresh');
+{$IFDEF mysql57}
+    pointer(mysql_reset_connection) := GetProcedureAddress(MysqlLibraryHandle,'mysql_reset_connection');
+{$ENDIF}
     pointer(mysql_rollback) := GetProcedureAddress(MysqlLibraryHandle,'mysql_rollback');
     pointer(mysql_row_seek) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_seek');
     pointer(mysql_row_tell) := GetProcedureAddress(MysqlLibraryHandle,'mysql_row_tell');
@@ -1959,10 +1969,6 @@ begin
     pointer(mysql_stmt_insert_id) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_insert_id');
     pointer(mysql_stmt_field_count) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_field_count');
     pointer(mysql_stmt_next_result) := GetProcedureAddress(MysqlLibraryHandle,'mysql_stmt_next_result');
-{$IFDEF mysql57}
-    pointer(mysql_real_escape_string_quote) := GetProcedureAddress(MysqlLibraryHandle,'mysql_real_escape_string_quote');
-    pointer(mysql_reset_connection) := GetProcedureAddress(MysqlLibraryHandle,'mysql_reset_connection');
-{$ENDIF}
 
     if mysql_library_init(argc, argv, groups) <> 0 then
       Exit;
diff --git a/packages/mysql/src/mysql4_com.pp b/packages/mysql/src/mysql4_com.pp
index 7d44097bb2..3e07cbd6bd 100644
--- a/packages/mysql/src/mysql4_com.pp
+++ b/packages/mysql/src/mysql4_com.pp
@@ -44,7 +44,7 @@ Type
 
      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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  }
+     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA  }
 
 
   function my_net_init(net:PNET; vio:PVio):longint;extdecl;external External_library name 'my_net_init';
diff --git a/packages/mysql/src/mysql4_comdyn.pp b/packages/mysql/src/mysql4_comdyn.pp
index 69ee85c230..3bb7f27120 100644
--- a/packages/mysql/src/mysql4_comdyn.pp
+++ b/packages/mysql/src/mysql4_comdyn.pp
@@ -42,7 +42,7 @@ uses ctypes,my4_sys,dynlibs, sysutils;
 
      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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  }
+     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA  }
 
 
 var
diff --git a/packages/mysql/src/mysql4dyn.pp b/packages/mysql/src/mysql4dyn.pp
index 99ee6f4265..67ebf689d9 100644
--- a/packages/mysql/src/mysql4dyn.pp
+++ b/packages/mysql/src/mysql4dyn.pp
@@ -39,7 +39,7 @@ uses ctypes,dynlibs, classes, sysutils, my4_sys, mysql4_comdyn;
 
      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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  }
+     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA  }
 
 
 {$IFDEF Unix}
diff --git a/packages/numlib/src/int.pas b/packages/numlib/src/int.pas
index 2c2419dd4e..7b197df928 100644
--- a/packages/numlib/src/int.pas
+++ b/packages/numlib/src/int.pas
@@ -24,7 +24,7 @@ Unit int;
 
 interface
 
-uses typ;
+uses typ,math;
 
 Var
     limit    : ArbInt;
diff --git a/packages/numlib/src/roo.pas b/packages/numlib/src/roo.pas
index 39da1be41f..fa6ca1c4f9 100644
--- a/packages/numlib/src/roo.pas
+++ b/packages/numlib/src/roo.pas
@@ -18,6 +18,9 @@
 
  **********************************************************************}
 
+{$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
+
 Unit roo;
 {$i direct.inc}
 
@@ -34,6 +37,8 @@ Procedure roobin(n: ArbInt; a: complex; Var z: complex; Var term: ArbInt);
 
 Procedure roof1r(f: rfunc1r; a, b, ae, re: ArbFloat; Var x: ArbFloat;
                  Var term: ArbInt);
+Procedure roof1rn(f: rfunc1rn; a, b, ae, re: ArbFloat; Var x: ArbFloat;
+                 Var term: ArbInt);
 
 {Determine all zeropoints for a given n'th degree polynomal with real
 coefficients}
@@ -45,7 +50,7 @@ Procedure roopol(Var a: ArbFloat; n: ArbInt; Var z: complex;
 
 Procedure rooqua(p, q: ArbFloat; Var z1, z2: complex);
 
-{Roofnr is undocumented, but verry big}
+{Solve a system of non-linear equations}
 
 Procedure roofnr(f: roofnrfunc; n: ArbInt; Var x, residu: ArbFloat; re: ArbFloat;
                  Var term: ArbInt);
@@ -141,13 +146,24 @@ End {roobin};
 Procedure roof1r(f: rfunc1r; a, b, ae, re: ArbFloat; Var x: ArbFloat;
                  Var term: ArbInt);
 
+  function nested_f(x: ArbFloat): ArbFloat;
+  begin
+    Result := f(x);
+  end;
+
+begin
+  roof1rn(@nested_f, a, b, ae, re, x, term);
+end;  
+
+Procedure roof1rn(f: rfunc1rn; a, b, ae, re: ArbFloat; Var x: ArbFloat;
+                 Var term: ArbInt);
 Var fa, fb, c, fc, m, tol, w1, w2 : ArbFloat;
                                 k : ArbInt;
                              stop : boolean;
 
 Begin
   fa := f(a);
- fb := f(b);
+  fb := f(b);
   If (spesgn(fa)*spesgn(fb)=1) Or (ae<0) Or (re<0)
    Then  {wrong input}
     Begin
@@ -173,7 +189,7 @@ Begin
   k := 0;
   tol := ae+re*spemax(abs(a), abs(b));
   w1 := abs(b-a);
- stop := false;
+  stop := false;
   while (abs(b-a)>tol) and (fb<>0) and (Not stop) Do
     Begin
       m := (a+b)/2;
diff --git a/packages/numlib/src/spe.pas b/packages/numlib/src/spe.pas
index 16f9dde960..b4201f46cb 100644
--- a/packages/numlib/src/spe.pas
+++ b/packages/numlib/src/spe.pas
@@ -20,6 +20,9 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
+
 unit spe;
 {$I DIRECT.INC}
 
@@ -57,54 +60,128 @@ function speent(x: ArbFloat): longint;
 {  Errorfunction ( 2/sqrt(pi)* Int(t,0,pi,exp(sqr(t)) )}
 function speerf(x: ArbFloat): ArbFloat;
 
-{  Errorfunction's complement ( 2/sqrt(pi)* Int(t,pi,inf,exp(sqr(t)) )}
+{  Errorfunction's complement ( 2/sqrt(pi)* Int(t,pi,inf,exp(sqr(t))) )}
 function speefc(x: ArbFloat): ArbFloat;
 
+{  Calculates the cumulative normal distribution
+   N(x) = 1/sqrt(2*pi) * Int(t, -INF, x, exp(t^2/2) ) }
+function normaldist(x: ArbFloat): ArbFloat;
+
+{  Inverse of cumulative normal distribution:
+   Returns x such that y = normaldist(x) }
+function invnormaldist(y: ArbFloat): ArbFloat;
+
 {  Function to calculate the Gamma function ( int(t,0,inf,t^(x-1)*exp(-t)) }
 function spegam(x: ArbFloat): ArbFloat;
 
 {  Function to calculate the natural logaritm of the Gamma function}
 function spelga(x: ArbFloat): ArbFloat;
 
+{  Function to calculate the lower incomplete Gamma function
+     int(t,0,x,exp(-t)t^(s-1)) / spegam(s)  (s > 0) }
+function gammap(s, x: ArbFloat): ArbFloat;
+
+{  Function to calculate the upper incomplete Gamma function
+     int(t,x,inf,exp(-t)t^(s-1)) / spegam(s)  (s > 0)
+     gammaq(s,x) = 1 - gammap(s,x) }
+function gammaq(s, x: ArbFloat): ArbFloat;
+function invgammaq(s, y: ArbFloat): ArbFloat;
+
+{  Function to calculate the (complete) beta function
+      beta(a, b) = int(t, 0, 1, t^(a-1) * (1-t)^(b-1) with a > 0, b > 0
+      beta(a, b) = spegam(a) * spegam(b) / spegam(a + b) }
+function beta(a, b: ArbFloat): ArbFloat;
+
+{  Function to calculate the (regularized) incomplete beta function
+      betai(a, b, x) = int(t, 0, x, t^(x-1) * (1-t)^(y-1) ) / beta(a,b) }
+function betai(a, b, x: ArbFloat): ArbFloat;
+function invbetai(a, b, y: ArbFloat; eps: ArbFloat = 0.0): ArbFloat;
+
+{ Function to calculate the cumulative chi2 distribution with n degrees of
+  freedom (upper tail) }
+function chi2dist(x: ArbFloat; n: ArbInt): ArbFloat;
+function invchi2dist(y: Arbfloat; n: ArbInt): ArbFloat;
+
+{  Function to calculate Student's t distribution with n degrees of freedom
+   (cumulative, upper tail if Tails = 1, else both tails }
+type
+  TNumTails = 1..2;
+
+function tdist(t: ArbFloat; n: ArbInt; Tails: TNumTails): ArbFloat;
+function invtdist(y: ArbFloat; n: ArbInt; Tails: TNumTails; eps: ArbFloat = 0.0): ArbFloat;
+
+{  Function to calculate the cumulative F distribution function of value F
+   with n1 and n2 degrees of freedom }
+function Fdist(F: ArbFloat; n1, n2: ArbInt): ArbFloat;
+function invFdist(p: ArbFloat; n1, n2: ArbInt; eps: ArbFloat = 0.0): ArbFloat;
+
 {  "Calculates" the maximum of two ArbFloat values     }
-function spemax(a, b: ArbFloat): ArbFloat;
+function spemax(a, b: ArbFloat): ArbFloat; deprecated 'Use max(a,b) in unit math.';
 
-{  Calculates the functionvalue of a polynomalfunction with n coefficients in a
-for variable X }
+{  Calculates the function value of a polynomial of degree n for variable x.
+   The polynomial coefficients a are ordered from lowest to highest degree term.
+     y = a0 + a1 x + a2 x^2 + ... + an x^n }
 function spepol(x: ArbFloat; var a: ArbFloat; n: ArbInt): ArbFloat;
 
 { Calc a^b with a and b real numbers}
-function spepow(a, b: ArbFloat): ArbFloat;
+function spepow(a, b: ArbFloat): ArbFloat; deprecated 'Use power(a,b) in unit math.';
 
 { Returns sign of x (-1 for x<0, 0 for x=0 and 1 for x>0)  }
-function spesgn(x: ArbFloat): ArbInt;
+function spesgn(x: ArbFloat): ArbInt;  deprecated 'Use sign(x) in unit math.';
 
 {  ArcSin(x) }
-function spears(x: ArbFloat): ArbFloat;
+function spears(x: ArbFloat): ArbFloat; deprecated 'Use arcsin(x) in unit math.';
 
 {  ArcCos(x) }
-function spearc(x: ArbFloat): ArbFloat;
+function spearc(x: ArbFloat): ArbFloat; deprecated 'Use arccos(x) in unit math.';
 
 {  Sinh(x) }
-function spesih(x: ArbFloat): ArbFloat;
+function spesih(x: ArbFloat): ArbFloat; deprecated 'Use sinh(x) in unit math.';
 
 {  Cosh(x) }
-function specoh(x: ArbFloat): ArbFloat;
+function specoh(x: ArbFloat): ArbFloat; deprecated 'Use cosh(x) in unit math.';
 
 {  Tanh(x) }
-function spetah(x: ArbFloat): ArbFloat;
+function spetah(x: ArbFloat): ArbFloat; deprecated 'Use tanh(x) in unit math.';
 
 {  ArcSinH(x) }
-function speash(x: ArbFloat): ArbFloat;
+function speash(x: ArbFloat): ArbFloat; deprecated 'Use arcsinh(x) in unit math.';
 
 {  ArcCosh(x) }
-function speach(x: ArbFloat): ArbFloat;
+function speach(x: ArbFloat): ArbFloat; deprecated 'Use arccosh(x) in unit math';
 
 {  ArcTanH(x) }
-function speath(x: ArbFloat): ArbFloat;
+function speath(x: ArbFloat): ArbFloat; deprecated 'Use arctanh(x) in unit math';
+
+{ Error numbers used within this unit:
+
+  401 - function spebk0(x) is not defined for x <= 0.
+  402 - function spebk1(x) is not defined for x <= 0.
+  403 - function speby0(x) is not defined for x <= 0.
+  404 - function speby1(x) is not defined for x <= 0.
+  405 - function speach(x) is not defined for x < 1
+  406 - function speath(x) is not defined for x <= -1 or x >= 1
+  407 - function spgam(x): x is too small or too large.
+  408 - function splga(x) cannot be calculated for x <= 0, or x is too large.
+  409 - function spears(s, x) is not defined for x < -1 or x > 1
+  410 - function gammap(s, x) is not defined for s <= 0 or x < 0
+  411 - function gammaq(s, x) is not defined for s <= 0 or x < 0
+  412 - function beta(a, b) is not defined for a <= 0 or b <= 0
+  413 - function betai(a, b, x) is not defined for a <= 0 or b <= 0
+  414 - function betai(a, b, x) is not defined for x < 0 or x > 0
+  415 - function invtdist(t, n) is not defined for t <= 0 or t >= 1 or n <= 0.
+}
 
 implementation
 
+uses
+  math, roo;
+
+const
+  SQRT2 = 1.4142135623730950488016887242097;   // sqrt(2)
+  SQRT2PI = 2.506628274631000502415765284811;  // sqrt(2*pi)
+  EXP_2 = 0.13533528323661269189399949497248;  // exp(-2)
+
 function spebi0(x: ArbFloat): ArbFloat;
 
 const
@@ -869,6 +946,120 @@ begin
     end
 end {speefc};
 
+{ N(x) = 1/sqrt(2 pi) int(-INF, x, exp(t^2/2) = (1 + erf(x/sqrt(2))) / 2 }
+function normaldist(x: ArbFloat): ArbFloat;
+begin
+  Result := 0.5 * (1.0 + speerf(x / SQRT2));
+end;
+
+function invnormaldist(y: ArbFloat): ArbFloat;
+{ Ref.: Moshier, "Methods and programs for mathematical function" }
+const
+  P0: array[0..4] of ArbFloat = (
+    -1.23916583867381258016,
+    13.9312609387279679503,
+    -56.6762857469070293439,
+    98.0010754185999661536,
+    -59.9633501014107895267);
+  Q0: array[0..8] of ArbFloat = (
+    -1.18331621121330003142,
+    15.9056225126211695515,
+    -82.0372256168333339912,
+    200.260212380060660359,
+    -225.462687854119370527,
+    86.3602421390890590575,
+    4.67627912898881538453,
+    1.95448858338141759834,
+    1.0);
+  P1: array[0..8] of ArbFloat = (
+    -8.57456785154685413611E-4,
+    -3.50424626827848203418E-2,
+    -1.40256079171354495875E-1,
+    2.18663306850790267539,
+    14.6849561928858024014,
+    44.0805073893200834700,
+    57.1628192246421288162,
+    31.5251094599893866154,
+    4.05544892305962419923);
+  Q1: array[0..8] of Arbfloat = (
+    -9.33259480895457427372E-4,
+    -3.80806407691578277194E-2,
+    -1.42182922854787788574E-1,
+    2.50464946208309415979,
+    15.0425385692907503408,
+    41.3172038254672030440,
+    45.3907635128879210584,
+    15.7799883256466749731,
+    1.0);
+  P2: array[0..8] of ArbFloat = (
+    6.23974539184983293730E-9,
+    2.65806974686737550832E-6,
+    3.01581553508235416007E-4,
+    1.23716634817820021358E-2,
+    2.01485389549179081538E-1,
+    1.33303460815807542389,
+    3.93881025292474443415,
+    6.91522889068984211695,
+    3.23774891776946035970);
+  Q2: array[0..8] of ArbFloat = (
+    6.79019408009981274425E-9,
+    2.89247864745380683936E-6,
+    3.28014464682127739104E-4,
+    1.34204006088543189037E-2,
+    2.16236993594496635890E-1,
+    1.37702099489081330271,
+    3.67983563856160859403,
+    6.02427039364742014255,
+    1.0);
+var
+  x, x0, x1: ArbFloat;
+  yy, y2: ArbFloat;
+  z: ArbFloat;
+  code: Integer;
+begin
+  if y <= 0.0 then
+  begin
+    Result := -giant;
+    exit;
+  end;
+
+  if y >= 1.0 then
+  begin
+    Result := +giant;
+    exit;
+  end;
+
+  code := 1;
+  yy := y;
+  if yy > 1.0 - EXP_2 then begin    // EXP_2 = exp(-2)
+    yy := 1.0 - yy;
+    code := 0;
+  end;
+
+  if yy > EXP_2 then begin
+    yy := yy - 0.5;
+    y2 := yy * yy;
+    x := y2 * spepol(y2, P0[0], 4) / spepol(y2, Q0[0], 8);
+    x := (yy + yy * x) * SQRT2PI;   // SQRT2PI = sqrt(2*pi);
+    Result := x;
+    exit;
+  end;
+
+  x := sqrt(-2.0 * ln(yy));
+  x0 := x - ln(x) / x;
+  z := 1.0 / x;
+
+  if x < 8.0 then
+    x1 := z * spepol(z, P1[0], 8) / spepol(z, Q1[0], 8)
+  else
+    x1 := z * spepol(z, P2[0], 8) / spepol(z, Q2[0], 8);
+
+  x := x0 - x1;
+  if code <> 0 then
+    x := -x;
+  Result := x;
+end;
+
 function spegam(x: ArbFloat): ArbFloat;
 const
 
@@ -1003,6 +1194,307 @@ begin
     RunError(408)
 end; {spelga}
 
+{ Implements power series expansion for lower incomplete gamma function
+  according to
+  https://en.wikipedia.org/wiki/Incomplete_gamma_function#Evaluation_formulae
+    gamma(s, x) = sum {k = 0 to inf, x^s exp(-x) x^k / (s (s+1) ... (s+k) ) }
+  Converges rapidly for x < s + 1 }
+function gammaser(s, x: ArbFloat): ArbFloat;
+const
+  MAX_IT = 100;
+  EPS = 1E-7;
+var
+  delta: Arbfloat;
+  sum: ArbFloat;
+  k: Integer;
+  lngamma: ArbFloat;
+begin
+  delta := 1 / s;
+  sum := delta;
+  for k := 1 to MAX_IT do begin
+    delta := delta * x / (s + k);
+    sum := sum + delta;
+    if delta < EPS then break;
+  end;
+  lngamma := spelga(s);  // log of complete gamma(s)
+  Result := exp(s * ln(x) - x + ln(sum) - lngamma);
+end;
+
+type
+  TCFFunc = function(n: Integer): ArbFloat is nested;
+
+{ Calculates the continued fraction a0 + (b1 / (a1 + b2 / (a2 + b3 / (a3 + b4 /...))))
+  using convergents.
+  Ref.: http://lib.dr.iastate.edu/cgi/viewcontent.cgi?article=8639&context=rtd
+    nth convergent: wn = P(n)/Q(n).
+    P(n) = a(n) P(n-1) + b(n) P(n-2)
+    Q(n) = a(n) Q(n-1) + b(n) Q(n-2)
+    P(-1) = 1, P(0) = a(0), Q(-1) = 0, Q(0) = 1 }
+function CalcCF(funca, funcb: TCfFunc; MaxIt: Integer; Eps: ArbFloat): ArbFloat;
+var
+  Pn, Pn1, Pn2: ArbFloat;
+  Qn, Qn1, Qn2: ArbFloat;
+  it: Integer;
+  prev: ArbFloat;
+  a, b: ArbFloat;
+begin
+  Pn2 := 1.0;
+  Pn1 := funca(0);
+  Qn2 := 0.0;
+  Qn1 := 1.0;
+  prev := Giant;
+  for it := 1 to MaxIt do begin
+    a := funca(it);
+    b := funcb(it);
+    Pn := a * Pn1 + b * Pn2;
+    Qn := a * Qn1 + b * Qn2;
+    Result := Pn/Qn;
+    if abs(Result - prev) < EPS * abs(Result) then
+      exit;
+    prev := Result;
+    Pn2 := Pn1;
+    Pn1 := Pn;
+    Qn2 := Qn1;
+    Qn1 := Qn;
+  end;
+end;
+
+
+{ calculates the upper incomplete gamma function using its continued
+  fraction expansion
+  https://en.wikipedia.org/wiki/Incomplete_gamma_function#Connection_with_Kummer.27s_confluent_hypergeometric_function }
+function gammacf(s, x: ArbFloat): ArbFloat;
+
+  function funca(i: Integer): ArbFloat;
+  begin
+    if i = 0 then
+      Result := 0
+    else
+    if odd(i) then
+      Result := x
+    else
+      Result := 1;
+  end;
+
+  function funcb(i: Integer): ArbFloat;
+  begin
+    if i = 1 then
+      Result := 1
+    else
+    if odd(i) then
+      Result := (i-1) div 2
+    else
+      Result := i div 2 - s;
+  end;
+
+const
+  MAX_IT = 100;
+  EPS = 1E-7;
+begin
+  Result := exp(-x + s*ln(x) - spelga(s)) * CalcCF(@funca, @funcb, MAX_IT, EPS);
+end;
+
+function gammap(s, x: ArbFloat): ArbFloat;
+begin
+  if (x < 0.0) or (s <= 0.0) then
+    RunError(410);                  // Invalid argument of gammap
+  if x = 0.0 then
+    Result := 0.0
+  else if x < s + 1 then
+    Result := gammaser(s, x)        // Use series expansion
+  else
+    Result := 1.0 - gammacf(s, x);  // Use continued fraction
+end;
+
+function gammaq(s, x: ArbFloat): ArbFloat;
+begin
+  if (x < 0.0) or (s <= 0.0) then
+    RunError(411);                  // Invalid argument of gammaq
+  if x = 0.0 then
+    Result := 1.0
+  else if x < s + 1 then
+    Result := 1.0 - gammaser(s, x)  // Use series expansion
+  else
+    Result := gammacf(s, x);        // Use continued fraction
+end;
+
+{ Ref.: Moshier, "Methods and programs for mathematical functions" }
+function invgammaq(s, y: ArbFloat): ArbFloat;
+const
+  NUM_IT = 30;
+var
+  d, y0, x0, xinit, lgm: ArbFloat;
+  it: Integer;
+  eps: ArbFloat;
+begin
+  d := 1.0 / (9 * s);
+  y0 := invnormaldist(y);
+  if y0 = giant then
+    exit(0.0);
+
+  y0 := 1.0 - d - y0 * sqrt(d);
+  x0 := s * y0 * y0 * y0;
+  xinit := x0;
+  lgm := spelga(s);
+  eps := 2.0 * MachEps;
+
+  for it := 1 to NUM_IT do
+  begin
+    if (x0 <= 0.0) then   // underflow
+      exit(0.0);
+    y0 := gammaq(s, x0);
+    d := (s - 1.0) * ln(x0) - x0 - lgm;
+    if d < -lnGiant then  // underflow
+      break;
+    d := -exp(d);
+    if d = 0.0 then
+      break;
+    d := (y0 - y) / d;
+    x0 := x0 - d;
+    if it <= 3 then
+      continue;
+    if abs(d / x0) < eps then
+      break;
+  end;
+  Result := x0;
+end;
+
+{ Calculates the complete beta function based on its property that
+    beta(a, b) = gamma(a) * gamma(b) / gamma(a+b)
+  https://en.wikipedia.org/wiki/Beta_function }
+function beta(a, b: ArbFloat): ArbFloat;
+begin
+  if (a <= 0) or (b <= 0) then
+    RunError(412);
+  Result := exp(spelga(a) + spelga(b) - spelga(a + b));
+end;
+
+{ Calculates the continued fraction of the incomplete beta function.
+  Ref: https://www.encyclopediaofmath.org/index.php/Incomplete_beta-function }
+function betaicf(a, b, x: ArbFloat): Arbfloat;
+
+  function funca(i: Integer): ArbFloat;
+  begin
+    if i = 0 then Result := 0.0 else Result := 1.0;
+  end;
+
+  function funcb(i: Integer): ArbFloat;
+  var
+    am: ArbFloat;
+    amm: ArbFloat;
+    m: Integer;
+  begin
+    if i = 1 then
+      Result := 1.0
+    else begin
+      m := (i-1) div 2;
+      am := a + m;
+      amm := am + m;
+      if odd(i) then
+        Result := m * (b - m) * x / ((amm - 1) * amm)
+      else
+        Result := -am * (am + b) * x / (amm * (amm + 1));
+    end;
+  end;
+
+const
+  MAX_IT = 100;
+  EPS = 1E-7;
+begin
+  Result := CalcCF(@funca, @funcb, MAX_IT, EPS);
+end;
+
+function betai(a, b, x: ArbFloat): ArbFloat;
+var
+  factor: ArbFloat;
+begin
+  // Check for invalid arguments
+  if (a <= 0) or (b <= 0) then
+    RunError(413);
+  if (x < 0) or (x > 1) then
+    RunError(414);
+
+  if (x = 0) or (x = 1) then
+    factor := 0
+  else
+    factor := exp(a * ln(x) + b * ln(1.0 - x) + spelga(a + b) - spelga(a) - spelga(b));
+
+  // The continued fraction expansion converges quickly only for
+  //    x < (a + 1) / (a + b + 2)
+  // For the other case, we apply the relation
+  //    beta(a, b, x) = 1 - beta(b, a, 1-x)
+  if x < (a + 1) / (a + b + 2) then
+    Result := factor * betaicf(a, b, x) / a
+  else
+    Result := 1.0 - factor * betaicf(b, a, 1.0 - x) / b;
+end;
+
+{ Inverse of the incomplete beta function }
+function invbetai(a, b, y: ArbFloat; eps: ArbFloat = 0.0): ArbFloat;
+
+  function _betai(x: ArbFloat): ArbFloat;
+  begin
+    Result := betai(a, b, x) - y;
+  end;
+
+var
+  term: ArbInt = 0;
+begin
+  if eps = 0.0 then
+    eps := MachEps;
+  roof1rn(@_betai, 0, 1, eps, eps, Result, term);
+  if term = 3 then
+    Result := NaN;
+end;
+
+function chi2dist(x: ArbFloat; n: ArbInt): ArbFloat;
+begin
+  Result := gammaQ(0.5*n, 0.5*x);
+end;
+
+function invchi2dist(y: Arbfloat; n: ArbInt): ArbFloat;
+begin
+  Result := 2.0 * invgammaQ(n/2, y);
+//  Result := 2.0 * invgammaQ_alglib(n/2, y);
+end;
+
+function tdist(t: ArbFloat; n: ArbInt; Tails: TNumTails): ArbFloat;
+begin
+  Result := betai(0.5*n, 0.5, n/(n+t*t));
+  if Tails = 1 then Result := Result * 0.5;
+end;
+
+function invtdist(y: ArbFloat; n: ArbInt; Tails: TNumTails;
+  eps: ArbFloat = 0.0): ArbFloat;
+var
+  w: ArbFloat;
+begin
+  if (n <= 0) or (y <= 0) or (y >= 1) then
+    RunError(415);
+
+  if Tails = 2 then y := y * 0.5;
+  w := invbetai(0.5*n, 0.5, 2*y, eps);
+  Result := sqrt(n/w - n);
+end;
+
+// Calculates the F distribution with n1 and n2 degrees of freedom in the
+// numerator and denominator, respectively
+function Fdist(F: ArbFloat; n1, n2: ArbInt): ArbFloat;
+begin
+  Result := betai(n2*0.5, n1*0.5, n2 / (n2 + n1*F));
+end;
+
+// Calculates the inverse of the F distribution
+// Ref. Moshier, "Methods and programs for mathematical functions"
+function invFdist(p: ArbFloat; n1, n2: ArbInt; eps: ArbFloat = 0.0): ArbFloat;
+var
+  s: ArbFloat;
+begin
+  if eps = 0.0 then eps := machEps;
+  s := invbetai(n2*0.5, n1*0.5, p, eps);
+  Result := n2 * (1-s) / (n1 * s);
+end;
+
 function spepol(x: ArbFloat; var a: ArbFloat; n: ArbInt): ArbFloat;
 var   pa : ^arfloat0;
        i : ArbInt;
@@ -1080,7 +1572,7 @@ var    y, u, t, s : ArbFloat;
 begin
   if abs(x) > 1
   then
-    RunError(401);
+    RunError(411);
   u:=sqr(x); uprang:= u > 0.5;
   if uprang
   then
@@ -1268,6 +1760,7 @@ end; {speath}
 var exitsave : pointer;
 
 procedure MyExit;
+{
 const ErrorS : array[400..408,1..6] of char =
      ('spepow',
       'spebk0',
@@ -1277,7 +1770,7 @@ const ErrorS : array[400..408,1..6] of char =
       'speach',
       'speath',
       'spegam',
-      'spelga');
+      'spelga'); }
 
 //var ErrFil : text;
 
@@ -1285,7 +1778,7 @@ begin
      ExitProc := ExitSave;
 //     Assign(ErrFil, 'CON');
 //    ReWrite(ErrFil);
-     if (ExitCode>=400) AND (ExitCode<=408) then
+     if (ExitCode>=400) AND (ExitCode<=415) then
        begin
 //         write(ErrFil, 'critical error in ', ErrorS[ExitCode]);
          ExitCode := 201
diff --git a/packages/numlib/src/spl.pas b/packages/numlib/src/spl.pas
index 68c76c399b..78383669fe 100644
--- a/packages/numlib/src/spl.pas
+++ b/packages/numlib/src/spl.pas
@@ -23,7 +23,7 @@ unit spl;
 
 interface
 
-uses typ, sle;
+uses typ, math, sle;
 
 function  spl1bspv(q: ArbInt; var kmin1, c1: ArbFloat; x: ArbFloat; var term: ArbInt): ArbFloat;
 function  spl2bspv(qx, qy: ArbInt; var kxmin1, kymin1, c11: ArbFloat; x, y: ArbFloat; var term: ArbInt): ArbFloat;
diff --git a/packages/numlib/src/typ.pas b/packages/numlib/src/typ.pas
index 642bf6c0d5..68fea7bc6d 100644
--- a/packages/numlib/src/typ.pas
+++ b/packages/numlib/src/typ.pas
@@ -35,6 +35,9 @@ Also some stuff had to be added to get ipf running (vector object and
 complex.inp and scale methods)
  }
 
+{$mode objfpc}{$H+}
+{$modeswitch nestedprocvars}
+
 unit typ;
 
 {$I DIRECT.INC}                 {Contains "global" compilerswitches which
@@ -44,6 +47,9 @@ unit typ;
 
 interface
 
+uses
+  Math;
+
 
 CONST numlib_version=2;         {used to detect version conflicts between
                                   header unit and dll}
@@ -68,10 +74,8 @@ CONST {Some constants for the variables below, in binary formats.}
     TC1 :  Float8Arb  = ($00,$00,$00,$00,$00,$00,$B0,$3C);
     TC2 :  Float8Arb  = ($FF,$FF,$FF,$FF,$FF,$FF,$EF,$7F);
     TC3 :  Float8Arb  = ($00,$00,$00,$00,$01,$00,$10,$00);
-    TC4 :  Float8Arb  = ($00,$00,$00,$00,$00,$00,$F0,$7F);
     TC5 :  Float8Arb  = ($EF,$39,$FA,$FE,$42,$2E,$86,$40);
     TC6 :  Float8Arb  = ($D6,$BC,$FA,$BC,$2B,$23,$86,$C0);
-    TC7 :  Float8Arb  = ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
 {$ENDIF}
 
      {For Extended}
@@ -79,10 +83,8 @@ CONST {Some constants for the variables below, in binary formats.}
     TC1 : Float10Arb = (0,0,$00,$00,$00,$00,0,128,192,63);         {Eps}
     TC2 : Float10Arb = ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$D6,$FE,127);  {9.99188560553925115E+4931}
     TC3 : Float10Arb = (1,0,0,0,0,0,0,0,0,0);                      {3.64519953188247460E-4951}
-    TC4 : Float10Arb = (0,0,0,0,0,0,0,$80,$FF,$7F);                {Inf}
     TC5 : Float10Arb = (18,25,219,91,61,101,113,177,12,64);        {1.13563488668777920E+0004}
     TC6 : Float10Arb = (108,115,3,170,182,56,27,178,12,192);       {-1.13988053843083006E+0004}
-    TC7 : Float10Arb = ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);  {NaN}
 {$ENDIF}
   { numdig  is the number of useful (safe) decimal places of an "ArbFloat"
             for display.
@@ -100,11 +102,8 @@ var
                                         the smallest ArbFloat > 1}
     giant    : ArbFloat absolute TC2;  { the largest ArbFloat}
     midget   : ArbFloat absolute TC3;  { the smallest positive ArbFloat}
-    infinity : ArbFloat absolute TC4;  { INF as defined in IEEE-754(double)
-                                         or intel (for extended)}
     LnGiant  : ArbFloat absolute TC5;  {ln of giant}
     LnMidget : ArbFloat absolute TC6;  {ln of midget}
-    NaN      : ArbFloat absolute TC7;  {Not A Number}
 
 {Copied from Det. Needs ArbExtended conditional}
 const               {  og = 8^-maxexp, og�>=midget,
@@ -186,6 +185,7 @@ type
 
      {Standard Functions used in NumLib}
      rfunc1r    = Function(x : ArbFloat): ArbFloat;
+     rfunc1rn   = Function(x : ArbFloat): ArbFloat is nested;
      rfunc2r    = Function(x, y : ArbFloat): ArbFloat;
 
      {Complex version}
diff --git a/packages/odbc/src/odbcsql.inc b/packages/odbc/src/odbcsql.inc
index 34d2f076e4..c6ce7bd274 100644
--- a/packages/odbc/src/odbcsql.inc
+++ b/packages/odbc/src/odbcsql.inc
@@ -68,6 +68,7 @@ uses
 
 type
   SQLCHAR      = cuchar;
+  SQLWCHAR     = WideChar;
   SQLSCHAR     = cschar;
   SQLSMALLINT  = csshort;
   SQLUSMALLINT = cushort;
@@ -87,7 +88,8 @@ type
   SQLHDESC     = SQLHANDLE;
   SQLHWND      = pointer;
   SQLSETPOSIROW= {$IF DEFINED(CPU64) AND DEFINED(ODBCVER352)}cuint64{$ELSE}SQLUSMALLINT{$ENDIF};
-  PSQLCHAR      = PChar;
+  PSQLCHAR      = PAnsiChar;
+  PSQLWCHAR     = PWideChar;
   PSQLSMALLINT  = ^SQLSMALLINT;
   PSQLUSMALLINT = ^SQLUSMALLINT;
   PSQLINTEGER   = ^SQLINTEGER;
@@ -211,6 +213,7 @@ const
   { C datatype to SQL datatype mapping }
   SQL_C_CHAR   = SQL_CHAR;
   SQL_C_WCHAR  = SQL_WCHAR;
+  SQL_C_TCHAR  = {$IFDEF UNICODE}SQL_C_WCHAR{$ELSE}SQL_C_CHAR{$ENDIF};
   SQL_C_LONG   = SQL_INTEGER;
   SQL_C_SHORT  = SQL_SMALLINT;
   SQL_C_FLOAT  = SQL_REAL;
@@ -1066,10 +1069,10 @@ const
 
 {$ifdef DYNLOADINGODBC}
 
-type   tSQLAllocHandle =function(HandleType: SQLSMALLINT;
+type   TSQLAllocHandle =function(HandleType: SQLSMALLINT;
            InputHandle:SQLHANDLE;Var OutputHandlePtr: SQLHANDLE):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
-type   tSQLSetEnvAttr=function (EnvironmentHandle:SQLHENV;
+type   TSQLSetEnvAttr=function (EnvironmentHandle:SQLHENV;
            Attribute:SQLINTEGER;Value:SQLPOINTER;
            StringLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
@@ -1078,9 +1081,15 @@ type   TSQLFreeHandle=function (HandleType:SQLSMALLINT;
 
 type   TSQLGetDiagRec=function (HandleType:SQLSMALLINT;
            Handle:SQLHANDLE;RecNumber:SQLSMALLINT;
-           Sqlstate:PSQLCHAR;var NativeError:SQLINTEGER;
+           SqlState:PSQLCHAR;var NativeError:SQLINTEGER;
            MessageText:PSQLCHAR;BufferLength:SQLSMALLINT;
            var TextLength:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLGetDiagRecW=function (HandleType:SQLSMALLINT;
+           Handle:SQLHANDLE;RecNumber:SQLSMALLINT;
+           SqlState:PSQLWCHAR;var NativeError:SQLINTEGER;
+           MessageText:PSQLWCHAR;BufferLength:SQLSMALLINT;
+           var TextLength:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+
 
 type   TSQLGetDiagField=function (HandleType:SQLSMALLINT;
            Handle:SQLHANDLE;RecNumber:SQLSMALLINT;
@@ -1091,20 +1100,33 @@ type   TSQLConnect=function (ConnectionHandle:SQLHDBC;
            ServerName:PSQLCHAR;NameLength1:SQLSMALLINT;
            UserName:PSQLCHAR;NameLength2:SQLSMALLINT;
            Authentication:PSQLCHAR;NameLength3:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLConnectW=function (ConnectionHandle:SQLHDBC;
+           ServerName:PSQLWCHAR;NameLength1:SQLSMALLINT;
+           UserName:PSQLWCHAR;NameLength2:SQLSMALLINT;
+           Authentication:PSQLWCHAR;NameLength3:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLDisconnect=function(ConnectionHandle:SQLHDBC):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
-type   TSQLDriverConnect=function (hdbc: SQLHDBC;
-           hwnd: SQLHWND;szCsin: PChar;
-           szCLen: SQLSMALLINT;szCsout: PChar;
-           cbCSMax: SQLSMALLINT;Var cbCsOut: SQLSMALLINT;
-           f: SQLUSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+type   TSQLDriverConnect=function (ConnectionHandle: SQLHDBC;
+           WindowHandle: SQLHWND; InConnectionString: PSQLCHAR;
+           StringLength1: SQLSMALLINT; OutConnectionString: PSQLCHAR;
+           BufferLength: SQLSMALLINT; Var StringLength2: SQLSMALLINT;
+           DriverCompletion: SQLUSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLDriverConnectW=function (ConnectionHandle: SQLHDBC;
+           WindowHandle: SQLHWND; InConnectionString: PSQLWCHAR;
+           StringLength1: SQLSMALLINT; OutConnectionString: PSQLWCHAR;
+           BufferLength: SQLSMALLINT; Var StringLength2: SQLSMALLINT;
+           DriverCompletion: SQLUSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLExecDirect=function (StatementHandle:SQLHSTMT;
            StatementText:PSQLCHAR;TextLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLExecDirectW=function (StatementHandle:SQLHSTMT;
+           StatementText:PSQLWCHAR;TextLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLPrepare=function (StatementHandle:SQLHSTMT;
            StatementText:PSQLCHAR;TextLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLPrepareW=function (StatementHandle:SQLHSTMT;
+           StatementText:PSQLWCHAR;TextLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLCloseCursor=function (StatementHandle:SQLHSTMT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
@@ -1120,6 +1142,11 @@ type   TSQLDescribeCol=function (StatementHandle:SQLHSTMT;
            BufferLength:SQLSMALLINT;var NameLength:SQLSMALLINT;
            var DataType:SQLSMALLINT;var ColumnSize:SQLULEN;
            var DecimalDigits:SQLSMALLINT;var Nullable:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLDescribeColW=function (StatementHandle:SQLHSTMT;
+           ColumnNumber:SQLUSMALLINT;ColumnName:PSQLWCHAR;
+           BufferLength:SQLSMALLINT;var NameLength:SQLSMALLINT;
+           var DataType:SQLSMALLINT;var ColumnSize:SQLULEN;
+           var DecimalDigits:SQLSMALLINT;var Nullable:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLFetchScroll=function (StatementHandle:SQLHSTMT;
            FetchOrientation:SQLSMALLINT;FetchOffset:SQLLEN):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
@@ -1150,7 +1177,7 @@ type   TSQLSetDescRec=function (DescriptorHandle:SQLHDESC;
            Length:SQLLEN; Precision, Scale: SQLSMALLINT;
            DataPtr:SQLPOINTER; StringLengthPtr,IndicatorPtr:PSQLLEN):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
-type   tSQLGetInfo=function (ConnectionHandle:SQLHDBC;
+type   TSQLGetInfo=function (ConnectionHandle:SQLHDBC;
            InfoType:SQLUSMALLINT;InfoValue:SQLPOINTER;
            BufferLength:SQLSMALLINT;StringLength:PSQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
@@ -1207,8 +1234,8 @@ type   TSQLFreeStmt=function (StatementHandle:SQLHSTMT;
 
 type   TSQLColAttribute=function (StatementHandle:SQLHSTMT;
            ColumnNumber:SQLUSMALLINT;FieldIdentifier:SQLUSMALLINT;
-           CharacterAttribute:PSQLCHAR;BufferLength:SQLSMALLINT;
-           StringLength:PSQLSMALLINT;NumericAttribute:PSQLLEN):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+           CharacterAttributePtr:SQLPOINTER;BufferLength:SQLSMALLINT;
+           StringLengthPtr:PSQLSMALLINT;NumericAttributePtr:PSQLLEN):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLEndTran=function (HandleType:SQLSMALLINT;
            Handle:SQLHANDLE;CompletionType:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
@@ -1218,12 +1245,22 @@ type   TSQLTables=function ( hstmt : SQLHSTMT;
            szTableOwner : PSQLCHAR;cbTableOwner : SQLSMALLINT;
            szTableName : PSQLCHAR;cbTableName : SQLSMALLINT;
            szTableType : PSQLCHAR;cbTableType : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLTablesW=function ( hstmt : SQLHSTMT;
+           szTableQualifier : PSQLWCHAR;cbTableQualifier : SQLSMALLINT;
+           szTableOwner : PSQLWCHAR;cbTableOwner : SQLSMALLINT;
+           szTableName : PSQLWCHAR;cbTableName : SQLSMALLINT;
+           szTableType : PSQLWCHAR;cbTableType : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLColumns=function ( hstmt : SQLHSTMT;
            szTableQualifier : PSQLCHAR;cbTableQualifier : SQLSMALLINT;
            szTableOwner : PSQLCHAR;cbTableOwner : SQLSMALLINT;
            szTableName : PSQLCHAR;cbTableName : SQLSMALLINT;
            szColumnName : PSQLCHAR;cbColumnName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
+      TSQLColumnsW=function ( hstmt : SQLHSTMT;
+           szTableQualifier : PSQLWCHAR;cbTableQualifier : SQLSMALLINT;
+           szTableOwner : PSQLWCHAR;cbTableOwner : SQLSMALLINT;
+           szTableName : PSQLWCHAR;cbTableName : SQLSMALLINT;
+           szColumnName : PSQLWCHAR;cbColumnName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 type   TSQLSpecialColumns=function (StatementHandle:SQLHSTMT;
            IdentifierType:SQLUSMALLINT;CatalogName:PSQLCHAR;
@@ -1236,42 +1273,60 @@ type   TSQLProcedures=function ( hstmt : SQLHSTMT;
            szTableQualifier : PSQLCHAR;cbTableQualifier : SQLSMALLINT;
            szTableOwner : PSQLCHAR;cbTableOwner : SQLSMALLINT;
            szTableName : PSQLCHAR;cbTableName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLProceduresW=function ( hstmt : SQLHSTMT;
+           szTableQualifier : PSQLWCHAR;cbTableQualifier : SQLSMALLINT;
+           szTableOwner : PSQLWCHAR;cbTableOwner : SQLSMALLINT;
+           szTableName : PSQLWCHAR;cbTableName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
 
-type   TSQLPrimaryKeys=function (hstmt : SQLHSTMT;
-           CatalogName:PSQLCHAR;NameLength1:SQLSMALLINT;
-           SchemaName:PSQLCHAR;NameLength2:SQLSMALLINT;
-           TableName:PSQLCHAR;NameLength3:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
 type   TSQLProcedureColumns = function(hstmt: SQLHSTMT;
            CatalogName: PSQLCHAR; NameLength1: SQLSMALLINT;
            SchemaName: PSQLCHAR; NameLength2: SQLSMALLINT;
            ProcName: PSQLCHAR; NameLength3: SQLSMALLINT;
            ColumnName: PSQLCHAR; NameLength4: SQLSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
+
+type   TSQLPrimaryKeys=function (hstmt : SQLHSTMT;
+           CatalogName:PSQLCHAR;NameLength1:SQLSMALLINT;
+           SchemaName:PSQLCHAR;NameLength2:SQLSMALLINT;
+           TableName:PSQLCHAR;NameLength3:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLPrimaryKeysW=function (hstmt : SQLHSTMT;
+           CatalogName:PSQLWCHAR;NameLength1:SQLSMALLINT;
+           SchemaName:PSQLWCHAR;NameLength2:SQLSMALLINT;
+           TableName:PSQLWCHAR;NameLength3:SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};
+
 type   TSQLStatistics = function (hstmt: SQLHSTMT;
            CatalogName:PSQLCHAR; NameLength1:SQLSMALLINT;
            SchemaName:PSQLCHAR; NameLength2:SQLSMALLINT;
            TableName:PSQLCHAR; NameLength3:SQLSMALLINT;
            Unique:SQLUSMALLINT;
            Reserved:SQLUSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
+       TSQLStatisticsW = function (hstmt: SQLHSTMT;
+           CatalogName:PSQLWCHAR; NameLength1:SQLSMALLINT;
+           SchemaName:PSQLWCHAR; NameLength2:SQLSMALLINT;
+           TableName:PSQLWCHAR; NameLength3:SQLSMALLINT;
+           Unique:SQLUSMALLINT;
+           Reserved:SQLUSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
 
 var    SQLAllocHandle:tSQLAllocHandle;
 var    SQLSetEnvAttr:tSQLSetEnvAttr;
 var    SQLFreeHandle:tSQLFreeHandle;
 var    SQLGetInfo:tSQLGetInfo;
-var    SQLProcedures:TSQLProcedures;
-var    SQLColumns:TSQLColumns;
-var    SQLSpecialColumns:TSQLSpecialColumns;
 var    SQLGetDiagRec:TSQLGetDiagRec;
 var    SQLGetDiagField:TSQLGetDiagField;
 var    SQLConnect:TSQLConnect;
+       SQLConnectW:TSQLConnectW;
 var    SQLDisconnect:TSQLDisconnect;
 var    SQLDriverConnect:TSQLDriverConnect;
+       SQLDriverConnectW:TSQLDriverConnectW;
 var    SQLExecDirect:TSQLExecDirect;
+       SQLExecDirectW:TSQLExecDirectW;
 var    SQLPrepare:TSQLPrepare;
+       SQLPrepareW:TSQLPrepareW;
 var    SQLCloseCursor:TSQLCloseCursor;
 var    SQLExecute:TSQLExecute;
 var    SQLFetch:TSQLFetch;
 var    SQLNumResultCols:TSQLNumResultCols;
 var    SQLDescribeCol:TSQLDescribeCol;
+       SQLDescribeColW:TSQLDescribeColW;
 var    SQLFetchScroll:TSQLFetchScroll;
 var    SQLExtendedFetch:TSQLExtendedFetch;
 var    SQLGetData:TSQLGetData;
@@ -1294,9 +1349,18 @@ var    SQLFreeStmt:TSQLFreeStmt;
 var    SQLColAttribute:TSQLColAttribute;
 var    SQLEndTran:TSQLEndTran;
 var    SQLTables:TSQLTables;
+       SQLTablesW:TSQLTablesW;
+var    SQLColumns:TSQLColumns;
+       SQLColumnsW:TSQLColumnsW;
+var    SQLSpecialColumns:TSQLSpecialColumns;
 var    SQLPrimaryKeys:TSQLPrimaryKeys;
+       SQLPrimaryKeysW:TSQLPrimaryKeysW;
+var    SQLProcedures:TSQLProcedures;
+       SQLProceduresW:TSQLProceduresW;
 var    SQLProcedureColumns : TSQLProcedureColumns;
 var    SQLStatistics: TSQLStatistics;
+       SQLStatisticsW: TSQLStatisticsW;
+
 var    odbcversion:word;
 
 {$else}
@@ -1323,11 +1387,20 @@ var    odbcversion:word;
                HandleType:   SQLSMALLINT;
                Handle:       SQLHANDLE;
                RecNumber:    SQLSMALLINT;
-               Sqlstate:     PSQLCHAR;
+               SqlState:     PSQLCHAR;
                var NativeError: SQLINTEGER;
                MessageText:     PSQLCHAR;
                BufferLength:    SQLSMALLINT;
                var TextLength:  SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLGetDiagRecW(
+               HandleType:   SQLSMALLINT;
+               Handle:       SQLHANDLE;
+               RecNumber:    SQLSMALLINT;
+               SqlState:     PSQLWCHAR;
+               var NativeError: SQLINTEGER;
+               MessageText:     PSQLWCHAR;
+               BufferLength:    SQLSMALLINT;
+               var TextLength:  SQLSMALLINT ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLGetDiagField(
                HandleType:SQLSMALLINT;
                Handle:SQLHANDLE;
@@ -1342,17 +1415,26 @@ var    odbcversion:word;
                UserName:PSQLCHAR;      NameLength2:SQLSMALLINT;
                Authentication:PSQLCHAR;NameLength3:SQLSMALLINT
               ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLConnectW(
+               ConnectionHandle: SQLHDBC;
+               ServerName:PSQLWCHAR;    NameLength1:SQLSMALLINT;
+               UserName:PSQLWCHAR;      NameLength2:SQLSMALLINT;
+               Authentication:PSQLWCHAR;NameLength3:SQLSMALLINT
+              ):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLDisconnect(
                ConnectionHandle:SQLHDBC):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLDriverConnect(
-               hdbc: SQLHDBC;
-               hwnd: SQLHWND;
-               szCsin: PChar;
-               szCLen: SQLSMALLINT;
-               szCsout: PChar;
-               cbCSMax: SQLSMALLINT;
-               Var cbCsOut: SQLSMALLINT;
-               f: SQLUSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+               ConnectionHandle: SQLHDBC;
+               WindowHandle: SQLHWND; InConnectionString: PSQLCHAR;
+               StringLength1: SQLSMALLINT; OutConnectionString: PSQLCHAR;
+               BufferLength: SQLSMALLINT; Var StringLength2: SQLSMALLINT;
+               DriverCompletion: SQLUSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLDriverConnectW(
+               ConnectionHandle: SQLHDBC;
+               WindowHandle: SQLHWND; InConnectionString: PSQLWCHAR;
+               StringLength1: SQLSMALLINT; OutConnectionString: PSQLWCHAR;
+               BufferLength: SQLSMALLINT; Var StringLength2: SQLSMALLINT;
+               DriverCompletion: SQLUSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLBrowseConnect(
                hdbc : SQLHDBC;
                szConnStrIn :PSQLCHAR;
@@ -1364,10 +1446,18 @@ var    odbcversion:word;
                StatementHandle:SQLHSTMT;
                StatementText:  PSQLCHAR;
                TextLength:     SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLExecDirectW(
+               StatementHandle:SQLHSTMT;
+               StatementText:  PSQLWCHAR;
+               TextLength:     SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLPrepare(
                StatementHandle:SQLHSTMT;
                StatementText:PSQLCHAR;
                TextLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLPrepareW(
+               StatementHandle:SQLHSTMT;
+               StatementText:PSQLWCHAR;
+               TextLength:SQLINTEGER):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLCloseCursor(
                StatementHandle:SQLHSTMT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLExecute(
@@ -1387,6 +1477,16 @@ var    odbcversion:word;
                var ColumnSize:SQLULEN;
                var DecimalDigits:SQLSMALLINT;
                var Nullable:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLDescribeColW(
+               StatementHandle:SQLHSTMT;
+               ColumnNumber:SQLUSMALLINT;
+               ColumnName:PSQLWCHAR;
+               BufferLength:SQLSMALLINT;
+               var NameLength:SQLSMALLINT;
+               var DataType:SQLSMALLINT;
+               var ColumnSize:SQLULEN;
+               var DecimalDigits:SQLSMALLINT;
+               var Nullable:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLFetchScroll(
                StatementHandle:SQLHSTMT;
                FetchOrientation:SQLSMALLINT;
@@ -1491,10 +1591,10 @@ var    odbcversion:word;
                StatementHandle:SQLHSTMT;
                ColumnNumber:SQLUSMALLINT;
                FieldIdentifier:SQLUSMALLINT;
-               CharacterAttribute:PSQLCHAR;
+               CharacterAttributePtr:SQLPOINTER;
                BufferLength:SQLSMALLINT;
-               StringLength:PSQLSMALLINT;
-               NumericAttribute:PSQLLEN):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+               StringLengthPtr:PSQLSMALLINT;
+               NumericAttributePtr:PSQLLEN):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
 {$ifdef ODBCVER3}
    function SQLEndTran(
                HandleType:SQLSMALLINT;
@@ -1510,6 +1610,15 @@ var    odbcversion:word;
                 cbTableName : SQLSMALLINT;
                 szTableType : PSQLCHAR;
                 cbTableType : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
+   function SQLTablesW( hstmt : SQLHSTMT;
+                szTableQualifier : PSQLWCHAR;
+                cbTableQualifier : SQLSMALLINT;
+                szTableOwner : PSQLWCHAR;
+                cbTableOwner : SQLSMALLINT;
+                szTableName : PSQLWCHAR;
+                cbTableName : SQLSMALLINT;
+                szTableType : PSQLWCHAR;
+                cbTableType : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
    function SQLColumns( hstmt : SQLHSTMT;
                 szTableQualifier : PSQLCHAR;
                 cbTableQualifier : SQLSMALLINT;
@@ -1519,6 +1628,15 @@ var    odbcversion:word;
                 cbTableName : SQLSMALLINT;
                 szColumnName : PSQLCHAR;
                 cbColumnName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
+   function SQLColumnsW( hstmt : SQLHSTMT;
+                szTableQualifier : PSQLWCHAR;
+                cbTableQualifier : SQLSMALLINT;
+                szTableOwner : PSQLWCHAR;
+                cbTableOwner : SQLSMALLINT;
+                szTableName : PSQLWCHAR;
+                cbTableName : SQLSMALLINT;
+                szColumnName : PSQLWCHAR;
+                cbColumnName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
    function SQLSpecialColumns(StatementHandle:SQLHSTMT;
                 IdentifierType:SQLUSMALLINT;
                 CatalogName:PSQLCHAR;
@@ -1536,23 +1654,38 @@ var    odbcversion:word;
                 cbTableOwner : SQLSMALLINT;
                 szTableName : PSQLCHAR;
                 cbTableName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
+   function SQLProceduresW( hstmt : SQLHSTMT;
+                szTableQualifier : PSQLWCHAR;
+                cbTableQualifier : SQLSMALLINT;
+                szTableOwner : PSQLWCHAR;
+                cbTableOwner : SQLSMALLINT;
+                szTableName : PSQLWCHAR;
+                cbTableName : SQLSMALLINT ) : SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
    function SQLPrimaryKeys(hstmt : SQLHSTMT;
-                CatalogName:PSQLCHAR;NameLength1:SQLSMALLINT;
-                SchemaName:PSQLCHAR;NameLength2:SQLSMALLINT;
-                TableName:PSQLCHAR;
-                NameLength3:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+                CatalogName:PSQLCHAR; NameLength1:SQLSMALLINT;
+                SchemaName:PSQLCHAR; NameLength2:SQLSMALLINT;
+                TableName:PSQLCHAR; NameLength3:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
+   function SQLPrimaryKeysW(hstmt : SQLHSTMT;
+                CatalogName:PSQLWCHAR; NameLength1:SQLSMALLINT;
+                SchemaName:PSQLWCHAR; NameLength2:SQLSMALLINT;
+                TableName:PSQLWCHAR; NameLength3:SQLSMALLINT):SQLRETURN;{$ifdef fpc} extdecl {$else} stdcall {$endif};external odbclib;
    function SQLProcedureColumns(hstmt: SQLHSTMT;
                 CatalogName: PSQLCHAR; NameLength1: SQLSMALLINT;
                 SchemaName: PSQLCHAR; NameLength2: SQLSMALLINT;
                 ProcName: PSQLCHAR; NameLength3: SQLSMALLINT;
-                ColumnName: PSQLCHAR; NameLength4: SQLSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif};
-                external odbclib;
+                ColumnName: PSQLCHAR; NameLength4: SQLSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
    function SQLStatistics(hstmt: SQLHSTMT;
                 CatalogName:PSQLCHAR; NameLength1:SQLSMALLINT;
                 SchemaName:PSQLCHAR; NameLength2:SQLSMALLINT;
                 TableName:PSQLCHAR; NameLength3:SQLSMALLINT;
                 Unique:SQLUSMALLINT;
                 Reserved:SQLUSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
+   function SQLStatisticsW(hstmt: SQLHSTMT;
+                CatalogName:PSQLWCHAR; NameLength1:SQLSMALLINT;
+                SchemaName:PSQLWCHAR; NameLength2:SQLSMALLINT;
+                TableName:PSQLWCHAR; NameLength3:SQLSMALLINT;
+                Unique:SQLUSMALLINT;
+                Reserved:SQLUSMALLINT): SQLRETURN; {$ifdef fpc} extdecl {$else} stdcall {$endif}; external odbclib;
 {$endif}
 // This function always load dynamic
 
@@ -1598,12 +1731,11 @@ begin
       end;
 
 {$ifdef fpc}
+    // Ansi versions:
     pointer(SQLAllocHandle) := GetProcedureAddress(ODBCLibraryHandle,'SQLAllocHandle');
     pointer(SQLSetEnvAttr) := GetProcedureAddress(ODBCLibraryHandle,'SQLSetEnvAttr');
     pointer(SQLFreeHandle) := GetProcedureAddress(ODBCLibraryHandle,'SQLFreeHandle');
     pointer(SQLGetInfo) := GetProcedureAddress(ODBCLibraryHandle,'SQLGetInfo');
-    pointer(SQLProcedures) := GetProcedureAddress(ODBCLibraryHandle,'SQLProcedures');
-    pointer(SQLColumns) := GetProcedureAddress(ODBCLibraryHandle,'SQLColumns');
     pointer(SQLSpecialColumns) := GetProcedureAddress(ODBCLibraryHandle,'SQLSpecialColumns');
     pointer(SQLGetDiagRec) := GetProcedureAddress(ODBCLibraryHandle,'SQLGetDiagRec');
     pointer(SQLGetDiagField) := GetProcedureAddress(ODBCLibraryHandle,'SQLGetDiagField');
@@ -1639,9 +1771,22 @@ begin
     pointer(SQLColAttribute) := GetProcedureAddress(ODBCLibraryHandle,'SQLColAttribute');
     pointer(SQLEndTran) := GetProcedureAddress(ODBCLibraryHandle,'SQLEndTran');
     pointer(SQLTables) := GetProcedureAddress(ODBCLibraryHandle,'SQLTables');
+    pointer(SQLColumns) := GetProcedureAddress(ODBCLibraryHandle,'SQLColumns');
     pointer(SQLPrimaryKeys) := GetProcedureAddress(ODBCLibraryHandle,'SQLPrimaryKeys');
+    pointer(SQLProcedures) := GetProcedureAddress(ODBCLibraryHandle,'SQLProcedures');
     pointer(SQLProcedureColumns) := GetProcedureAddress(ODBCLibraryHandle,'SQLProcedureColumns');
     pointer(SQLStatistics) := GetProcedureAddress(ODBCLibraryHandle,'SQLStatistics');
+    // Unicode versions:
+    pointer(SQLConnectW) := GetProcedureAddress(ODBCLibraryHandle,'SQLConnectW');
+    pointer(SQLDriverConnectW) := GetProcedureAddress(ODBCLibraryHandle,'SQLDriverConnectW');
+    pointer(SQLExecDirectW) := GetProcedureAddress(ODBCLibraryHandle,'SQLExecDirectW');
+    pointer(SQLPrepareW) := GetProcedureAddress(ODBCLibraryHandle,'SQLPrepareW');
+    pointer(SQLDescribeColW) := GetProcedureAddress(ODBCLibraryHandle,'SQLDescribeColW');
+    pointer(SQLTablesW) := GetProcedureAddress(ODBCLibraryHandle,'SQLTablesW');
+    pointer(SQLColumnsW) := GetProcedureAddress(ODBCLibraryHandle,'SQLColumnsW');
+    pointer(SQLProceduresW) := GetProcedureAddress(ODBCLibraryHandle,'SQLProceduresW');
+    pointer(SQLPrimaryKeysW) := GetProcedureAddress(ODBCLibraryHandle,'SQLPrimaryKeysW');
+    pointer(SQLStatisticsW) := GetProcedureAddress(ODBCLibraryHandle,'SQLStatisticsW');
 {$else}
     SQLAllocHandle := GetProcedureAddress(ODBCLibraryHandle,'SQLAllocHandle');
     SQLSetEnvAttr := GetProcedureAddress(ODBCLibraryHandle,'SQLSetEnvAttr');
diff --git a/packages/openssl/src/fpopenssl.pp b/packages/openssl/src/fpopenssl.pp
index 7190d6878e..81fc486e3e 100644
--- a/packages/openssl/src/fpopenssl.pp
+++ b/packages/openssl/src/fpopenssl.pp
@@ -21,7 +21,7 @@ interface
 uses
   Classes, SysUtils, openssl, ctypes;
 Type
-  TSSLType = (stAny,stSSLv2,stSSLv3,stTLSv1);
+  TSSLType = (stAny,stSSLv2,stSSLv3,stTLSv1,stTLSv1_1,stTLSv1_2);
 
   //  PASN1_INTEGER = SslPtr;
 
@@ -42,6 +42,14 @@ Type
 
   { TSSLContext }
 
+  TSSLContext = Class;
+  TRTlsExtCtx = record
+    CTX: TSSLContext;
+    domains: array of string; // SSL Certificate with one or more alternative names (SAN)
+  end;
+  TTlsExtCtx = array of TRTlsExtCtx;
+  PTlsExtCtx = ^TTlsExtCtx;
+
   TSSLContext = Class(TObject)
   private
     FCTX: PSSL_CTX;
@@ -66,6 +74,11 @@ Type
     function LoadVerifyLocations(const CAfile: String; const CApath: String):cInt;
     function LoadPFX(Const S,APassword : AnsiString) : cint;
     function LoadPFX(Data : TSSLData; Const APAssword : Ansistring) : cint;
+    function SetOptions(AOptions: cLong): cLong;
+    procedure SetTlsextServernameCallback(cb: PCallbackCb);
+    procedure SetTlsextServernameArg(ATlsextcbp: SslPtr);
+    procedure ActivateServerSNI(ATlsextcbp: TTlsExtCtx);
+    procedure SetEcdhAuto(const onoff: boolean);
     Property CTX: PSSL_CTX Read FCTX;
   end;
 
@@ -127,6 +140,33 @@ begin
     SetLength(Result,0);
 end;
 
+function SelectSNIContextCallback(ASSL: TSSL; ad: integer; arg: TTlsExtCtx): integer; cdecl;
+var
+  sHostName: string;
+  o, i, f: integer;
+begin
+  sHostName := SSLGetServername(ASSL, TLSEXT_NAMETYPE_host_name);
+  if (sHostName <> '') and (length(arg) > 0) then
+  begin
+    f := -1;
+    for o:=0 to length(arg)-1 do
+    begin
+      for i:=0 to length(arg[o].domains)-1 do
+        if sHostName = arg[o].domains[i] then
+        begin
+          f := o;
+          break;
+        end;
+      if f <> -1 then break
+    end;
+    if f = -1 then
+      result := SSL_TLSEXT_ERR_NOACK
+    else if f > 1 then // first one should be the main certificate
+      SslSetSslCtx(ASSL, arg[f].CTX);
+  end;
+  result := SSL_TLSEXT_ERR_OK;
+end;
+
 { TSSLContext }
 
 Constructor TSSLContext.Create(AContext: PSSL_CTX);
@@ -140,11 +180,14 @@ Var
   C : PSSL_CTX;
 
 begin
+  C := nil;
   Case AType of
     stAny:  C := SslCtxNew(SslMethodV23);
     stSSLv2: C := SslCtxNew(SslMethodV2);
     stSSLv3: C := SslCtxNew(SslMethodV3);
     stTLSv1: C := SslCtxNew(SslMethodTLSV1);
+    stTLSv1_1: C := SslCtxNew(SslMethodTLSV1_1);
+    stTLSv1_2: C := SslCtxNew(SslMethodTLSV1_2);
   end;
   if (C=Nil) then
      Raise ESSL.Create(SErrCountNotGetContext);
@@ -327,6 +370,36 @@ begin
   end;
 end;
 
+function TSSLContext.SetOptions(AOptions: cLong): cLong;
+begin
+  result := SslCtxCtrl(FCTX, SSL_CTRL_OPTIONS, AOptions, nil);
+end;
+
+procedure TSSLContext.SetTlsextServernameCallback(cb: PCallbackCb);
+begin
+  SslCtxCallbackCtrl(FCTX, SSL_CTRL_SET_TLSEXT_SERVERNAME_CB, cb);
+end;
+
+procedure TSSLContext.SetTlsextServernameArg(ATlsextcbp: SslPtr);
+begin
+  SslCtxCtrl(FCTX, SSL_CTRL_SET_TLSEXT_SERVERNAME_ARG, 0, ATlsextcbp);
+end;
+
+procedure TSSLContext.ActivateServerSNI(ATlsextcbp: TTlsExtCtx);
+begin
+  SetTlsextServernameCallback(@SelectSNIContextCallback);
+  SetTlsextServernameArg(Pointer(ATlsextcbp));
+end;
+
+procedure TSSLContext.SetEcdhAuto(const onoff: boolean);
+var larg: clong;
+begin
+  if onoff then
+    larg := 1
+  else
+    larg := 0;
+  SslCtxCtrl(FCTX, SSL_CTRL_SET_ECDH_AUTO, larg, nil);
+end;
 
 { TSSLData }
 
diff --git a/packages/openssl/src/openssl.pas b/packages/openssl/src/openssl.pas
index fd47de2f91..2f8cc458d2 100644
--- a/packages/openssl/src/openssl.pas
+++ b/packages/openssl/src/openssl.pas
@@ -207,7 +207,8 @@ type
     aux: pointer;  // ^X509_CERT_AUX
   end;
   pX509 = ^X509;
-
+  PPX509 = ^PX509;
+  
   DSA = record
 	pad: integer;
 	version: integer;
@@ -252,6 +253,7 @@ type
   PPRSA = ^PRSA;
   PASN1_cInt = SslPtr;
   PPasswdCb = SslPtr;
+  PCallbackCb = SslPtr;
   PFunction = procedure;
   DES_cblock = array[0..7] of Byte;
   PDES_cblock = ^DES_cblock;
@@ -567,7 +569,9 @@ const
   SSL_ERROR_ZERO_RETURN = 6;
   SSL_ERROR_WANT_CONNECT = 7;
   SSL_ERROR_WANT_ACCEPT = 8;
-  
+  SSL_ERROR_WANT_CHANNEL_ID_LOOKUP = 9;
+  SSL_ERROR_PENDING_SESSION = 11;
+
   SSL_CTRL_NEED_TMP_RSA = 1;
   SSL_CTRL_SET_TMP_RSA = 2;
   SSL_CTRL_SET_TMP_DH = 3;
@@ -640,7 +644,36 @@ const
   SSL_CTRL_TLS_EXT_SEND_HEARTBEAT             = 85;
   SSL_CTRL_GET_TLS_EXT_HEARTBEAT_PENDING      = 86;
   SSL_CTRL_SET_TLS_EXT_HEARTBEAT_NO_REQUESTS  = 87;
-  // Some missing values ?
+  SSL_CTRL_CHAIN                              = 88;
+  SSL_CTRL_CHAIN_CERT                         = 89;
+  SSL_CTRL_GET_CURVES                         = 90;
+  SSL_CTRL_SET_CURVES                         = 91;
+  SSL_CTRL_SET_CURVES_LIST                    = 92;
+  SSL_CTRL_GET_SHARED_CURVE                   = 93;
+  SSL_CTRL_SET_ECDH_AUTO                      = 94;
+  SSL_CTRL_SET_SIGALGS                        = 97;
+  SSL_CTRL_SET_SIGALGS_LIST                   = 98;
+  SSL_CTRL_CERT_FLAGS                         = 99;
+  SSL_CTRL_CLEAR_CERT_FLAGS                   = 100;
+  SSL_CTRL_SET_CLIENT_SIGALGS                 = 101;
+  SSL_CTRL_SET_CLIENT_SIGALGS_LIST            = 102;
+  SSL_CTRL_GET_CLIENT_CERT_TYPES              = 103;
+  SSL_CTRL_SET_CLIENT_CERT_TYPES              = 104;
+  SSL_CTRL_BUILD_CERT_CHAIN                   = 105;
+  SSL_CTRL_SET_VERIFY_CERT_STORE              = 106;
+  SSL_CTRL_SET_CHAIN_CERT_STORE               = 107;
+  SSL_CTRL_GET_PEER_SIGNATURE_NID             = 108;
+  SSL_CTRL_GET_SERVER_TMP_KEY                 = 109;
+  SSL_CTRL_GET_RAW_CIPHERLIST                 = 110;
+  SSL_CTRL_GET_EC_POINT_FORMATS               = 111;
+  SSL_CTRL_GET_TLSA_RECORD                    = 112;
+  SSL_CTRL_SET_TLSA_RECORD                    = 113;
+  SSL_CTRL_PULL_TLSA_RECORD                   = 114;
+  SSL_CTRL_GET_CHAIN_CERTS                    = 115;
+  SSL_CTRL_SELECT_CURRENT_CERT                = 116;
+  SSL_CTRL_CHANNEL_ID                         = 117;
+  SSL_CTRL_GET_CHANNEL_ID                     = 118;
+  SSL_CTRL_SET_CHANNEL_ID                     = 119;
 
 
   DTLS_CTRL_GET_TIMEOUT	           = 73;
@@ -649,21 +682,100 @@ const
   SSL_CTRL_GET_RI_SUPPORT	   = 76;
   SSL_CTRL_CLEAR_OPTIONS	   = 77;
   SSL_CTRL_CLEAR_MODE		   = 78;
-  
-  TLSEXT_NAMETYPE_host_name        = 0;
 
-  SSL_MODE_ENABLE_PARTIAL_WRITE = 1;
-  SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER = 2;
-  SSL_MODE_AUTO_RETRY = 4;
-  SSL_MODE_NO_AUTO_CHAIN = 8;
+  TLSEXT_TYPE_server_name = 0;
+  TLSEXT_TYPE_max_fragment_length = 1;
+  TLSEXT_TYPE_client_certificate_url = 2;
+  TLSEXT_TYPE_trusted_ca_keys = 3;
+  TLSEXT_TYPE_truncated_hmac = 4;
+  TLSEXT_TYPE_status_request = 5;
+  TLSEXT_TYPE_user_mapping = 6;
+  TLSEXT_TYPE_client_authz = 7;
+  TLSEXT_TYPE_server_authz = 8;
+  TLSEXT_TYPE_cert_type = 9;
+  TLSEXT_TYPE_elliptic_curves = 10;
+  TLSEXT_TYPE_ec_point_formats = 11;
+  TLSEXT_TYPE_srp = 12;
+  TLSEXT_TYPE_signature_algorithms = 13;
+  TLSEXT_TYPE_use_srtp = 14;
+  TLSEXT_TYPE_heartbeat = 15;
+  TLSEXT_TYPE_session_ticket = 35;
+  TLSEXT_TYPE_renegotiate = $ff01;
+  TLSEXT_TYPE_next_proto_neg = 13172;
+  TLSEXT_NAMETYPE_host_name = 0;
+  TLSEXT_STATUSTYPE_ocsp = 1;
+  TLSEXT_ECPOINTFORMAT_first = 0;
+  TLSEXT_ECPOINTFORMAT_uncompressed = 0;
+  TLSEXT_ECPOINTFORMAT_ansiX962_compressed_prime = 1;
+  TLSEXT_ECPOINTFORMAT_ansiX962_compressed_char2 = 2;
+  TLSEXT_ECPOINTFORMAT_last = 2;
+  TLSEXT_signature_anonymous = 0;
+  TLSEXT_signature_rsa = 1;
+  TLSEXT_signature_dsa = 2;
+  TLSEXT_signature_ecdsa = 3;
+  TLSEXT_hash_none = 0;
+  TLSEXT_hash_md5 = 1;
+  TLSEXT_hash_sha1 = 2;
+  TLSEXT_hash_sha224 = 3;
+  TLSEXT_hash_sha256 = 4;
+  TLSEXT_hash_sha384 = 5;
+  TLSEXT_hash_sha512 = 6;
+  TLSEXT_MAXLEN_host_name = 255;
+
+  SSL_TLSEXT_ERR_OK = 0;
+  SSL_TLSEXT_ERR_ALERT_WARNING = 1;
+  SSL_TLSEXT_ERR_ALERT_FATAL = 2;
+  SSL_TLSEXT_ERR_NOACK = 3;
+
+  SSL_MODE_ENABLE_PARTIAL_WRITE                 = $00000001;
+  SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER           = $00000002;
+  SSL_MODE_AUTO_RETRY                           = $00000004;
+  SSL_MODE_NO_AUTO_CHAIN                        = $00000008;
+  SSL_MODE_RELEASE_BUFFERS                      = $00000010;
+
+  SSL_OP_MICROSOFT_SESS_ID_BUG                  = $00000001;
+  SSL_OP_NETSCAPE_CHALLENGE_BUG                 = $00000002;
+  SSL_OP_LEGACY_SERVER_CONNECT                  = $00000004;
+  SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG       = $00000008;
+  SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG            = $00000010;
+  SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER             = $00000020;
+  SSL_OP_MSIE_SSLV2_RSA_PADDING                 = $00000040;
+  SSL_OP_SAFARI_ECDHE_ECDSA_BUG                 = $00000040;
+  SSL_OP_SSLEAY_080_CLIENT_DH_BUG               = $00000080;
+  SSL_OP_TLS_D5_BUG                             = $00000100;
+  SSL_OP_TLS_BLOCK_PADDING_BUG                  = $00000200;
+  SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS            = $00000800;
+  SSL_OP_NO_QUERY_MTU                           = $00001000;
+  SSL_OP_COOKIE_EXCHANGE                        = $00002000;
+  SSL_OP_NO_TICKET                              = $00004000;
+  SSL_OP_CISCO_ANYCONNECT                       = $00008000;
+  SSL_OP_ALL                                    = $000FFFFF;
+  SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION = $00010000;
+  SSL_OP_NO_COMPRESSION                         = $00020000;
+  SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION      = $00040000;
+  SSL_OP_SINGLE_ECDH_USE                        = $00080000;
+  SSL_OP_SINGLE_DH_USE                          = $00100000;
+  SSL_OP_EPHEMERAL_RSA                          = $00200000;
+  SSL_OP_CIPHER_SERVER_PREFERENCE               = $00400000;
+  SSL_OP_TLS_ROLLBACK_BUG                       = $00800000;
+  SSL_OP_NO_SSLv2                               = $01000000;
+  SSL_OP_NO_SSLv3                               = $02000000;
+  SSL_OP_NO_TLSv1                               = $04000000;
+  SSL_OP_NO_TLSv1_2                             = $08000000;
+  SSL_OP_NO_TLSv1_1                             = $10000000;
+  SSL_OP_NETSCAPE_CA_DN_BUG                     = $20000000;
+  SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG        = $40000000;
+  SSL_OP_CRYPTOPRO_TLSEXT_BUG                   = $80000000;
 
-  SSL_OP_NO_SSLv2 = $01000000;
-  SSL_OP_NO_SSLv3 = $02000000;
-  SSL_OP_NO_TLSv1 = $04000000;
-  SSL_OP_ALL = $000FFFFF;
   SSL_VERIFY_NONE = $00;
   SSL_VERIFY_PEER = $01;
 
+  SSL_CERT_FLAG_TLS_STRICT                      = $00000001;
+
+  // Used in SSL_set_shutdown()/SSL_get_shutdown();
+  SSL_SENT_SHUTDOWN = 1;
+  SSL_RECEIVED_SHUTDOWN = 2;
+
   OPENSSL_DES_DECRYPT = 0;
   OPENSSL_DES_ENCRYPT = 1;
 
@@ -834,8 +946,16 @@ const
 //DES modes
   DES_ENCRYPT = 1;
   DES_DECRYPT = 0;
-  
-  
+
+// Error codes for ECDH Function
+  ECDH_F_ECDH_COMPUTE_KEY = 100;
+  ECDH_F_ECDH_DATA_NEW_METHOD = 101;
+
+// Error codes for ECDH Reason
+  ECDH_R_NO_PRIVATE_VALUE = 100;
+  ECDH_R_POINT_ARITHMETIC_FAILURE = 101;
+  ECDH_R_KDF_FAILED = 102;
+
 var
   SSLLibHandle: TLibHandle = 0;
   SSLUtilHandle: TLibHandle = 0;
@@ -863,6 +983,8 @@ var
   function SslMethodV2:PSSL_METHOD;
   function SslMethodV3:PSSL_METHOD;
   function SslMethodTLSV1:PSSL_METHOD;
+  function SslMethodTLSV1_1:PSSL_METHOD;
+  function SslMethodTLSV1_2:PSSL_METHOD;
   function SslMethodV23:PSSL_METHOD;
   function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):cInt;
   function SslCtxUsePrivateKeyASN1(pk: cInt; ctx: PSSL_CTX; d: String; len: cLong):cInt;
@@ -894,6 +1016,9 @@ var
   function SSLCipherGetName(c: SslPtr): String;
   function SSLCipherGetBits(c: SslPtr; var alg_bits: cInt):cInt;
   function SSLGetVerifyResult(ssl: PSSL):cLong;
+  function SSLGetServername(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): string;
+  procedure SslCtxCallbackCtrl(ssl: PSSL; _type: cInt; cb: PCallbackCb);
+  function SslSetSslCtx(ssl: PSSL; ctx: PSSL_CTX): PSSL;
 
 // libeay.dll
   procedure ERR_load_crypto_strings;
@@ -908,6 +1033,7 @@ var
   function X509print(b: PBIO; a: PX509): cInt;
   function X509SetVersion(x: PX509; version: cInt): cInt;
   function X509SetPubkey(x: PX509; pkey: PEVP_PKEY): cInt;
+  function X509GetPubkey(x: PX509): PEVP_PKEY;
   function X509SetIssuerName(x: PX509; name: PX509_NAME): cInt;
   function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: cInt;
     bytes: string; len, loc, _set: cInt): cInt;
@@ -1071,7 +1197,8 @@ var
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
                u: pointer): integer;	
   function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
-
+  function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
+  
   // BIO Functions - bio.h
   function BioNew(b: PBIO_METHOD): PBIO;
   procedure BioFreeAll(b: PBIO);
@@ -1258,6 +1385,8 @@ type
   TSslMethodV2 = function:PSSL_METHOD; cdecl;
   TSslMethodV3 = function:PSSL_METHOD; cdecl;
   TSslMethodTLSV1 = function:PSSL_METHOD; cdecl;
+  TSslMethodTLSV1_1 = function:PSSL_METHOD; cdecl;
+  TSslMethodTLSV1_2 = function:PSSL_METHOD; cdecl;
   TSslMethodV23 = function:PSSL_METHOD; cdecl;
   TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):cInt; cdecl;
   TSslCtxUsePrivateKeyASN1 = function(pk: cInt; ctx: PSSL_CTX; d: sslptr; len: cInt):cInt; cdecl;
@@ -1286,6 +1415,9 @@ type
   TSSLCipherGetName = function(c: Sslptr):PChar; cdecl;
   TSSLCipherGetBits = function(c: SslPtr; alg_bits: PcInt):cInt; cdecl;
   TSSLGetVerifyResult = function(ssl: PSSL):cInt; cdecl;
+  TSSLGetServername = function(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): PChar; cdecl;
+  TSSLCtxCallbackCtrl = procedure(ctx: PSSL_CTX; _type: cInt; cb: PCallbackCb); cdecl;
+  TSSLSetSslCtx = function(ssl: PSSL; ctx: PSSL_CTX): PSSL; cdecl;
 
 // libeay.dll
   TERR_load_crypto_strings = procedure; cdecl;
@@ -1299,6 +1431,7 @@ type
   TX509print = function(b: PBIO; a: PX509): cInt; cdecl;
   TX509SetVersion = function(x: PX509; version: cInt): cInt; cdecl;
   TX509SetPubkey = function(x: PX509; pkey: PEVP_PKEY): cInt; cdecl;
+  TX509GetPubkey = function(x: PX509): PEVP_PKEY; cdecl;
   TX509SetIssuerName = function(x: PX509; name: PX509_NAME): cInt; cdecl;
   TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PChar; _type: cInt;
     bytes: PChar; len, loc, _set: cInt): cInt; cdecl;
@@ -1447,6 +1580,7 @@ type
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
                u: pointer): integer; cdecl;	
   TPEM_write_bio_PUBKEY = function(bp: pBIO; x: pEVP_PKEY): integer; cdecl;
+  TPEM_read_bio_X509 = function(bp: pBIO; x: PPX509; cb: Ppem_password_cb; u: pointer): px509; cdecl;
 
   // BIO Functions
 
@@ -1470,6 +1604,8 @@ var
   _SslMethodV2: TSslMethodV2 = nil;
   _SslMethodV3: TSslMethodV3 = nil;
   _SslMethodTLSV1: TSslMethodTLSV1 = nil;
+  _SslMethodTLSV1_1: TSslMethodTLSV1_1 = nil;
+  _SslMethodTLSV1_2: TSslMethodTLSV1_2 = nil;
   _SslMethodV23: TSslMethodV23 = nil;
   _SslCtxUsePrivateKey: TSslCtxUsePrivateKey = nil;
   _SslCtxUsePrivateKeyASN1: TSslCtxUsePrivateKeyASN1 = nil;
@@ -1498,6 +1634,9 @@ var
   _SSLCipherGetName: TSSLCipherGetName = nil;
   _SSLCipherGetBits: TSSLCipherGetBits = nil;
   _SSLGetVerifyResult: TSSLGetVerifyResult = nil;
+  _SSLGetServername: TSSLGetServername = nil;
+  _SslCtxCallbackCtrl: TSSLCtxCallbackCtrl = nil;
+  _SslSetSslCtx: TSSLSetSslCtx = nil;
 
 // libeay.dll
   _ERR_load_crypto_strings: TERR_load_crypto_strings = nil;
@@ -1511,6 +1650,7 @@ var
   _X509print: TX509print = nil;
   _X509SetVersion: TX509SetVersion = nil;
   _X509SetPubkey: TX509SetPubkey = nil;
+  _X509GetPubkey: TX509GetPubkey = nil;
   _X509SetIssuerName: TX509SetIssuerName = nil;
   _X509NameAddEntryByTxt: TX509NameAddEntryByTxt = nil;
   _X509Sign: TX509Sign = nil;
@@ -1663,7 +1803,7 @@ var
   _PEM_read_bio_PUBKEY: TPEM_read_bio_PUBKEY = nil; 
   _PEM_write_bio_PrivateKey: TPEM_write_bio_PrivateKey = nil;	
   _PEM_write_bio_PUBKEY: TPEM_write_bio_PUBKEY = nil;
-
+  _PEM_read_bio_X509: TPEM_read_bio_X509 = nil;
   // BIO Functions
 
   _BIO_ctrl: TBIO_ctrl = nil;
@@ -1864,6 +2004,22 @@ begin
     Result := nil;
 end;
 
+function SslMethodTLSV1_1:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodTLSV1_1) then
+    Result := _SslMethodTLSV1_1
+  else
+    Result := nil;
+end;
+
+function SslMethodTLSV1_2:PSSL_METHOD;
+begin
+  if InitSSLInterface and Assigned(_SslMethodTLSV1_2) then
+    Result := _SslMethodTLSV1_2
+  else
+    Result := nil;
+end;
+
 function SslMethodV23:PSSL_METHOD;
 begin
   if InitSSLInterface and Assigned(_SslMethodV23) then
@@ -2084,6 +2240,27 @@ begin
     Result := X509_V_ERR_APPLICATION_VERIFICATION;
 end;
 
+function SSLGetServername(ssl: PSSL; _type: cInt = TLSEXT_NAMETYPE_host_name): string;
+begin
+  if InitSSLInterface and Assigned(_SSLGetServername) then
+    result := PChar(_SSLGetServername(ssl, _type))
+  else
+    result := '';
+end;
+
+procedure SslCtxCallbackCtrl(ssl: PSSL; _type: cInt; cb: PCallbackCb);
+begin
+  if InitSSLInterface and Assigned(_SslCtxCallbackCtrl) then
+    _SslCtxCallbackCtrl(ssl, _type, cb);
+end;
+
+function SslSetSslCtx(ssl: PSSL; ctx: PSSL_CTX): PSSL;
+begin
+  if InitSSLInterface and Assigned(_SslSetSslCtx) then
+    result := _SslSetSslCtx(ssl, ctx)
+  else
+    result := nil;
+end;
 
 // libeay.dll
 function SSLeayversion(t: cInt): string;
@@ -2315,6 +2492,15 @@ begin
     Result := 0;
 end;
 
+function X509GetPubkey(x: PX509): PEVP_PKEY;
+begin
+  if InitSSLInterface and Assigned(_X509GetPubkey) then
+    Result := _X509GetPubkey(x)
+  else
+   Result := 0;
+end;
+
+
 function X509SetIssuerName(x: PX509; name: PX509_NAME): cInt;
 begin
   if InitSSLInterface and Assigned(_X509SetIssuerName) then
@@ -3112,6 +3298,15 @@ Begin
     Result := -1;
 end; 
 
+function PEM_read_bio_X509(bp: pBIO;  x: ppx509; cb: Ppem_password_cb; u: pointer): px509;
+begin
+  if InitSSLInterface and Assigned(_PEM_read_bio_X509) then
+    Result := _PEM_read_bio_X509(bp, x, cb, u)
+  else
+    Result := nil;
+end;
+
+
 // BIO Functions
 
 function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
@@ -3777,6 +3972,8 @@ begin
   _SslMethodV2 := GetProcAddr(SSLLibHandle, 'SSLv2_method');
   _SslMethodV3 := GetProcAddr(SSLLibHandle, 'SSLv3_method');
   _SslMethodTLSV1 := GetProcAddr(SSLLibHandle, 'TLSv1_method');
+  _SslMethodTLSV1_1 := GetProcAddr(SSLLibHandle, 'TLSv1_1_method');
+  _SslMethodTLSV1_2 := GetProcAddr(SSLLibHandle, 'TLSv1_2_method');
   _SslMethodV23 := GetProcAddr(SSLLibHandle, 'SSLv23_method');
   _SslCtxUsePrivateKey := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey');
   _SslCtxUsePrivateKeyASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey_ASN1');
@@ -3807,6 +4004,9 @@ begin
   _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name');
   _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits');
   _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result');
+  _SslGetServername := GetProcAddr(SSLLibHandle, 'SSL_get_servername');
+  _SslCtxCallbackCtrl := GetProcAddr(SSLLibHandle, 'SSL_CTX_callback_ctrl');
+  _SslSetSslCtx := GetProcAddr(SSLLibHandle, 'SSL_set_SSL_CTX');
 end;
 
 Procedure LoadUtilEntryPoints;
@@ -3823,6 +4023,7 @@ begin
   _X509print := GetProcAddr(SSLUtilHandle, 'X509_print');
   _X509SetVersion := GetProcAddr(SSLUtilHandle, 'X509_set_version');
   _X509SetPubkey := GetProcAddr(SSLUtilHandle, 'X509_set_pubkey');
+  _X509GetPubkey := GetProcAddr(SSLUtilHandle, 'X509_get_pubkey');
   _X509SetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_set_issuer_name');
   _X509NameAddEntryByTxt := GetProcAddr(SSLUtilHandle, 'X509_NAME_add_entry_by_txt');
   _X509Sign := GetProcAddr(SSLUtilHandle, 'X509_sign');
@@ -3952,6 +4153,8 @@ begin
   _PEM_read_bio_PUBKEY := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_PUBKEY');
   _PEM_write_bio_PrivateKey := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PrivateKey');
   _PEM_write_bio_PUBKEY := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PUBKEY');
+  _PEM_read_bio_X509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509');
+  
   // BIO
   _BIO_ctrl := GetProcAddr(SSLUtilHandle, 'BIO_ctrl');
   _BIO_s_file := GetProcAddr(SSLUtilHandle, 'BIO_s_file');
@@ -4053,6 +4256,8 @@ begin
   _SslMethodV2 := nil;
   _SslMethodV3 := nil;
   _SslMethodTLSV1 := nil;
+  _SslMethodTLSV1_1 := nil;
+  _SslMethodTLSV1_2 := nil;
   _SslMethodV23 := nil;
   _SslCtxUsePrivateKey := nil;
   _SslCtxUsePrivateKeyASN1 := nil;
@@ -4081,7 +4286,9 @@ begin
   _SslCipherGetName := nil;
   _SslCipherGetBits := nil;
   _SslGetVerifyResult := nil;
-
+  _SslGetServername := nil;
+  _SslCtxCallbackCtrl := nil;
+  _SslSetSslCtx := nil;
   _PKCS7_ISSUER_AND_SERIAL_new:=nil;
   _PKCS7_ISSUER_AND_SERIAL_free:=nil;
   _PKCS7_ISSUER_AND_SERIAL_digest:=nil;
@@ -4181,6 +4388,7 @@ begin
   _X509print := nil;
   _X509SetVersion := nil;
   _X509SetPubkey := nil;
+  _X509GetPubkey := nil;
   _X509SetIssuerName := nil;
   _X509NameAddEntryByTxt := nil;
   _X509Sign := nil;
@@ -4304,10 +4512,10 @@ begin
   // PEM
 
   _PEM_read_bio_PrivateKey := nil;
-      _PEM_read_bio_PrivateKey := nil;
+  _PEM_read_bio_PrivateKey := nil;
   _PEM_read_bio_PUBKEY := nil;
-      _PEM_write_bio_PrivateKey := nil;
-      _PEM_write_bio_PUBKEY := nil;
+  _PEM_write_bio_PrivateKey := nil;
+  _PEM_read_bio_X509 := nil;
 
   // BIO
 
diff --git a/packages/os2units/src/dive.pas b/packages/os2units/src/dive.pas
index ad96f3011a..4c41409cf0 100644
--- a/packages/os2units/src/dive.pas
+++ b/packages/os2units/src/dive.pas
@@ -25,8 +25,8 @@
 
  You should have received a copy of the Library GNU General Public License
  along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
+ the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA.
 
 ****************************************************************************}
 
diff --git a/packages/pastojs/fpmake.pp b/packages/pastojs/fpmake.pp
index 3110ddf797..f35242d7dd 100644
--- a/packages/pastojs/fpmake.pp
+++ b/packages/pastojs/fpmake.pp
@@ -19,7 +19,7 @@ begin
 {$endif ALLPACKAGES}
 
     P.Version:='3.0.1';
-    P.OSes := AllOses;
+    P.OSes := AllOses-[embedded,msdos];
     P.Dependencies.Add('fcl-js');
     P.Dependencies.Add('fcl-passrc');
 
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index b6e9f7d0a8..4f2117c7e8 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -11,268 +11,3813 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
- **********************************************************************}
+ **********************************************************************
+}(*
+Abstract:
+  Converts TPasElements into TJSElements.
+
+Works:
+- units, programs
+- unit interface function
+- uses list
+- use $impl for implementation declarations, can be disabled
+- interface vars
+  - only double, no other float type
+  - only string, no other string type
+  - modifier public to protect from removing by optimizer
+- implementation vars
+- external vars
+- initialization section
+- option to add "use strict";
+- procedures
+  - params
+  - local vars
+  - default values
+  - function results
+  - modifier external 'name'
+  - local const: declare in singleton parent function as local var
+  - give procedure overloads in module unique names by appending $1, $2, ...
+  - give nested procedure overloads unique names by appending $1, $2, ...
+  - untyped parameter
+  - varargs
+  - modifier public to protect from removing by optimizer
+  - choose overloads based on type and precision
+  - fail overload on multiple with loss of precision or one used default param
+- assign statements
+- char
+  - literals
+  - ord(char)  ->  char.charCodeAt()
+  - chr(integer)  -> String.fromCharCode(integer)
+- string
+  - literals
+  - setlength(s,newlen) -> s = rtl.strSetLength(s,newlen)
+  - read and write char aString[]
+  - allow only String, no ShortString, AnsiString, UnicodeString,...
+  - allow type casting string to external class name 'String'
+- for loop
+  - if loopvar is used afterwards append  if($loopend>i)i--;
+- repeat..until
+- while..do
+- try..finally
+- try..except, try..except on else
+- raise, raise E
+- asm..end
+- assembler; asm..end;
+- break
+- continue
+- procedure str, function str
+- type alias
+- inc/dec to += -=
+- case-of
+- convert "a div b" to "Math.floor(a / b)"
+- and, or, xor, not: logical and bitwise
+- typecast boolean to integer and back
+- rename name conflicts with js identifiers: apply, bind, call, prototype, ...
+- record
+  - types and vars
+  - assign
+  - clone record member
+  - clone set member
+  - clone when passing as argument
+  - equal, not equal
+- classes
+  - declare using createClass
+  - constructor
+  - destructor
+  - vars, init on create, clear references on destroy
+  - class vars
+  - ancestor
+  - virtual, override, abstract
+  - "is" operator
+  - "as" operator
+  - call inherited
+    - "inherited;",
+    - "inherited funcname(params);"
+    - in nested proc
+  - call class method
+  - read/write class var
+  - property
+    - param list
+    - property of type array
+  - class property
+    - accessors non static
+  - Assigned()
+  - default property
+  - type casts
+  - overloads, reintroduce  append $1, $2, ...
+  - reintroduced variables
+  - external vars and methods
+  - const
+  - bracket accessor, getter/setter has external name '[]'
+  - TObject.Free sets variable to nil
+- dynamic arrays
+  - arrays can be null
+  - init as "arr = []"  so typeof works
+  - SetLength(arr,len) becomes  arr = SetLength(arr,len,defaultvalue)
+  - length(), low(), high(), assigned(), concat()
+  - assign nil -> []  so typeof works
+  - read, write element arr[index]
+  - multi dimensional [index1,index2] -> [index1][index2]
+  - array of record
+  - equal, unequal nil -> rtl.length(array)==0  or >0
+  - when passing nil to an array argument, pass []
+  - allow type casting array to external class name 'Array'
+  - type cast array to array of same dimensions and compatible element type
+  - function copy(array,start=0,count=max): array
+  - procedure insert(item,var array,const position)
+  - procedure delete(var array,const start,count)
+  - const c: dynarray = (a,b,...)
+- static arrays
+  - range: enumtype
+  - init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
+  - init with expression
+  - length(1-dim array)
+  - low(1-dim array), high(1-dim array)
+- open arrays
+  - as dynamic arrays
+- enums
+  - type with values and names
+  - option to write numbers instead of variables
+  - ord(), low(), high(), pred(), succ()
+  - type cast alias to enumtype
+  - type cast number to enumtype
+  - const aliasname = enumvalue
+- sets
+  - set of enum
+  - include, exclude, clone when referenced
+  - assign :=   set state referenced
+  - constant set: enums, enum vars, ranges
+  - set operators +, -, *, ><, =, <>, >=, <=
+  - in-operator
+  - low(), high()
+  - when passing as argument set state referenced
+  - set of (enum,enum2)  - anonymous enumtype
+- with-do  using local var
+  - with record do i:=v;
+  - with classinstance do begin create; i:=v; f(); i:=a[]; end;
+- pass by reference
+  - pass local var to a var/out parameter
+  - pass variable to a var/out parameter
+  - pass reference to a var/out parameter
+  - pass array element to a var/out parameter
+- procedure types
+  - implemented as immutable wrapper function
+  - assign := nil, proctype (not clone), @function, @method
+  - call  explicit and implicit
+  - compare equal and notequal with nil, proctype, address, function
+  - assigned(proctype)
+  - pass as argument
+  - methods
+  - mode delphi: proctype:=proc
+  - mode delphi: functype=funcresulttype
+  - nested functions
+  - reference to
+- class-of
+  - assign :=   nil, var
+  - call class method
+  - call constructor
+  - operators =, <>
+  - class var, property, method
+  - Self in class method
+  - typecast
+- class external
+  - JS object or function as ancestor
+  - does not descend from TObject
+  - all members become external. case sensitive
+  - has no hidden values like $class, $ancestor, $unitname, $init, $final
+  - can be ancestor of a pascal class (not descend from TObject).
+  - pascal class descendant can override methods
+  - property works as normal, replaced by getter and setter
+  - class-of
+  - class var/function: works as in JS.
+  - is and as operators
+  - destructor forbidden
+  - constructor must not be virtual
+  - constructor 'new' -> new extclass(params)
+  - identifiers are renamed to avoid clashes with external names
+  - call inherited
+  - Pascal descendant can override newinstance
+  - any class can be typecasted to any root class
+  - class instances cannot access external class members (e.g. static class functions)
+  - external class 'Array' bracket operator [integer] type jsvalue
+  - external class 'Object' bracket operator [string] type jsvalue
+- jsvalue
+  - init as undefined
+  - assign to jsvalue := integer, string, boolean, double, char
+  - type cast base types to jsvalue
+  - type cast jsvalue to base type
+     integer: Math.floor(jsvalue)   may return NaN
+     boolean: !(jsvalue == false)   works for numbers too 0==false
+     double: rtl.getNumber(jsvalue)    typeof(n)=="number"?n:NaN;
+     string: ""+jsvalue
+     char: rtl.getChar(jsvalue)   ((typeof(c)!="string") && (c.length==1)) ? c : ""
+  - enums: assign to jsvalue, typecast jsvalue to enum
+  - class instance: assign to jsvalue, typecast jsvalue to a class
+  - class of: assign to jsvalue, typecast jsvalue to a class-of
+  - array of jsvalue,
+    allow to assign any array to an array of jsvalue
+    allow type casting to any array
+  - parameter, result type, assign from/to untyped
+  - operators equal, not equal
+  - callback: assign to jsvalue, equal, not equal
+- RTTI
+  - base types
+  - unit $rtti
+  - enum type tkEnumeration
+  - set type tkSet
+  - procedure type  tkProcVar, tkMethod
+  - class type tkClass
+    - fields,
+    - methods,
+    - properties  no params, no index, no defaultvalue
+    - class forward
+  - class-of type tkClassRef
+  - dyn array type  tkDynArray
+  - static array type  tkArray
+  - record type  tkRecord
+  - no typeinfo for local types
+  - built-in function typeinfo(): Pointer/TTypeInfo/...;
+    - typeinfo(class) -> class.$rtti
+  - WPO skip not used typeinfo
+  - open array param
+- pointer
+  - compare with and assign nil
+- ECMAScript6:
+  - use 0b for binary literals
+  - use 0o for octal literals
+- dotted unit names, namespaces
+
+ToDos:
+- change some == into ===
+- constant evaluation
+- static arrays
+- property index specifier
+- RTTI
+  - stored false/true
+  - class property
+    - defaultvalue
+  - type alias type
+  - documentation
+- sourcemaps
+- move local types to unit scope
+- local var absolute
+- FuncName:= (instead of Result:=)
+- check memleaks
+- @@ compare method in delphi mode
+- make records more lightweight
+- enumeration  for..in..do
+- pointer of record
+- nested types in class
+- asm: pas() - useful for overloads and protect an identifier from optimization
+- source maps
+- ifthen
+- stdcall of methods: pass original 'this' as first parameter
+
+Not in Version 1.0:
+- write, writeln
+- arrays
+  - static array: non 0 start index, length
+  - array of static array: setlength
+  - array range char, char range, integer range, enum range
+  - array of const
+  - TestArray_DynArrayConst: Chars: array of char = ''aoc'';
+- sets
+  - set of char, boolean, integer range, char range, enum range
+- call array of proc element without ()
+- record const
+- class: property modifier index
+- enums with custom values
+- library
+- option typecast checking
+- option verify method calls -CR
+- option range checking -Cr
+- option overflow checking -Co
+- optimizations:
+  - add $mod only if needed
+  - add Self only if needed
+  - set operators on literals without temporary arrays, a in [b], [a]*b<>[]
+  - shortcut for test set is empty  a=[]  a<>[]
+  - put set literals into constants
+  - use a number for small sets
+  - nested procs without var, instead as "function name(){}"
+  -O1 insert local/unit vars for global type references:
+      at start of intf var $r1;
+      at end of impl: $r1=path;
+  -O1 insert unit vars for complex literals
+  -O1 no function Result var when assigned only once
+  - SetLength(scope.a,l) -> read scope only once, same for
+    Include, Exclude, Inc, Dec, +=, -=, *=, /=
+  -O1 replace constant expression with result
+  -O1 pass array element by ref: when index is constant, use that directly
+- objects, interfaces, advanced records
+- class helpers, type helpers, record helpers,
+- generics
+- operator overloading
+- inline
+- anonymous functions
+
+Compile flags for debugging: -d<x>
+   VerbosePas2JS
+*)
 unit fppas2js;
 
 {$mode objfpc}{$H+}
+{$inline on}
 
 interface
 
 uses
-  Classes, SysUtils, jsbase, jstree, pastree, pparser;
-
+  Classes, SysUtils, math, contnrs, jsbase, jstree, PasTree, PScanner,
+  PasResolver, PasResolveEval;
+
+// message numbers
+const
+  nPasElementNotSupported = 4001;
+  nIdentifierNotFound = 4002;
+  nUnaryOpcodeNotSupported = 4003;
+  nBinaryOpcodeNotSupported = 4004;
+  nInvalidNumber = 4005;
+  nInitializedArraysNotSupported = 4006;
+  nMemberExprMustBeIdentifier = 4007;
+  nCantWriteSetLiteral = 4008;
+  nVariableIdentifierExpected = 4009;
+  nExpectedXButFoundY = 4010;
+  nInvalidFunctionReference = 4011;
+  nMissingExternalName = 4012;
+  nVirtualMethodNameMustMatchExternal = 4013;
+  nPublishedNameMustMatchExternal = 4014;
+  nInvalidVariableModifier = 4015;
+  nNoArgumentsAllowedForExternalObjectConstructor = 4016;
+  nNewInstanceFunctionMustBeVirtual = 4017;
+  nNewInstanceFunctionMustHaveTwoParameters = 4018;
+  nNewInstanceFunctionMustNotHaveOverloadAtX = 4019;
+  nBracketAccessorOfExternalClassMustHaveOneParameter = 4020;
+  nTypeXCannotBePublished = 4021;
+  nNotSupportedX = 4022;
+  nNestedInheritedNeedsParameters = 4023;
+  nFreeNeedsVar = 4024;
+// resourcestring patterns of messages
+resourcestring
+  sPasElementNotSupported = 'Pascal element not supported: %s';
+  sIdentifierNotFound = 'Identifier not found "%s"';
+  sUnaryOpcodeNotSupported = 'Unary OpCode not yet supported "%s"';
+  sBinaryOpcodeNotSupported = 'Binary OpCode not yet supported "%s"';
+  sInvalidNumber = 'Invalid number "%s"';
+  sInitializedArraysNotSupported = 'Initialized array variables not yet supported';
+  sMemberExprMustBeIdentifier = 'Member expression must be an identifier';
+  sCantWriteSetLiteral = 'Cannot write set literal';
+  sVariableIdentifierExpected = 'Variable identifier expected';
+  sExpectedXButFoundY = 'Expected %s, but found %s';
+  sInvalidFunctionReference = 'Invalid function reference';
+  sMissingExternalName = 'Missing external name';
+  sVirtualMethodNameMustMatchExternal = 'Virtual method name must match external';
+  sInvalidVariableModifier = 'Invalid variable modifier "%s"';
+  sPublishedNameMustMatchExternal = 'Published name must match external';
+  sNoArgumentsAllowedForExternalObjectConstructor = 'no arguments allowed for external object constructor';
+  sNewInstanceFunctionMustBeVirtual = 'NewInstance function must be virtual';
+  sNewInstanceFunctionMustHaveTwoParameters = 'NewInstance function must have two parameters';
+  sNewInstanceFunctionMustNotHaveOverloadAtX = 'NewInstance function must not have overload at %s';
+  sBracketAccessorOfExternalClassMustHaveOneParameter = 'Bracket accessor of external class must have one parameter';
+  sTypeXCannotBePublished = 'Type "%s" cannot be published';
+  sNotSupportedX = 'Not supported: %s';
+  sNestedInheritedNeedsParameters = 'nested inherited needs parameters';
+  sFreeNeedsVar = 'Free needs a variable';
+
+const
+  ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
+
+type
+  TPas2JSBuiltInName = (
+    pbifnArray_Concat,
+    pbifnArray_Copy,
+    pbifnArray_Length,
+    pbifnArray_NewMultiDim,
+    pbifnArray_SetLength,
+    pbifnAs,
+    pbifnAsExt,
+    pbifnClassInstanceFree,
+    pbifnClassInstanceNew,
+    pbifnCreateClass,
+    pbifnCreateClassExt,
+    pbifnGetChar,
+    pbifnGetNumber,
+    pbifnGetObject,
+    pbifnIs,
+    pbifnIsExt,
+    pbifnFreeLocalVar,
+    pbifnFreeVar,
+    pbifnProcType_Create,
+    pbifnProcType_Equal,
+    pbifnProgramMain,
+    pbifnRecordEqual,
+    pbifnRTTIAddField, // typeinfos of tkclass and tkrecord have addField
+    pbifnRTTIAddFields, // typeinfos of tkclass and tkrecord have addFields
+    pbifnRTTIAddMethod,//   "   "
+    pbifnRTTIAddProperty,//   "   "
+    pbifnRTTINewClass,// typeinfo creator of tkClass $Class
+    pbifnRTTINewClassRef,// typeinfo of tkClassRef $ClassRef
+    pbifnRTTINewEnum,// typeinfo of tkEnumeration $Enum
+    pbifnRTTINewDynArray,// typeinfo of tkDynArray $DynArray
+    pbifnRTTINewMethodVar,// typeinfo of tkMethod $MethodVar
+    pbifnRTTINewPointer,// typeinfo of tkPointer $Pointer
+    pbifnRTTINewProcSig,// rtl.newTIProcSig
+    pbifnRTTINewProcVar,// typeinfo of tkProcVar $ProcVar
+    pbifnRTTINewRecord,// typeinfo creator of tkRecord $Record
+    pbifnRTTINewRefToProcVar,// typeinfo of tkRefToProcVar $RefToProcVar
+    pbifnRTTINewSet,// typeinfo of tkSet $Set
+    pbifnRTTINewStaticArray,// typeinfo of tkArray $StaticArray
+    pbifnSetCharAt,
+    pbifnSet_Clone,
+    pbifnSet_Create,
+    pbifnSet_Difference,
+    pbifnSet_Equal,
+    pbifnSet_Exclude,
+    pbifnSet_GreaterEqual,
+    pbifnSet_Include,
+    pbifnSet_Intersect,
+    pbifnSet_LowerEqual,
+    pbifnSet_NotEqual,
+    pbifnSet_Reference,
+    pbifnSet_SymDiffSet,
+    pbifnSet_Union,
+    pbifnSpaceLeft,
+    pbifnStringSetLength,
+    pbifnUnitInit,
+    pbivnExceptObject,
+    pbivnImplementation,
+    pbivnLoopEnd,
+    pbivnModule,
+    pbivnModules,
+    pbivnPtrClass,
+    pbivnRTL,
+    pbivnRTTI, // $rtti
+    pbivnRTTIArray_Dims,
+    pbivnRTTIArray_ElType,
+    pbivnRTTIClassRef_InstanceType,
+    pbivnRTTIEnum_EnumType,
+    pbivnRTTIInt_MaxValue,
+    pbivnRTTIInt_MinValue,
+    pbivnRTTILocal, // $r
+    pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
+    pbivnRTTIPointer_RefType,
+    pbivnRTTIProcFlags,
+    pbivnRTTIProcVar_ProcSig,
+    pbivnRTTIPropDefault,
+    pbivnRTTIPropStored,
+    pbivnRTTISet_CompType,
+    pbivnSelf,
+    pbivnTObjectDestroy,
+    pbivnWith,
+    pbitnAnonymousPostfix,
+    pbitnIntDouble,
+    pbitnTI,
+    pbitnTIClass,
+    pbitnTIClassRef,
+    pbitnTIDynArray,
+    pbitnTIEnum,
+    pbitnTIInteger,
+    pbitnTIMethodVar,
+    pbitnTIPointer,
+    pbitnTIProcVar,
+    pbitnTIRecord,
+    pbitnTIRefToProcVar,
+    pbitnTISet,
+    pbitnTIStaticArray,
+    pbitnUIntDouble
+    );
+
+const
+  Pas2JSBuiltInNames: array[TPas2JSBuiltInName] of string = (
+    'arrayConcat', // rtl.arrayConcat
+    'arrayCopy', // rtl.arrayCopy
+    'length', // rtl.length
+    'arrayNewMultiDim', // rtl.arrayNewMultiDim
+    'arraySetLength', // rtl.arraySetLength
+    'as', // rtl.as
+    'asExt', // rtl.asExt
+    '$destroy',
+    '$create',
+    'createClass', // rtl.createClass
+    'createClassExt', // rtl.createClassExt
+    'getChar', // rtl.getChar
+    'getNumber', // rtl.getNumber
+    'getObject', // rtl.getObject
+    'is', // rtl.is
+    'isExt', // rtl.isExt
+    'freeLoc', // rtl.freeLoc
+    'free', // rtl.free
+    'createCallback', // rtl.createCallback
+    'eqCallback', // rtl.eqCallback
+    '$main',
+    '$equal',
+    'addField',
+    'addFields',
+    'addMethod',
+    'addProperty',
+    '$Class',
+    '$ClassRef',
+    '$Enum',
+    '$DynArray',
+    '$MethodVar',
+    '$Pointer',
+    'newTIProcSig',
+    '$ProcVar',
+    '$Record',
+    '$RefToProcVar',
+    '$Set',
+    '$StaticArray',
+    'setCharAt', // rtl.setCharAt
+    'cloneSet', // rtl.cloneSet
+    'createSet', // rtl.createSet [...]
+    'diffSet', // rtl.diffSet -
+    'eqSet', // rtl.eqSet =
+    'excludeSet', // rtl.excludeSet
+    'geSet', // rtl.geSet superset >=
+    'includeSet', // rtl.includeSet
+    'intersectSet', // rtl.intersectSet *
+    'leSet', // rtl.leSet subset <=
+    'neSet', // rtl.neSet <>
+    'refSet', // rtl.refSet
+    'symDiffSet', // rtl.symDiffSet >< (symmetrical difference)
+    'unionSet', // rtl.unionSet +
+    'spaceLeft', // rtl.spaceLeft
+    'strSetLength', // rtl.
+    '$init',
+    '$e',
+    '$impl',
+    '$loopend',
+    '$mod',
+    'pas',
+    '$class',
+    'rtl',
+    '$rtti',
+    'dims',
+    'eltype',
+    'instancetype',
+    'enumtype',
+    'maxvalue',
+    'minvalue',
+    '$r',
+    'methodkind',
+    'reftype',
+    'flags',
+    'procsig',
+    'defaultvalue',
+    'stored',
+    'comptype',
+    'Self',
+    'tObjectDestroy', // rtl.tObjectDestroy
+    '$with',
+    '$a',
+    'NativeInt',
+    'tTypeInfo', // rtl.
+    'tTypeInfoClass', // rtl.
+    'tTypeInfoClassRef', // rtl.
+    'tTypeInfoDynArray', // rtl.
+    'tTypeInfoEnum', // rtl.
+    'tTypeInfoInteger', // rtl.
+    'tTypeInfoMethodVar', // rtl.
+    'tTypeInfoPointer', // rtl.
+    'tTypeInfoProcVar', // rtl.
+    'tTypeInfoRecord', // rtl.
+    'tTypeInfoRefToProcVar', // rtl.
+    'tTypeInfoSet', // rtl.
+    'tTypeInfoStaticArray', // rtl.
+    'NativeUInt'
+    );
+
+  JSReservedWords: array[0..113] of string = (
+     // keep sorted, first uppercase, then lowercase !
+     'Array',
+     'ArrayBuffer',
+     'Boolean',
+     'DataView',
+     'Date',
+     'Error',
+     'EvalError',
+     'Float32Array',
+     'Float64Array',
+     'Generator',
+     'GeneratorFunction',
+     'Infinity',
+     'Int16Array',
+     'Int32Array',
+     'Int8Array',
+     'InternalError',
+     'JSON',
+     'Map',
+     'Math',
+     'NaN',
+     'Number',
+     'Object',
+     'Promise',
+     'Proxy',
+     'RangeError',
+     'ReferenceError',
+     'Reflect',
+     'RegExp',
+     'Set',
+     'String',
+     'Symbol',
+     'SyntaxError',
+     'TypeError',
+     'URIError',
+     'Uint16Array',
+     'Uint32Array',
+     'Uint8Array',
+     'Uint8ClampedArray',
+     'WeakMap',
+     'WeakSet',
+     '__extends',
+     '_super',
+     'anonymous',
+     'apply',
+     'arguments',
+     'array',
+     'await',
+     'bind',
+     'break',
+     'call',
+     'case',
+     'catch',
+     'charAt',
+     'charCodeAt',
+     'class',
+     'constructor',
+     'continue',
+     'decodeURI',
+     'decodeURIComponent',
+     'default',
+     'delete',
+     'do',
+     'each',
+     'else',
+     'encodeURI',
+     'encodeURIComponent',
+     'enum',
+     'escape',
+     'eval',
+     'export',
+     'extends',
+     'false',
+     'for',
+     'function',
+     'getPrototypeOf',
+     'hasOwnProperty',
+     'if',
+     'implements',
+     'import',
+     'in',
+     'instanceof',
+     'interface',
+     'isFinite',
+     'isNaN',
+     'isPrototypeOf',
+     'let',
+     'new',
+     'null',
+     'package',
+     'parseFloat',
+     'parseInt',
+     'private',
+     'propertyIsEnumerable',
+     'protected',
+     'prototype',
+     'public',
+     'return',
+     'static',
+     'super',
+     'switch',
+     'this',
+     'throw',
+     'toLocaleString',
+     'toString',
+     'true',
+     'try',
+     'undefined',
+     'unescape',
+     'uneval',
+     'valueOf',
+     'var',
+     'while',
+     'with',
+     'yield'
+    );
+
+const
+  ClassVarModifiersType = [vmClass,vmStatic];
+  LowJSNativeInt = MinSafeIntDouble;
+  HighJSNativeInt = MaxSafeIntDouble;
+  LowJSBoolean = false;
+  HighJSBoolean = true;
 Type
-  EPas2JS = Class(Exception);
-  { TPasToJSConverter }
+
+  { EPas2JS }
+
+  EPas2JS = Class(Exception)
+  public
+    PasElement: TPasElement;
+    MsgNumber: integer;
+    Args: TMessageArgs;
+    Id: int64;
+    MsgType: TMessageType;
+  end;
+
+//------------------------------------------------------------------------------
+// Pas2js built-in types
+type
+  TPas2jsBaseType = (
+    pbtNone,
+    pbtJSValue
+    );
+  TPas2jsBaseTypes = set of TPas2jsBaseType;
+
+const
+  Pas2jsBaseTypeNames: array[TPas2jsBaseType] of string = (
+    'None',
+    'JSValue'
+    );
+
+//------------------------------------------------------------------------------
+// Element CustomData
+type
+
+  { TPas2JsElementData }
+
+  TPas2JsElementData = Class(TPasElementBase)
+  private
+    FElement: TPasElement;
+    procedure SetElement(const AValue: TPasElement);
+  public
+    Owner: TObject; // e.g. a TPasToJSConverter
+    Next: TPas2JsElementData; // TPasToJSConverter uses this for its memory chain
+    constructor Create; virtual;
+    destructor Destroy; override;
+    property Element: TPasElement read FElement write SetElement; // can be TPasElement
+  end;
+  TPas2JsElementDataClass = class of TPas2JsElementData;
+
+  { TP2JConstExprData - CustomData of a const TPasExpr }
+
+  TP2JConstExprData = Class(TPas2JsElementData)
+  public
+    // Element is TPasExpr
+    Value: TJSValue;
+    destructor Destroy; override;
+  end;
+
+  TPas2JSClassScope = class(TPasClassScope)
+  public
+    NewInstanceFunction: TPasClassFunction;
+  end;
+
+  { TPas2JSWithExprScope }
+
+  TPas2JSWithExprScope = class(TPasWithExprScope)
+  public
+    WithVarName: string;
+  end;
+
+  { TResElDataPas2JSBaseType - CustomData for compiler built-in types (TPasUnresolvedSymbolRef), e.g. jsvalue }
+
+  TResElDataPas2JSBaseType = class(TResElDataBaseType)
+  public
+    JSBaseType: TPas2jsBaseType;
+  end;
+
+//------------------------------------------------------------------------------
+// TPas2JSResolver
+const
+  msAllPas2jsModeSwitchesReadOnly = [
+    msClass,
+    msResult,
+    msRepeatForward,
+    // ToDo: msPointer2Procedure,
+    // ToDo: msAutoDeref,
+    msInitFinal,
+    msOut,
+    msDefaultPara,
+    // ToDo: msDuplicateNames
+    msProperty,
+    // ToDo: msDefaultInline
+    msExcept,
+    // ToDo: msAdvancedRecords
+    msDefaultUnicodestring,
+    msCBlocks
+    ];
+  msAllPas2jsModeSwitches = msAllPas2jsModeSwitchesReadOnly+[
+    msDelphi,msObjfpc,
+    msHintDirective,msNestedComment,
+    msExternalClass];
+
+  btAllJSBaseTypes = [
+    btChar,
+    btString,
+    btDouble,
+    btBoolean,
+    btByteBool,
+    btWordBool,
+    btLongBool,
+    btQWordBool,
+    btByte,
+    btShortInt,
+    btWord,
+    btSmallInt,
+    btLongWord,
+    btLongint,
+    btUIntDouble,
+    btIntDouble,
+    btPointer
+    ];
+  bfAllJSBaseProcs = bfAllStandardProcs;
+
+  btAllJSStrings = [btString];
+  btAllJSChars = [btChar];
+  btAllJSStringAndChars = btAllJSStrings+btAllJSChars;
+  btAllJSFloats = [btDouble];
+  btAllJSBooleans = [btBoolean];
+  btAllJSInteger = [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongint,
+    btIntDouble,btUIntDouble];
+  btAllJSValueSrcTypes = [btNil,btUntyped,btPointer]+btAllJSInteger
+      +btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans;
+  btAllJSValueTypeCastTo = btAllJSInteger
+      +btAllJSStringAndChars+btAllJSFloats+btAllJSBooleans+[btPointer];
+
+
+  DefaultPasResolverOptions = [
+    proFixCaseOfOverrides,
+    proClassPropertyNonStatic,
+    proPropertyAsVarParam,
+    proClassOfIs,
+    proExtClassInstanceNoTypeMembers,
+    proOpenAsDynArrays,
+    proProcTypeWithoutIsNested,
+    proMethodAddrAsPointer
+    ];
+type
+  TPas2JSResolver = class(TPasResolver)
+  private
+    FJSBaseTypes: array[TPas2jsBaseType] of TPasUnresolvedSymbolRef;
+    FExternalNames: TFPHashList; // list of list of TPasIdentifier
+    FFirstElementData, FLastElementData: TPas2JsElementData;
+    function GetJSBaseTypes(aBaseType: TPas2jsBaseType): TPasUnresolvedSymbolRef; inline;
+    procedure InternalAdd(Item: TPasIdentifier);
+    procedure OnClearHashItem(Item, Dummy: pointer);
+  protected
+    FOverloadScopes: TFPList; // list of TPasIdentifierScope
+    function HasOverloadIndex(El: TPasElement): boolean; virtual;
+    function GetOverloadIndex(Identifier: TPasIdentifier;
+      StopAt: TPasElement): integer;
+    function GetOverloadAt(Identifier: TPasIdentifier; var Index: integer): TPasIdentifier;
+    function GetOverloadIndex(El: TPasElement): integer;
+    function GetOverloadAt(const aName: String; Index: integer): TPasIdentifier;
+    function RenameOverload(El: TPasElement): boolean;
+    procedure RenameOverloadsInSection(aSection: TPasSection);
+    procedure RenameOverloads(DeclEl: TPasElement; Declarations: TFPList);
+    procedure RenameSubOverloads(Declarations: TFPList);
+    procedure PushOverloadScope(Scope: TPasIdentifierScope);
+    procedure PopOverloadScope;
+    procedure AddType(El: TPasType); override;
+    procedure ResolveImplAsm(El: TPasImplAsmStatement); override;
+    procedure ResolveNameExpr(El: TPasExpr; const aName: string;
+      Access: TResolvedRefAccess); override;
+    procedure FinishModule(CurModule: TPasModule); override;
+    procedure FinishSetType(El: TPasSetType); override;
+    procedure FinishClassType(El: TPasClassType); override;
+    procedure FinishVariable(El: TPasVariable); override;
+    procedure FinishProcedureType(El: TPasProcedureType); override;
+    procedure FinishPropertyOfClass(PropEl: TPasProperty); override;
+    procedure CheckConditionExpr(El: TPasExpr;
+      const ResolvedEl: TPasResolverResult); override;
+    procedure CheckNewInstanceFunction(ClassScope: TPas2JSClassScope); virtual;
+    function AddExternalName(const aName: string; El: TPasElement): TPasIdentifier; virtual;
+    function FindExternalName(const aName: String): TPasIdentifier; virtual;
+    procedure AddExternalPath(aName: string; El: TPasElement);
+    procedure ClearElementData; virtual;
+  protected
+    const
+      cJSValueConversion = 2*cTypeConversion;
+    // additional base types
+    function AddJSBaseType(const aName: string; Typ: TPas2jsBaseType): TResElDataPas2JSBaseType;
+    function IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType): boolean;
+    function IsJSBaseType(const TypeResolved: TPasResolverResult;
+      Typ: TPas2jsBaseType; HasValue: boolean = false): boolean;
+    function CheckAssignCompatibilityCustom(const LHS,
+      RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean; var Handled: boolean): integer; override;
+    function CheckTypeCastClassInstanceToClass(const FromClassRes,
+      ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer; override;
+    function CheckEqualCompatibilityCustomType(const LHS,
+      RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean): integer; override;
+    procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
+      Params: TParamsExpr; out ResolvedEl: TPasResolverResult); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // base types
+    procedure AddObjFPCBuiltInIdentifiers(
+      const TheBaseTypes: TResolveBaseTypes;
+      const TheBaseProcs: TResolverBuiltInProcs); override;
+    function CheckTypeCastRes(const FromResolved,
+      ToResolved: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnError: boolean): integer; override;
+    property JSBaseTypes[aBaseType: TPas2jsBaseType]: TPasUnresolvedSymbolRef read GetJSBaseTypes;
+    // compute literals and constants
+    function ExtractPasStringLiteral(El: TPasElement; const S: String): TJSString; virtual;
+    function ComputeConst(Expr: TPasExpr; StoreCustomData: boolean): TJSValue; virtual;
+    function ComputeConstString(Expr: TPasExpr; StoreCustomData, NotEmpty: boolean): String; virtual;
+    // CustomData
+    function GetElementData(El: TPasElementBase;
+      DataClass: TPas2JsElementDataClass): TPas2JsElementData; virtual;
+    procedure AddElementData(Data: TPas2JsElementData); virtual;
+    function CreateElementData(DataClass: TPas2JsElementDataClass;
+      El: TPasElement): TPas2JsElementData; virtual;
+    // utility
+    function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean=
+      false): string; override;
+    function HasTypeInfo(El: TPasType): boolean; override;
+    function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
+    function IsExternalBracketAccessor(El: TPasElement): boolean;
+  end;
+
+//------------------------------------------------------------------------------
+// TConvertContext
+type
+  TCtxAccess = (
+    caRead,  // normal read
+    caAssign, // needs setter
+    caByReference // needs path, getter and setter
+    );
+
+  TFunctionContext = Class;
+
+  { TConvertContext }
+
+  TConvertContextClass = Class of TConvertContext;
   TConvertContext = Class(TObject)
+  public
+    PasElement: TPasElement;
+    JSElement: TJSElement;
+    Resolver: TPas2JSResolver;
+    Parent: TConvertContext;
+    IsGlobal: boolean; // can hold constants and types
+    Access: TCtxAccess;
+    AccessContext: TConvertContext;
+    TmpVarCount: integer;
+    constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); virtual;
+    function GetRootModule: TPasModule;
+    function GetFunctionContext: TFunctionContext;
+    function GetLocalName(El: TPasElement): string; virtual;
+    function GetSelfContext: TFunctionContext;
+    function GetContextOfType(aType: TConvertContextClass): TConvertContext;
+    function CreateLocalIdentifier(const Prefix: string): string;
+    function CurrentModeSwitches: TModeSwitches;
+    function GetGlobalFunc: TFunctionContext;
+    procedure WriteStack;
+    procedure DoWriteStack(Index: integer); virtual;
+    function ToString: string; override;
+  end;
+
+  { TRootContext }
+
+  TRootContext = Class(TConvertContext)
+  end;
+
+  { TFCLocalVar }
 
+  TFCLocalVar = class
+  public
+    Element: TPasElement;
+    Name: string;
+    constructor Create(const aName: string; TheEl: TPasElement);
+  end;
+  TFCLocalVars = array of TFCLocalVar;
+
+  { TFunctionContext
+    Module Function: PasElement is TPasProcedure, ThisPas=nil
+    Method: PasElement is TPasProcedure, ThisPas is TPasClassType }
+
+  TFunctionContext = Class(TConvertContext)
+  public
+    LocalVars: TFCLocalVars;
+    ThisPas: TPasElement;
+    destructor Destroy; override;
+    procedure AddLocalVar(const aName: string; El: TPasElement);
+    function ToString: string; override;
+    function GetLocalName(El: TPasElement): string; override;
+    function IndexOfLocalVar(const aName: string): integer;
+    function IndexOfLocalVar(El: TPasElement): integer;
+    function FindLocalVar(const aName: string): TFCLocalVar;
+    function FindLocalVar(El: TPasElement): TFCLocalVar;
+    procedure DoWriteStack(Index: integer); override;
   end;
 
+  { TObjectContext }
+
+  TObjectContext  = Class(TConvertContext)
+  end;
+
+  { TSectionContext - interface/implementation/program/library
+    interface/program/library: PasElement is TPasModule, ThisPas is TPasModule
+    implementation: PasElement is TImplementationSection, ThisPas is TPasModule }
+
+  TSectionContext = Class(TFunctionContext)
+  public
+    constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
+  end;
+
+  { TDotContext - used for converting eopSubIdent }
+
+  TDotContext = Class(TConvertContext)
+  public
+    LeftResolved: TPasResolverResult;
+  end;
+
+  { TAssignContext - used for left side of an assign statement }
+
+  TAssignContext = Class(TConvertContext)
+  public
+    // set when creating:
+    LeftResolved: TPasResolverResult;
+    RightResolved: TPasResolverResult;
+    RightSide: TJSElement;
+    // created by ConvertElement:
+    PropertyEl: TPasProperty;
+    Setter: TPasElement;
+    Call: TJSCallExpression;
+    constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
+  end;
+
+  { TParamContext }
+
+  TParamContext = Class(TConvertContext)
+  public
+    // set when creating:
+    Arg: TPasArgument;
+    Expr: TPasExpr;
+    ResolvedExpr: TPasResolverResult;
+    // created by ConvertElement:
+    Getter: TJSElement;
+    Setter: TJSElement;
+    ReusingReference: boolean; // true = result is a reference, do not create another
+    constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
+  end;
+
+//------------------------------------------------------------------------------
+// TPasToJSConverter
+type
+  TPasToJsConverterOption = (
+    coLowerCase, // lowercase all identifiers, except conflicts with JS reserved words
+    coSwitchStatement, // convert case-of into switch instead of if-then-else
+    coEnumNumbers, // use enum numbers instead of names
+    coUseStrict,   // insert 'use strict'
+    coNoTypeInfo   // do not generate RTTI
+    );
+  TPasToJsConverterOptions = set of TPasToJsConverterOption;
+
+  TPas2JSIsElementUsedEvent = function(Sender: TObject; El: TPasElement): boolean of object;
+
+  TPasToJsPlatform = (
+    PlatformBrowser,
+    PlatformNodeJS
+    );
+  TPasToJsPlatforms = set of TPasToJsPlatform;
+const
+  PasToJsPlatformNames: array[TPasToJsPlatform] of string = (
+   'Browser',
+   'NodeJS'
+    );
+type
+  TPasToJsProcessor = (
+    ProcessorECMAScript5,
+    ProcessorECMAScript6
+    );
+  TPasToJsProcessors = set of TPasToJsProcessor;
+const
+  PasToJsProcessorNames: array[TPasToJsProcessor] of string = (
+   'ECMAScript5',
+   'ECMAScript6'
+    );
+
+type
+  TJSReservedWordList = array of String;
+
+  TRefPathKind = (
+    rpkPath,      // e.g. "TObject"
+    rpkPathWithDot, // e.g. "TObject."
+    rpkPathAndName // e.g. "TObject.ClassName"
+    );
+
+  { TPasToJSConverter }
+
   TPasToJSConverter = Class(TObject)
   private
-    FCurrentContext: TJSElement;
-    FMainFunction: TJSString;
-    FNameSpace: TJSString;
+    // inline at top, only functions declared after the inline implementation actually use it
+    function GetUseEnumNumbers: boolean; inline;
+    function GetUseLowerCase: boolean; inline;
+    function GetUseSwitchStatement: boolean; inline;
+  private
+    type
+      TForLoopFindData = record
+        ForLoop: TPasImplForLoop;
+        LoopVar: TPasElement;
+        FoundLoop: boolean;
+        LoopVarWrite: boolean; // true if first acces of LoopVar after loop is a write
+        LoopVarRead: boolean; // true if first acces of LoopVar after loop is a read
+      end;
+      PForLoopFindData = ^TForLoopFindData;
+    procedure ForLoop_OnProcBodyElement(El: TPasElement; arg: pointer);
+  private
+    FBuiltInNames: array[TPas2JSBuiltInName] of string;
+    FOnIsElementUsed: TPas2JSIsElementUsedEvent;
+    FOnIsTypeInfoUsed: TPas2JSIsElementUsedEvent;
+    FOptions: TPasToJsConverterOptions;
+    FPreservedWords: TJSReservedWordList; // sorted with CompareStr
+    FTargetPlatform: TPasToJsPlatform;
+    FTargetProcessor: TPasToJsProcessor;
+    Function CreatePrimitiveDotExpr(AName: string; Src: TPasElement = nil): TJSElement;
+    Function CreateSubDeclNameExpr(El: TPasElement; const Name: string;
+      AContext: TConvertContext): TJSElement;
+    Function CreateIdentifierExpr(El: TPasElement; AContext: TConvertContext): TJSElement;
+    Function CreateIdentifierExpr(AName: string; El: TPasElement; AContext: TConvertContext): TJSElement;
+    Function CreateSwitchStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement;
+    Function CreateTypeDecl(El: TPasType; AContext: TConvertContext): TJSElement;
+    Function CreateVarDecl(El: TPasVariable; AContext: TConvertContext): TJSElement;
     Procedure AddToSourceElements(Src: TJSSourceElements; El: TJSElement);
-    Function CreateConstDecl(El: TPasElement; AContext: TConvertContext): TJSElement;
-    Function CreateIdentifierExpr(AName: String; El: TPasElement; AContext: TConvertContext): TJSElement;
-    Function CreateTypeDecl(El: TPasElement; AContext: TConvertContext): TJSElement;
-    Function CreateVarDecl(El: TPasElement; AContext: TConvertContext): TJSElement;
-    procedure SetCurrentContext(AValue: TJSElement);
+    procedure RemoveFromSourceElements(Src: TJSSourceElements;
+      El: TJSElement);
+    function GetBuildInNames(bin: TPas2JSBuiltInName): string;
+    procedure SetBuildInNames(bin: TPas2JSBuiltInName; const AValue: string);
+    procedure SetPreservedWords(const AValue: TJSReservedWordList);
+    procedure SetUseEnumNumbers(const AValue: boolean);
+    procedure SetUseLowerCase(const AValue: boolean);
+    procedure SetUseSwitchStatement(const AValue: boolean);
   protected
-    // helper functions
-    Procedure DoError(Const Msg : String);
-    Procedure DoError(Const Msg : String; Const Args : Array of Const);
-    // Never create an element manually, always use the below function
-    Function CreateElement(C: TJSElementClass; Src: TPasElement): TJSElement; virtual;
+    // Error functions
+    Procedure DoError(Id: int64; Const Msg : String);
+    Procedure DoError(Id: int64; Const Msg : String; Const Args : Array of Const);
+    Procedure DoError(Id: int64; MsgNumber: integer; const MsgPattern: string; Const Args : Array of Const; El: TPasElement);
+    procedure RaiseNotSupported(El: TPasElement; AContext: TConvertContext; Id: int64; const Msg: string = '');
+    procedure RaiseIdentifierNotFound(Identifier: string; El: TPasElement; Id: int64);
+    procedure RaiseInconsistency(Id: int64);
+    // Computation, value conversions
     Function GetExpressionValueType(El: TPasExpr; AContext: TConvertContext ): TJSType; virtual;
-    Function GetIdentValueType(AName: String; AContext: TConvertContext): TJSType; virtual;
-    Function TransFormIdent(El: TJSPrimaryExpressionIdent; AContext : TConvertContext): TJSElement;virtual;
-    Function CreateJSContext(AContext : TConvertContext): TJSElement;virtual;
-    Function TransFormVariableName(Const AName :  String; AContext : TConvertContext) : String;
-    Function TransFormVariableName(El : TPasElement; AContext : TConvertContext) : String;
-    Function TransFormFunctionName(El : TPasElement; AContext : TConvertContext) : String;
-    Function GetExceptionObjectname(AContext : TConvertContext) : String;
-    Function ResolveType(El : TPasElement; AContext : TConvertContext) : TPasType;
-    Function CreateCallStatement(const caltname: string;para: array of string): TJSCallExpression;
-    Function CreateCallStatement(const pex2: TJSElement;para: array of string): TJSCallExpression;
-    Function CreateProcedureDeclaration(const El: TPasElement):TJSFunctionDeclarationStatement;
-    Function CreateUnary(ms: array of string; E: TJSElement): TJSUnary;
-    Function CreateMemberExpression(ms: array of string): TJSDotMemberExpression;
-    Procedure Addproceduretoclass(sl: TJSStatementList; E: TJSElement;const P: TPasProcedure);
-    Function GetFunctionDefinitionInUnary(const fd: TJSFunctionDeclarationStatement;const funname: string; inunary: boolean): TJSFunctionDeclarationStatement;
-    Function GetFunctionUnaryName(var je: TJSElement;var fundec: TJSFunctionDeclarationStatement): TJSString;
+    Function GetPasIdentValueType(AName: String; AContext: TConvertContext): TJSType; virtual;
+    Function ComputeConstString(Expr: TPasExpr; AContext: TConvertContext; NotEmpty: boolean): String; virtual;
+    Function IsExternalClassConstructor(El: TPasElement): boolean;
+    Procedure ComputeRange(const RangeResolved: TPasResolverResult;
+      AContext: TConvertContext; out MinValue, MaxValue: int64;
+      ErrorEl: TPasElement); virtual;
+    // Name mangling
+    Function TransformVariableName(El: TPasElement; Const AName: String; AContext : TConvertContext): String; virtual;
+    Function TransformVariableName(El: TPasElement; AContext : TConvertContext) : String; virtual;
+    Function TransformModuleName(El: TPasModule; AddModulesPrefix: boolean; AContext : TConvertContext) : String; virtual;
+    Function IsPreservedWord(const aName: string): boolean; virtual;
+    // Never create an element manually, always use the below functions
+    Function IsElementUsed(El: TPasElement): boolean; virtual;
+    Function IsSystemUnit(aModule: TPasModule): boolean; virtual;
+    Function HasTypeInfo(El: TPasType; AContext: TConvertContext): boolean; virtual;
+    Function IsClassRTTICreatedBefore(aClass: TPasClassType; Before: TPasElement): boolean;
+    Function CreateElement(C: TJSElementClass; Src: TPasElement): TJSElement; virtual;
+    Function CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
+      AContext : TConvertContext): TJSCallExpression; virtual;
+    Function CreateFunction(El: TPasElement; WithBody: boolean = true;
+      WithSrc: boolean = false): TJSFunctionDeclarationStatement;
+    Procedure CreateProcedureCall(var Call: TJSCallExpression; Args: TParamsExpr;
+      TargetProc: TPasProcedureType; AContext: TConvertContext); virtual;
+    Procedure CreateProcedureCallArgs(Elements: TJSArrayLiteralElements;
+      Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext); virtual;
+    Function CreateProcCallArg(El: TPasExpr; TargetArg: TPasArgument;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateProcCallArgRef(El: TPasExpr; ResolvedEl: TPasResolverResult;
+      TargetArg: TPasArgument;  AContext: TConvertContext): TJSElement; virtual;
+    Function CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
+    Function CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
+    Function CreateCallExpression(El: TPasElement): TJSCallExpression;
+    Function CreateUsesList(UsesSection: TPasSection; AContext : TConvertContext): TJSArrayLiteral;
+    Procedure AddToStatementList(var First, Last: TJSStatementList;
+      Add: TJSElement; Src: TPasElement);
+    Function CreateValInit(PasType: TPasType; Expr: TPasElement; El: TPasElement;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateVarInit(El: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateVarStatement(const aName: String; Init: TJSElement;
+      El: TPasElement): TJSVariableStatement; virtual;
+    Function CreateVarDecl(const aName: String; Init: TJSElement; El: TPasElement): TJSVarDeclaration; virtual;
+    Function CreateLiteralNumber(El: TPasElement; const n: TJSNumber): TJSLiteral; virtual;
+    Function CreateLiteralString(El: TPasElement; const s: string): TJSLiteral; virtual;
+    Function CreateLiteralJSString(El: TPasElement; const s: TJSString): TJSLiteral; virtual;
+    Function CreateLiteralBoolean(El: TPasElement; b: boolean): TJSLiteral; virtual;
+    Function CreateLiteralNull(El: TPasElement): TJSLiteral; virtual;
+    Function CreateLiteralUndefined(El: TPasElement): TJSLiteral; virtual;
+    Function CreateSetLiteralElement(Expr: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ClonePrimaryExpression(El: TJSPrimaryExpression; Src: TPasElement): TJSPrimaryExpression;
+    Function CreateRecordInit(aRecord: TPasRecordType; Expr: TPasElement;
+      El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateArrayInit(ArrayType: TPasArrayType; Expr: TPasElement;
+      El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateCmpArrayWithNil(El: TPasElement; JSArray: TJSElement;
+      OpCode: TExprOpCode): TJSElement; virtual;
+    Function CreateReferencePath(El: TPasElement; AContext : TConvertContext;
+      Kind: TRefPathKind; Full: boolean = false; Ref: TResolvedReference = nil): string; virtual;
+    Function CreateReferencePathExpr(El: TPasElement; AContext : TConvertContext;
+      Full: boolean = false; Ref: TResolvedReference = nil): TJSElement; virtual;
+    Function CreateImplementationSection(El: TPasModule; AContext: TConvertContext): TJSFunctionDeclarationStatement;
+    Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext);
+    Function CreateDotExpression(aParent: TPasElement; Left, Right: TJSElement): TJSElement; virtual;
+    Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
+    Function CreateCloneRecord(El: TPasElement; ResolvedEl: TPasResolverResult;
+      RecordExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateCallback(El: TPasElement; ResolvedEl: TPasResolverResult;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateAssignStatement(LeftEl: TPasElement; AssignContext: TAssignContext): TJSElement; virtual;
+    Function CreateTypeInfoRef(El: TPasType; AContext: TConvertContext;
+      ErrorEl: TPasElement): TJSElement; virtual;
+    Function CreateRTTIArgList(Parent: TPasElement; Args: TFPList;
+      AContext: TConvertContext): TJSElement; virtual;
+    Procedure AddRTTIArgument(Arg: TPasArgument; TargetParams: TJSArrayLiteral;
+      AContext: TConvertContext); virtual;
+    Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
+      IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
+    Function CreateRTTIClassField(V: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIClassMethod(Proc: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIClassProperty(Prop: TPasProperty; AContext: TConvertContext): TJSElement; virtual;
     // Statements
-    Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertStatement(El: TPasImplStatement; AContext: TConvertContext ): TJSElement;virtual;
+    Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
+    Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
+    Function ConvertStatement(El: TPasImplStatement; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertAssignStatement(El: TPasImplAssign; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRaiseStatement(El: TPasImplRaise; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertIfStatement(El: TPasImplIfElse; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertWhileStatement(El: TPasImplWhileDo; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRepeatStatement(El: TPasImplRepeatUntil; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertForStatement(El: TPasImplForLoop; AContext: TConvertContext): TJSElement; virtual;
-    Function ConvertFinalizationSection(El: TFinalizationSection; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertInitializationSection(El: TInitializationSection; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertSimpleStatement(El: TPasImplSimple; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertTryStatement(El: TPasImplTry; AContext: TConvertContext ): TJSElement;virtual;
-    Function ConvertWithStatement(El: TPasImplWithDo; AContext: TConvertContext): TJSElement;virtual;
-    Function ConvertTryFinallyStatement(El: TPasImplTryFinally; AContext: TConvertContext): TJSElement;virtual;
+    Function ConvertFinalizationSection(El: TFinalizationSection; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertInitializationSection(El: TInitializationSection; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSimpleStatement(El: TPasImplSimple; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertWithStatement(El: TPasImplWithDo; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertTryStatement(El: TPasImplTry; AContext: TConvertContext ): TJSElement; virtual;
     Function ConvertExceptOn(El: TPasImplExceptOn; AContext: TConvertContext): TJSElement;
-    Function ConvertTryExceptStatement(El: TPasImplTryExcept; AContext: TConvertContext): TJSElement;
+    Function ConvertCaseOfStatement(El: TPasImplCaseOf; AContext: TConvertContext): TJSElement;
+    Function ConvertAsmStatement(El: TPasImplAsmStatement; AContext: TConvertContext): TJSElement;
     // Expressions
-    Function ConvertArrayValues(El: TArrayValues; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertInheritedExpression(El: TInheritedExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertNilExpr(El: TNilExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertParamsExpression(El: TParamsExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertRecordValues(El: TRecordValues; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertSelfExpression(El: TSelfExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertBinaryExpression(El: TBinaryExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertBoolConstExpression(El: TBoolConstExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertUnaryExpression(El: TUnaryExpr; AContext : TConvertContext ): TJSElement;virtual;
-    Function ConvertCallExpression(El: TParamsExpr; AContext : TConvertContext ): TJSElement;virtual;
-    Function TransFormStringLiteral(S : String) : String;
-    // Convert various TPasElement nodes
-    Function ConvertProperty(El: TPasProperty; AContext : TConvertContext ): TJSElement;virtual;
-    Function ConvertCommand(El: TPasImplCommand; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertCommands(El: TPasImplCommands; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertConst(El: TPasConst; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertDeclarations(El: TPasDeclarations; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertExportSymbol(El: TPasExportSymbol; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertExpression(El: TPasExpr; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertImplBlock(El: TPasImplBlock; AContext : TConvertContext ): TJSElement;virtual;
-    Function ConvertLabelMark(El: TPasImplLabelMark; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertLabels(El: TPasLabels; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertModule(El: TPasModule; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertPackage(El: TPasPackage; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertArgument(El: TPasArgument; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertProcedure(El: TPasProcedure; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertProcedureImpl(El: TPasProcedureImpl; AContext : TConvertContext    ): TJSElement;virtual;
-    Function ConvertResString(El: TPasResString; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertResultElement(El: TPasResultElement; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertType(El: TPasElement; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertVariable(El: TPasVariable; AContext : TConvertContext): TJSElement;virtual;
-    Function ConvertElement(El : TPasElement; AContext : TConvertContext) : TJSElement; virtual;
-    function ConvertClassType(const EL: TPasClassType;const AContext: TConvertContext): TJSElement;
-    Function ConvertClassMember(El: TPasElement;AContext: TConvertContext): TJSElement;
-    Function ConvertClassconstructor(El: TPasConstructor;AContext: TConvertContext): TJSElement;
-    Property CurrentContext : TJSElement Read FCurrentContext Write SetCurrentContext;
+    Function ConvertArrayValues(El: TArrayValues; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertInheritedExpression(El: TInheritedExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertParamsExpression(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExternalConstructor(Left: TPasElement; Ref: TResolvedReference;
+      ParamsExpr: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertTObjectFree(Bin: TBinaryExpr; NameExpr: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertTypeCastToBaseType(El: TParamsExpr; AContext: TConvertContext; ToBaseTypeData: TResElDataBaseType): TJSElement; virtual;
+    Function ConvertSetLiteral(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertOpenArrayParam(ElType: TPasType; El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Length(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_SetLength(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_ExcludeInclude(El: TParamsExpr; AContext: TConvertContext; IsInclude: boolean): TJSElement; virtual;
+    Function ConvertBuiltInContinue(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInBreak(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Exit(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_IncDec(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Assigned(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Chr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Ord(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Low(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_High(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Pred(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Succ(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_StrProc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_StrFunc(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltInStrParam(El: TPasExpr; AContext: TConvertContext; IsStrFunc, IsFirst: boolean): TJSElement; virtual;
+    Function ConvertBuiltIn_ConcatArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_CopyArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_InsertArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_DeleteArray(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_TypeInfo(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBinaryExpressionRes(El: TBinaryExpr; AContext: TConvertContext;
+      const LeftResolved, RightResolved: TPasResolverResult; var A,B: TJSElement): TJSElement; virtual;
+    Function ConvertSubIdentExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBoolConstExpression(El: TBoolConstExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertIdentifierExpr(El: TPasExpr; const aName: string; AContext : TConvertContext): TJSElement; virtual;
+    Function ConvertUnaryExpression(El: TUnaryExpr; AContext: TConvertContext): TJSElement; virtual;
+    // Convert declarations
+    Function ConvertElement(El : TPasElement; AContext: TConvertContext) : TJSElement; virtual;
+    Function ConvertProperty(El: TPasProperty; AContext: TConvertContext ): TJSElement; virtual;
+    Function ConvertCommand(El: TPasImplCommand; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertCommands(El: TPasImplCommands; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertConst(El: TPasConst; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertDeclarations(El: TPasDeclarations; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExportSymbol(El: TPasExportSymbol; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExpression(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertImplBlock(El: TPasImplBlock; AContext: TConvertContext ): TJSElement; virtual;
+    Function ConvertLabelMark(El: TPasImplLabelMark; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertLabels(El: TPasLabels; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertModule(El: TPasModule; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertPackage(El: TPasPackage; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertProcedure(El: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertResString(El: TPasResString; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertVariable(El: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertRecordType(El: TPasRecordType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertClassForwardType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertClassExternalType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertClassOfType(El: TPasClassOfType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertEnumType(El: TPasEnumType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertSetType(El: TPasSetType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertPointerType(El: TPasPointerType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertProcedureType(El: TPasProcedureType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertArrayType(El: TPasArrayType; AContext: TConvertContext): TJSElement; virtual;
+  Public
+    // RTTI, TypeInfo constants
+    const
+      // TParamFlag
+      pfVar = 1;
+      pfConst = 2;
+      pfOut = 4;
+      pfArray = 8;
+      // TProcedureFlag
+      pfStatic = 1;
+      pfVarargs = 2;
+      pfExternal = 4;
+      // TPropertyFlag
+      pfGetFunction = 1;
+      pfSetProcedure = 2;
+      pfStoredFunction = 4;
+    type
+      TMethodKind = (
+        mkProcedure, // 0  default
+        mkFunction,  // 1
+        mkConstructor,  // 2
+        mkDestructor,   // 3
+        mkClassProcedure,  // 4
+        mkClassFunction  // 5
+        );
   Public
-    Function ConvertElement(El : TPasElement) : TJSElement;
-    Property NameSpace : TJSString Read FNameSpace Write FNameSpace;
-    Property MainFunction : TJSString Read FMainFunction Write FMainFunction;
+    Constructor Create;
+    destructor Destroy; override;
+    Function ConvertPasElement(El: TPasElement; Resolver: TPas2JSResolver) : TJSElement;
+    // options
+    Property Options: TPasToJsConverterOptions read FOptions write FOptions;
+    Property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform;
+    Property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
+    Property UseLowerCase: boolean read GetUseLowerCase write SetUseLowerCase default true;
+    Property UseSwitchStatement: boolean read GetUseSwitchStatement write SetUseSwitchStatement;// default false, because slower than "if" in many engines
+    Property UseEnumNumbers: boolean read GetUseEnumNumbers write SetUseEnumNumbers; // default false
+    Property OnIsElementUsed: TPas2JSIsElementUsedEvent read FOnIsElementUsed write FOnIsElementUsed;
+    Property OnIsTypeInfoUsed: TPas2JSIsElementUsedEvent read FOnIsTypeInfoUsed write FOnIsTypeInfoUsed;
+    Property PreservedWords: TJSReservedWordList read FPreservedWords write SetPreservedWords;
+    // names
+    Property BuildInNames[bin: TPas2JSBuiltInName]: string read GetBuildInNames write SetBuildInNames;
   end;
-  EPasToJS = Class(Exception);
+
+var
+  JSTypeCaptions: array[TJSType] of string = (
+    'undefined',
+    'null',
+    'boolean',
+    'number',
+    'string',
+    'object',
+    'reference',
+    'completion'
+    );
+
+function CodePointToJSString(u: longword): TJSString;
+function PosLast(c: char; const s: string): integer;
 
 implementation
 
-resourcestring
-  SErrUNknownExpressionClass = 'Unknown expression class: %s';
-  SErrUnexpected = 'Unexpected class: %s';
-  SerrInitalizedArray = 'Initialized array variables not yet supported';
+const
+  TempRefObjGetterName = 'get';
+  TempRefObjSetterName = 'set';
+  TempRefObjSetterArgName = 'v';
 
-{ TPasToJSConverter }
+function CodePointToJSString(u: longword): TJSString;
+begin
+  if u < $10000 then
+    // Note: codepoints $D800 - $DFFF are reserved
+    Result:=WideChar(u)
+  else
+    Result:=WideChar($D800+((u - $10000) shr 10))+WideChar($DC00+((u - $10000) and $3ff));
+end;
+
+function PosLast(c: char; const s: string): integer;
+begin
+  Result:=length(s);
+  while (Result>0) and (s[Result]<>c) do dec(Result);
+end;
 
-Procedure TPasToJSConverter.AddToSourceElements(Src : TJSSourceElements; El : TJSElement);
+{ TFCLocalVar }
 
-Var
-  L : TJSStatementList;
-  A : TJSElement;
+constructor TFCLocalVar.Create(const aName: string; TheEl: TPasElement);
+begin
+  Name:=aName;
+  Element:=TheEl;
+end;
+
+{ TPas2JSResolver }
+
+// inline
+function TPas2JSResolver.GetJSBaseTypes(aBaseType: TPas2jsBaseType
+  ): TPasUnresolvedSymbolRef;
+begin
+  Result:=TPasUnresolvedSymbolRef(FJSBaseTypes[aBaseType]);
+end;
+
+procedure TPas2JSResolver.InternalAdd(Item: TPasIdentifier);
+var
+  Index: Integer;
+  OldItem: TPasIdentifier;
+  aName: ShortString;
+begin
+  aName:=Item.Identifier;
+  Index:=FExternalNames.FindIndexOf(aName);
+  {$IFDEF VerbosePasResolver}
+  if Item.Owner<>nil then
+    raise Exception.Create('20170322235419');
+  Item.Owner:=Self;
+  {$ENDIF}
+  //writeln('  Index=',Index);
+  if Index>=0 then
+    begin
+    // insert LIFO - last in, first out
+    OldItem:=TPasIdentifier(FExternalNames.List^[Index].Data);
+    {$IFDEF VerbosePasResolver}
+    if OldItem.Identifier<>aName then
+      raise Exception.Create('20170322235429');
+    {$ENDIF}
+    Item.NextSameIdentifier:=OldItem;
+    FExternalNames.List^[Index].Data:=Item;
+    end
+  else
+    begin
+    FExternalNames.Add(aName, Item);
+    {$IFDEF VerbosePasResolver}
+    if FindExternalName(Item.Identifier)<>Item then
+      raise Exception.Create('20170322235433');
+    {$ENDIF}
+    end;
+end;
+
+procedure TPas2JSResolver.OnClearHashItem(Item, Dummy: pointer);
+var
+  PasIdentifier: TPasIdentifier absolute Item;
+  Ident: TPasIdentifier;
+begin
+  if Dummy=nil then ;
+  //writeln('TPas2JSResolver.OnClearItem ',PasIdentifier.Identifier+':'+PasIdentifier.ClassName);
+  while PasIdentifier<>nil do
+    begin
+    Ident:=PasIdentifier;
+    PasIdentifier:=PasIdentifier.NextSameIdentifier;
+    Ident.Free;
+    end;
+end;
 
+function TPas2JSResolver.HasOverloadIndex(El: TPasElement): boolean;
+var
+  C: TClass;
+  ProcScope: TPasProcedureScope;
 begin
-  Repeat
-    if Not (EL is TJSStatementList) then
+  C:=El.ClassType;
+  if C=TPasProperty then
+    exit(false)
+  else if C=TPasClassType then
+    begin
+    if TPasClassType(El).IsForward then
+      exit(false);
+    end
+  else if C.InheritsFrom(TPasProcedure) then
+    begin
+    if TPasProcedure(El).IsOverride then
+      exit(true);
+    // Note: external proc pollutes the name space
+    ProcScope:=TPasProcedureScope(El.CustomData);
+    if ProcScope.DeclarationProc<>nil then
+      // implementation proc -> only count the header -> skip
+      exit(false);
+    end;
+  Result:=true;
+end;
+
+function TPas2JSResolver.GetOverloadIndex(Identifier: TPasIdentifier;
+  StopAt: TPasElement): integer;
+// if not found return number of overloads
+// if found return index in overloads
+var
+  El: TPasElement;
+begin
+  Result:=0;
+  // iterate from last added to first added
+  // Note: the first added has Index=0
+  while Identifier<>nil do
+    begin
+    El:=Identifier.Element;
+    Identifier:=Identifier.NextSameIdentifier;
+    if El=StopAt then
       begin
-      A:=EL;
-      El:=Nil;
+      Result:=0;
+      continue;
+      end;
+    if HasOverloadIndex(El) then
+      inc(Result);
+    end;
+end;
+
+function TPas2JSResolver.GetOverloadAt(Identifier: TPasIdentifier;
+  var Index: integer): TPasIdentifier;
+// if found Result<>nil and Index=0
+// if not found Result=nil and Index is reduced by number of overloads
+var
+  El: TPasElement;
+  CurIdent: TPasIdentifier;
+  Count: Integer;
+begin
+  if Identifier=nil then exit(nil);
+  // Note: the Identifier chain is from last added to first added
+  // -> get length of chain
+  Count:=0;
+  CurIdent:=Identifier;
+  while CurIdent<>nil do
+    begin
+    El:=CurIdent.Element;
+    CurIdent:=CurIdent.NextSameIdentifier;
+    if HasOverloadIndex(El) then
+      inc(Count);
+    end;
+  if Count<=Index then
+    begin
+    // Index is not in this scope
+    dec(Index);
+    exit(nil);
+    end;
+  // Index is in this scope -> find it
+  CurIdent:=Identifier;
+  while CurIdent<>nil do
+    begin
+    if HasOverloadIndex(CurIdent.Element) then
+      begin
+      dec(Count);
+      if (Index=Count) then
+        begin
+        Index:=0;
+        Result:=CurIdent;
+        exit;
+        end;
+      end;
+    CurIdent:=CurIdent.NextSameIdentifier;
+    end;
+end;
+
+function TPas2JSResolver.GetOverloadIndex(El: TPasElement): integer;
+var
+  i: Integer;
+  Identifier: TPasIdentifier;
+begin
+  Result:=0;
+  for i:=FOverloadScopes.Count-1 downto 0 do
+    begin
+    // find last added
+    Identifier:=TPasIdentifierScope(FOverloadScopes[i]).FindLocalIdentifier(El.Name);
+    // add count or index
+    inc(Result,GetOverloadIndex(Identifier,El));
+    end;
+  // find in external names
+  Identifier:=FindExternalName(El.Name);
+  // add count or index
+  inc(Result,GetOverloadIndex(Identifier,El));
+end;
+
+function TPas2JSResolver.GetOverloadAt(const aName: String; Index: integer
+  ): TPasIdentifier;
+var
+  i: Integer;
+begin
+  Result:=nil;
+  for i:=FOverloadScopes.Count-1 downto 0 do
+    begin
+    // find last added
+    Result:=TPasIdentifierScope(FOverloadScopes[i]).FindLocalIdentifier(aName);
+    Result:=GetOverloadAt(Result,Index);
+    if Result<>nil then
+      exit;
+    end;
+  // find in external names
+  Result:=FindExternalName(aName);
+  Result:=GetOverloadAt(Result,Index);
+end;
+
+function TPas2JSResolver.RenameOverload(El: TPasElement): boolean;
+var
+  OverloadIndex: Integer;
+
+  function GetDuplicate: TPasElement;
+  var
+    Duplicate: TPasIdentifier;
+  begin
+    Duplicate:=GetOverloadAt(El.Name,0);
+    Result:=Duplicate.Element;
+  end;
+
+var
+  NewName: String;
+  Duplicate: TPasElement;
+begin
+  // => count overloads in this section
+  OverloadIndex:=GetOverloadIndex(El);
+  if OverloadIndex=0 then
+    exit(false); // there is no overload
+
+  if (El.ClassType=TPasClassFunction)
+      and (TPas2JSClassScope(TPasClassType(El.Parent).CustomData).NewInstanceFunction=El) then
+    begin
+    Duplicate:=GetDuplicate;
+    RaiseMsg(20170324234324,nNewInstanceFunctionMustNotHaveOverloadAtX,
+      sNewInstanceFunctionMustNotHaveOverloadAtX,[GetElementSourcePosStr(Duplicate)],El);
+    end;
+  if El.Visibility=visPublished then
+    begin
+    Duplicate:=GetDuplicate;
+    RaiseMsg(20170413220924,nDuplicateIdentifier,sDuplicateIdentifier,
+      [Duplicate.Name,GetElementSourcePosStr(Duplicate)],El);
+    end;
+
+  NewName:=El.Name+'$'+IntToStr(OverloadIndex);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPas2JSResolver.RenameOverload "',El.Name,'" has overload. NewName="',NewName,'"');
+  {$ENDIF}
+  El.Name:=NewName;
+  Result:=true;
+end;
+
+procedure TPas2JSResolver.RenameOverloadsInSection(aSection: TPasSection);
+var
+  ImplSection: TImplementationSection;
+  SectionClass: TClass;
+begin
+  if aSection=nil then exit;
+  PushOverloadScope(aSection.CustomData as TPasIdentifierScope);
+  RenameOverloads(aSection,aSection.Declarations);
+  SectionClass:=aSection.ClassType;
+  if SectionClass=TInterfaceSection then
+    begin
+    // unit interface
+    // first rename all overloads in interface and implementation
+    ImplSection:=(aSection.Parent as TPasModule).ImplementationSection;
+    if ImplSection<>nil then
+      begin
+      PushOverloadScope(ImplSection.CustomData as TPasIdentifierScope);
+      RenameOverloads(ImplSection,ImplSection.Declarations);
+      end;
+    // and then rename all nested overloads (e.g. methods)
+    // Important: nested overloads must check both interface and implementation
+    RenameSubOverloads(aSection.Declarations);
+    if ImplSection<>nil then
+      begin
+      RenameSubOverloads(ImplSection.Declarations);
+      PopOverloadScope;
+      end;
+    end
+  else
+    begin
+    // program or library
+    RenameSubOverloads(aSection.Declarations);
+    end;
+  PopOverloadScope;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPas2JSResolver.RenameOverloadsInSection END ',GetObjName(aSection));
+  {$ENDIF}
+end;
+
+procedure TPas2JSResolver.RenameOverloads(DeclEl: TPasElement;
+  Declarations: TFPList);
+var
+  i: Integer;
+  El: TPasElement;
+  Proc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+begin
+  //IsExternalClass:=(DeclEl is TPasClassType) and (TPasClassType(DeclEl).IsExternal);
+  if DeclEl=nil then;
+  for i:=0 to Declarations.Count-1 do
+    begin
+    El:=TPasElement(Declarations[i]);
+    if (El is TPasProcedure) then
+      begin
+      Proc:=TPasProcedure(El);
+      if Proc.IsOverride or Proc.IsExternal then
+        continue;
+      // Note: Pascal names of external procs are not in the JS, so no need to rename them
+      ProcScope:=Proc.CustomData as TPasProcedureScope;
+      //writeln('TPas2JSResolver.RenameOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
+      if ProcScope.DeclarationProc<>nil then
+        begin
+        if ProcScope.ImplProc<>nil then
+          RaiseInternalError(20170221110853);
+        // proc implementation (not forward) -> skip
+        continue;
+        end;
+      // proc declaration (header, not body)
+      if RenameOverload(Proc) then
+        if ProcScope.ImplProc<>nil then
+          ProcScope.ImplProc.Name:=Proc.Name;
+      end;
+    end;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPas2JSResolver.RenameOverloads END ',GetObjName(DeclEl));
+  {$ENDIF}
+end;
+
+procedure TPas2JSResolver.RenameSubOverloads(Declarations: TFPList);
+var
+  i, OldScopeCount: Integer;
+  El: TPasElement;
+  Proc, ImplProc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+  ClassScope, aScope: TPasClassScope;
+  ClassEl: TPasClassType;
+  C: TClass;
+begin
+  for i:=0 to Declarations.Count-1 do
+    begin
+    El:=TPasElement(Declarations[i]);
+    C:=El.ClassType;
+    if C.InheritsFrom(TPasProcedure) then
+      begin
+      Proc:=TPasProcedure(El);
+      if Proc.IsAbstract or Proc.IsExternal then continue;
+      ProcScope:=Proc.CustomData as TPasProcedureScope;
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassScope));
+      {$ENDIF}
+      if ProcScope.DeclarationProc<>nil then
+        // proc implementation (not forward) -> skip
+        continue;
+      ImplProc:=Proc;
+      if ProcScope.ImplProc<>nil then
+        begin
+        // this proc has a separate implementation
+        // -> switch to implementation
+        ImplProc:=ProcScope.ImplProc;
+        ProcScope:=ImplProc.CustomData as TPasProcedureScope;
+        end;
+      PushOverloadScope(ProcScope);
+      // first rename all overloads on this level
+      RenameOverloads(ImplProc.Body,ImplProc.Body.Declarations);
+      // then process nested procedures
+      RenameSubOverloads(ImplProc.Body.Declarations);
+      PopOverloadScope;
+      end
+    else if C=TPasClassType then
+      begin
+      ClassEl:=TPasClassType(El);
+      if ClassEl.IsForward then continue;
+      ClassScope:=El.CustomData as TPas2JSClassScope;
+      OldScopeCount:=FOverloadScopes.Count;
+
+      // add class and ancestors scopes
+      aScope:=ClassScope;
+      repeat
+        PushOverloadScope(aScope);
+        aScope:=aScope.AncestorScope;
+      until aScope=nil;
+
+      // first rename all overloads on this level
+      RenameOverloads(ClassEl,ClassEl.Members);
+      // then process nested procedures
+      RenameSubOverloads(ClassEl.Members);
+
+      while FOverloadScopes.Count>OldScopeCount do
+        PopOverloadScope;
       end
+    else if C=TPasConst then
+      RenameOverload(El)
+    else if C.InheritsFrom(TPasVariable) and (El.Parent.ClassType=TPasClassType) then
+      RenameOverload(El);
+    end;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPas2JSResolver.RenameSubOverloads END');
+  {$ENDIF}
+end;
+
+procedure TPas2JSResolver.PushOverloadScope(Scope: TPasIdentifierScope);
+begin
+  FOverloadScopes.Add(Scope);
+end;
+
+procedure TPas2JSResolver.PopOverloadScope;
+begin
+  FOverloadScopes.Delete(FOverloadScopes.Count-1);
+end;
+
+procedure TPas2JSResolver.AddType(El: TPasType);
+begin
+  inherited AddType(El);
+  if TopScope is TPasClassScope then
+    RaiseNotYetImplemented(20170608232534,El,'nested types');
+end;
+
+procedure TPas2JSResolver.ResolveImplAsm(El: TPasImplAsmStatement);
+{type
+  TAsmToken = (
+    atNone,
+    atWord,
+    atDot,
+    atRoundBracketOpen,
+    atRoundBracketClose
+    );
+
+  procedure Next;
+  begin
+
+  end;}
+
+var
+  Lines: TStrings;
+begin
+  Lines:=El.Tokens;
+  if Lines=nil then exit;
+end;
+
+procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
+  Access: TResolvedRefAccess);
+
+  procedure CheckTObjectFree(Ref: TResolvedReference);
+  var
+    Bin: TBinaryExpr;
+    Left: TPasExpr;
+    LeftResolved: TPasResolverResult;
+    IdentEl: TPasElement;
+  begin
+    if not IsTObjectFreeMethod(El) then exit;
+    if Ref.WithExprScope<>nil then
+      begin
+      // with expr do free
+      if GetNewInstanceExpr(Ref.WithExprScope.Expr)<>nil then
+        exit; // with TSomeClass.Free do Free  -> ok
+      RaiseMsg(20170517092407,nFreeNeedsVar,sFreeNeedsVar,[],El);
+      end;
+    if (El.Parent.ClassType<>TBinaryExpr) then
+      RaiseMsg(20170516151916,nFreeNeedsVar,sFreeNeedsVar,[],El);
+    Bin:=TBinaryExpr(El.Parent);
+    if (Bin.right<>El) or (Bin.OpCode<>eopSubIdent) then
+      RaiseMsg(20170516151950,nFreeNeedsVar,sFreeNeedsVar,[],El);
+    if rrfImplicitCallWithoutParams in Ref.Flags then
+      // ".Free;" -> ok
+    else if Bin.Parent is TParamsExpr then
+      begin
+      if Bin.Parent.Parent is TPasExpr then
+        RaiseMsg(20170516161345,nFreeNeedsVar,sFreeNeedsVar,[],El);
+      // ".Free();" -> ok
+      end
+    else if Bin.Parent is TPasImplElement then
+      // ok
     else
       begin
-      L:=EL as TJSStatementList;
-      A:=L.A;
-      EL:=L.B;
-      L.A:=Nil;
-      L.B:=Nil;
-      FreeAndNil(L);
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JSResolver.ResolveNameExpr.CheckTObjectFree Bin.Parent=',GetObjName(Bin.Parent));
+      {$ENDIF}
+      RaiseMsg(20170516160347,nFreeNeedsVar,sFreeNeedsVar,[],El);
       end;
-    Src.Statements.AddNode.Node:=A;
-  until (El=Nil);
+
+    Left:=Bin.left;
+    ComputeElement(Left,LeftResolved,[]);
+    if not (rrfReadable in LeftResolved.Flags) then
+      RaiseMsg(20170516152300,nFreeNeedsVar,sFreeNeedsVar,[],El);
+    if not (rrfWritable in LeftResolved.Flags) then
+      RaiseMsg(20170516152307,nFreeNeedsVar,sFreeNeedsVar,[],El);
+    IdentEl:=LeftResolved.IdentEl;
+    if IdentEl=nil then
+      RaiseMsg(20170516152401,nFreeNeedsVar,sFreeNeedsVar,[],El);
+    if IdentEl.ClassType=TPasArgument then
+      exit; // readable and writable argument -> ok
+    if (IdentEl.ClassType=TPasVariable)
+       or (IdentEl.ClassType=TPasConst) then
+      exit; // readable and writable variable -> ok
+    if IdentEl.ClassType=TPasResultElement then
+      exit; // readable and writable function result -> ok
+    RaiseMsg(20170516152455,nFreeNeedsVar,sFreeNeedsVar,[],El);
+  end;
+
+var
+  Ref: TResolvedReference;
+begin
+  inherited ResolveNameExpr(El, aName, Access);
+  if El.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(El.CustomData);
+    if (CompareText(aName,'free')=0) then
+      CheckTObjectFree(Ref);
+    end;
 end;
 
-Function TPasToJSConverter.ConvertModule(El: TPasModule; AContext : TConvertContext): TJSElement;
+procedure TPas2JSResolver.FinishModule(CurModule: TPasModule);
+var
+  ModuleClass: TClass;
+begin
+  inherited FinishModule(CurModule);
+  FOverloadScopes:=TFPList.Create;
+  try
+    ModuleClass:=CurModule.ClassType;
+    if ModuleClass=TPasModule then
+      begin
+      RenameOverloadsInSection(CurModule.InterfaceSection);
+      // Note: ImplementationSection is child of InterfaceSection
+      end
+    else if ModuleClass=TPasProgram then
+      RenameOverloadsInSection(TPasProgram(CurModule).ProgramSection)
+    else if CurModule.ClassType=TPasLibrary then
+      RenameOverloadsInSection(TPasLibrary(CurModule).LibrarySection)
+    else
+      RaiseNotYetImplemented(20170221000032,CurModule);
+  finally
+    FOverloadScopes.Free;
+  end;
+end;
 
-Var
-  I : Integer;
-  Src : TJSSourceElements;
+procedure TPas2JSResolver.FinishSetType(El: TPasSetType);
+var
+  TypeEl: TPasType;
+begin
+  inherited FinishSetType(El);
+  TypeEl:=ResolveAliasType(El.EnumType);
+  if TypeEl.ClassType=TPasEnumType then
+    // ok
+  else
+    RaiseMsg(20170415182320,nNotSupportedX,sNotSupportedX,['set of '+TypeEl.Name],El);
+end;
 
+procedure TPas2JSResolver.FinishClassType(El: TPasClassType);
 begin
-  Result:=Nil;
-  Src:=TJSSourceElements(CreateElement(TJSSourceElements,El));
-  Result:=Src;
-  if Assigned(El.InterfaceSection) then
-    AddToSourceElements(Src,ConvertElement(El.InterfaceSection,AContext));
-  if assigned(El.ImplementationSection) then
-    AddToSourceElements(Src,ConvertElement(El.ImplementationSection,AContext));
-  if (El is TPasProgram) then
+  inherited FinishClassType(El);
+  if El.IsExternal then
     begin
-    if Assigned(TPasProgram(El).ProgramSection) then
-      AddToSourceElements(Src,ConvertElement(TPasProgram(El).ProgramSection,AContext));
+    if El.ExternalName='' then
+      RaiseMsg(20170321151109,nMissingExternalName,sMissingExternalName,[],El);
+    AddExternalPath(El.ExternalName,El);
     end;
-  if Assigned(El.InitializationSection) then
-    AddToSourceElements(Src,ConvertElement(El.InitializationSection,AContext));
-  if Assigned(El.FinalizationSection) then
-    AddToSourceElements(Src,ConvertElement(El.FinalizationSection,AContext));
-{
-TPasUnitModule = Class(TPasModule)
-TPasLibrary = class(TPasModule)
+end;
+
+procedure TPas2JSResolver.FinishVariable(El: TPasVariable);
+const
+  ClassFieldModifiersAllowed = [vmClass,vmStatic,vmExternal,vmPublic];
+  RecordVarModifiersAllowed = [];
+  LocalVarModifiersAllowed = [];
+  ImplementationVarModifiersAllowed = [vmExternal];
+  SectionVarModifiersAllowed = [vmExternal,vmPublic];
+
+  procedure RaiseVarModifierNotSupported(const Allowed: TVariableModifiers);
+  var
+    s: String;
+    m: TVariableModifier;
+  begin
+    s:='';
+    for m in TVariableModifiers do
+      if (m in El.VarModifiers) and not (m in Allowed) then
+        begin
+        str(m,s);
+        RaiseMsg(20170322134418,nInvalidVariableModifier,
+          sInvalidVariableModifier,[VariableModifierNames[m]],El);
+        end;
+  end;
+
+var
+  ExtName: String;
+  ParentC: TClass;
+begin
+  inherited FinishVariable(El);
+  ParentC:=El.Parent.ClassType;
+  if (ParentC=TPasClassType) then
+    begin
+    // class member
+    RaiseVarModifierNotSupported(ClassFieldModifiersAllowed);
+    if TPasClassType(El.Parent).IsExternal then
+      begin
+      // external class -> make variable external
+      if not (vmExternal in El.VarModifiers) then
+        begin
+        if (El.ClassType=TPasVariable) or (El.ClassType=TPasConst) then
+          begin
+          if El.ExportName<>nil then
+            RaiseMsg(20170322134321,nInvalidVariableModifier,
+              sInvalidVariableModifier,['export name'],El.ExportName);
+          El.ExportName:=TPrimitiveExpr.Create(El,pekString,''''+El.Name+'''');
+          end;
+        Include(El.VarModifiers,vmExternal);
+        end;
+      if El.Visibility=visPublished then
+        // Note: an external class has no typeinfo
+        RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished,
+          [],El);
+      end;
+    end
+  else if ParentC=TPasRecordType then
+    // record member
+    RaiseVarModifierNotSupported(RecordVarModifiersAllowed)
+  else if ParentC=TProcedureBody then
+    // local var
+    RaiseVarModifierNotSupported(LocalVarModifiersAllowed)
+  else if ParentC=TImplementationSection then
+    // implementation var
+    RaiseVarModifierNotSupported(ImplementationVarModifiersAllowed)
+  else if ParentC.InheritsFrom(TPasSection) then
+    begin
+    // interface/program/library var
+    RaiseVarModifierNotSupported(SectionVarModifiersAllowed);
+    end
+  else
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPas2JSResolver.FinishVariable ',GetObjName(El),' Parent=',GetObjName(El.Parent));
+    {$ENDIF}
+    RaiseNotYetImplemented(20170324151259,El);
+    end;
+
+  if vmExternal in El.VarModifiers then
+    begin
+    // compute constant
+    if El.LibraryName<>nil then
+      RaiseMsg(20170227094227,nPasElementNotSupported,sPasElementNotSupported,
+        ['library'],El.ExportName);
+    if El.ExportName=nil then
+      RaiseMsg(20170227100750,nMissingExternalName,sMissingExternalName,[],El);
+    ExtName:=ComputeConstString(El.ExportName,true,true);
+    if (El.Visibility=visPublished) and (ExtName<>El.Name) then
+      RaiseMsg(20170407002940,nPublishedNameMustMatchExternal,
+        sPublishedNameMustMatchExternal,[],El.ExportName);
+    // add external name to FExternalNames
+    if (El.Parent is TPasSection)
+        or ((El.ClassType=TPasConst) and (El.Parent is TPasProcedure)) then
+      AddExternalPath(ExtName,El.ExportName);
+    end;
+end;
+
+procedure TPas2JSResolver.FinishProcedureType(El: TPasProcedureType);
+var
+  Proc: TPasProcedure;
+  pm: TProcedureModifier;
+  ExtName: String;
+  C: TClass;
+  AClass: TPasClassType;
+  ClassScope: TPas2JSClassScope;
+  ptm: TProcTypeModifier;
+begin
+  inherited FinishProcedureType(El);
+  if El.Parent is TPasProcedure then
+    begin
+    Proc:=TPasProcedure(El.Parent);
+
+    // calling convention
+    if Proc.CallingConvention<>ccDefault then
+      RaiseMsg(20170211214731,nPasElementNotSupported,sPasElementNotSupported,
+        [cCallingConventions[Proc.CallingConvention]],Proc);
+
+    for pm in TProcedureModifiers do
+      if (pm in Proc.Modifiers)
+          and (not (pm in [pmVirtual, pmAbstract, pmOverride,
+                           pmOverload, pmReintroduce,
+                           pmAssembler, pmPublic,
+                           pmExternal, pmForward])) then
+        RaiseNotYetImplemented(20170208142159,El,'modifier '+ModifierNames[pm]);
+    for ptm in TProcTypeModifiers do
+      if (ptm in Proc.ProcType.Modifiers)
+          and (not (ptm in [ptmOfObject,ptmVarargs])) then
+        RaiseNotYetImplemented(20170411171454,El,'modifier '+ProcTypeModifiers[ptm]);
+
+    // check pmPublic
+    if [pmPublic,pmExternal]<=Proc.Modifiers then
+      RaiseMsg(20170324150149,nInvalidXModifierY,
+        sInvalidXModifierY,[Proc.ElementTypeName,'public, external'],Proc);
+    if (Proc.PublicName<>nil) then
+      RaiseMsg(20170324150417,nPasElementNotSupported,sPasElementNotSupported,
+        ['public name'],Proc.PublicName);
+
+    if (Proc.Parent.ClassType=TPasClassType) then
+      begin
+      // class member
+      AClass:=TPasClassType(Proc.Parent);
+      ClassScope:=AClass.CustomData as TPas2JSClassScope;
+
+      if AClass.IsExternal then
+        begin
+        // external class -> make method external
+        if not (pmExternal in Proc.Modifiers) then
+          begin
+          if Proc.LibrarySymbolName<>nil then
+            RaiseMsg(20170322142158,nInvalidXModifierY,
+              sInvalidXModifierY,[Proc.ElementTypeName,'symbol name'],Proc.LibrarySymbolName);
+          Proc.Modifiers:=Proc.Modifiers+[pmExternal];
+          Proc.LibrarySymbolName:=TPrimitiveExpr.Create(El,pekString,''''+Proc.Name+'''');
+          end;
+
+        if Proc.Visibility=visPublished then
+          // Note: an external class has no typeinfo
+          RaiseMsg(20170413221327,nSymbolCannotBePublished,sSymbolCannotBePublished,
+            [],Proc);
+
+        C:=Proc.ClassType;
+        if (C=TPasProcedure) or (C=TPasFunction)
+            or (C=TPasClassProcedure) or (C=TPasClassFunction) then
+          // ok
+        else if C=TPasConstructor then
+          begin
+          if Proc.IsVirtual then
+            // constructor of external class can't be overriden -> forbid virtual
+            RaiseMsg(20170323100447,nInvalidXModifierY,sInvalidXModifierY,
+              [Proc.ElementTypeName,'virtual,external'],Proc);
+          if CompareText(Proc.Name,'new')=0 then
+            begin
+            ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
+            if ExtName<>Proc.Name then
+              RaiseMsg(20170323083511,nVirtualMethodNameMustMatchExternal,
+                sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
+            end
+          else if El.Args.Count>0 then
+            RaiseMsg(20170322164357,nNoArgumentsAllowedForExternalObjectConstructor,
+              sNoArgumentsAllowedForExternalObjectConstructor,[],TPasArgument(El.Args[0]));
+          if pmVirtual in Proc.Modifiers then
+            RaiseMsg(20170322183141,nInvalidXModifierY,sInvalidXModifierY,
+              [Proc.ElementTypeName,'virtual'],Proc.ProcType);
+          end
+        else
+          RaiseMsg(20170322163210,nPasElementNotSupported,sPasElementNotSupported,
+            [Proc.ElementTypeName],Proc);
+
+        end
+      else
+        begin
+        // Pascal class
+        if (ClassScope.NewInstanceFunction=nil)
+            and (ClassScope.AncestorScope<>nil)
+            and (TPasClassType(ClassScope.AncestorScope.Element).IsExternal)
+            and (Proc.ClassType=TPasClassFunction)
+            and (Proc.Visibility in [visProtected,visPublic,visPublished])
+            and (TPasClassFunction(Proc).FuncType.ResultEl.ResultType=AClass)
+            and ([pmOverride,pmExternal]*Proc.Modifiers=[]) then
+          begin
+          // The first non private class function in a Pascal class descending
+          // from an external class
+          // -> this is the NewInstance function
+          ClassScope.NewInstanceFunction:=TPasClassFunction(Proc);
+          CheckNewInstanceFunction(ClassScope);
+          end;
+        end;
+      end;
+
+    if pmExternal in Proc.Modifiers then
+      begin
+      // external proc
+
+      // external override -> unneeded information, probably a bug
+      if Proc.IsOverride then
+        RaiseMsg(20170321101715,nInvalidXModifierY,sInvalidXModifierY,
+          [Proc.ElementTypeName,'override,external'],Proc);
+
+      if Proc.LibraryExpr<>nil then
+        RaiseMsg(20170211220712,nPasElementNotSupported,sPasElementNotSupported,
+          ['external library name'],Proc.LibraryExpr);
+      if Proc.LibrarySymbolName=nil then
+        RaiseMsg(20170227095454,nMissingExternalName,sMissingExternalName,
+          ['missing external name'],Proc);
+
+      for pm in [pmAssembler,pmForward,pmNoReturn,pmInline] do
+        if pm in Proc.Modifiers then
+          RaiseMsg(20170323100842,nInvalidXModifierY,sInvalidXModifierY,
+            [Proc.ElementTypeName,ModifierNames[pm]],Proc);
+
+      // compute external name
+      ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
+
+      // a virtual must have the external name, so that override works
+      if Proc.IsVirtual and (Proc.Name<>ExtName) then
+        RaiseMsg(20170321090049,nVirtualMethodNameMustMatchExternal,
+          sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
+
+      // a published must have the external name, so that streaming works
+      if (Proc.Visibility=visPublished) then
+        begin
+        if (Proc.Name<>ExtName) then
+          RaiseMsg(20170407002940,nPublishedNameMustMatchExternal,
+            sPublishedNameMustMatchExternal,[],Proc.LibrarySymbolName);
+        if ExtName=ExtClassBracketAccessor then
+          RaiseMsg(20170409211805,nSymbolCannotBePublished,
+            sSymbolCannotBePublished,[],Proc.LibrarySymbolName);
+        end;
+
+      if Proc.Parent is TPasSection then
+        AddExternalPath(ExtName,Proc.LibrarySymbolName);
+
+      exit;
+      end;
+    end;
+end;
+
+procedure TPas2JSResolver.FinishPropertyOfClass(PropEl: TPasProperty);
+var
+  Getter, Setter: TPasElement;
+  GetterIsBracketAccessor, SetterIsBracketAccessor: Boolean;
+  Arg: TPasArgument;
+  ArgResolved: TPasResolverResult;
+  ParentC: TClass;
+begin
+  inherited FinishPropertyOfClass(PropEl);
+
+  ParentC:=PropEl.Parent.ClassType;
+  if (ParentC=TPasClassType) then
+    begin
+    // class member
+    if TPasClassType(PropEl.Parent).IsExternal then
+      begin
+      // external class
+      if PropEl.Visibility=visPublished then
+        // Note: an external class has no typeinfo
+        RaiseMsg(20170413221703,nSymbolCannotBePublished,sSymbolCannotBePublished,
+          [],PropEl);
+      end;
+    end;
+
+  Getter:=GetPasPropertyGetter(PropEl);
+  GetterIsBracketAccessor:=IsExternalBracketAccessor(Getter);
+  Setter:=GetPasPropertySetter(PropEl);
+  SetterIsBracketAccessor:=IsExternalBracketAccessor(Setter);
+  if GetterIsBracketAccessor then
+    begin
+    if PropEl.Args.Count<>1 then
+      RaiseMsg(20170403001743,nBracketAccessorOfExternalClassMustHaveOneParameter,
+        sBracketAccessorOfExternalClassMustHaveOneParameter,
+        [],PropEl);
+    end;
+  if SetterIsBracketAccessor then
+    begin
+    if PropEl.Args.Count<>1 then
+      RaiseMsg(20170403001806,nBracketAccessorOfExternalClassMustHaveOneParameter,
+        sBracketAccessorOfExternalClassMustHaveOneParameter,
+        [],PropEl);
+    end;
+  if GetterIsBracketAccessor or SetterIsBracketAccessor then
+    begin
+    Arg:=TPasArgument(PropEl.Args[0]);
+    if not (Arg.Access in [argDefault,argConst]) then
+      RaiseMsg(20170403090225,nXExpectedButYFound,sXExpectedButYFound,
+        ['default or "const"',AccessNames[Arg.Access]],PropEl);
+    ComputeElement(Arg,ArgResolved,[rcType],Arg);
+    if not (ArgResolved.BaseType in (btAllJSInteger+btAllJSStringAndChars+btAllJSBooleans+btAllJSFloats)) then
+      RaiseMsg(20170403090628,nIncompatibleTypesGotExpected,
+        sIncompatibleTypesGotExpected,
+        [GetResolverResultDescription(ArgResolved,true),'string'],Arg);
+    end;
+end;
+
+procedure TPas2JSResolver.CheckConditionExpr(El: TPasExpr;
+  const ResolvedEl: TPasResolverResult);
+begin
+  if (ResolvedEl.BaseType=btCustom) and (IsJSBaseType(ResolvedEl,pbtJSValue)) then
+    exit;
+  inherited CheckConditionExpr(El, ResolvedEl);
+end;
+
+procedure TPas2JSResolver.CheckNewInstanceFunction(ClassScope: TPas2JSClassScope
+  );
+var
+  Proc: TPasClassFunction;
+  Args: TFPList;
+  Arg: TPasArgument;
+  ResolvedArg: TPasResolverResult;
+begin
+  Proc:=ClassScope.NewInstanceFunction;
+  // proc modifiers override and external were already checked
+  // visibility was already checked
+  // function result type was already checked
+  if not Proc.IsVirtual then
+    RaiseMsg(20170324231040,nNewInstanceFunctionMustBeVirtual,
+      sNewInstanceFunctionMustBeVirtual,[],Proc);
+  Args:=Proc.ProcType.Args;
+  if Args.Count<2 then
+    RaiseMsg(20170324232247,nNewInstanceFunctionMustHaveTwoParameters,
+      sNewInstanceFunctionMustHaveTwoParameters,[],Proc.ProcType);
+
+  // first param must be a string
+  Arg:=TPasArgument(Args[0]);
+  if Arg.Access<>argDefault then
+    RaiseMsg(20170324232655,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+      ['1',AccessNames[Arg.Access],'default (none)'],Arg);
+  if Arg.ArgType=nil then
+    RaiseMsg(20170324233201,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+      ['1','untyped','String'],Arg);
+  ComputeElement(Arg.ArgType,ResolvedArg,[rcType]);
+  if ResolvedArg.BaseType<>btString then
+    RaiseMsg(20170324233348,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+      ['1',GetResolverResultDescription(ResolvedArg),'String'],Arg);
+
+  // second param must be const untyped
+  Arg:=TPasArgument(Args[1]);
+  if Arg.Access<>argConst then
+    RaiseMsg(20170324233457,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+      ['2',AccessNames[Arg.Access],'const'],Arg);
+  if Arg.ArgType<>nil then
+    RaiseMsg(20170324233508,nIncompatibleTypeArgNo,sIncompatibleTypeArgNo,
+      ['2','type','untyped'],Arg);
+end;
+
+function TPas2JSResolver.AddExternalName(const aName: string; El: TPasElement
+  ): TPasIdentifier;
+var
+  Item: TPasIdentifier;
+begin
+  //writeln('TPas2JSResolver.AddExternalIdentifier Name="',aName,'" El=',GetObjName(El));
+  Item:=TPasIdentifier.Create;
+  Item.Identifier:=aName;
+  Item.Element:=El;
+
+  InternalAdd(Item);
+  //writeln('TPas2JSResolver.AddExternalIdentifier END');
+  Result:=Item;
+end;
+
+function TPas2JSResolver.FindExternalName(const aName: String
+  ): TPasIdentifier;
+begin
+  Result:=TPasIdentifier(FExternalNames.Find(aName));
+  {$IFDEF VerbosePasResolver}
+  if (Result<>nil) and (Result.Owner<>Self) then
+    begin
+    writeln('TPas2JSResolver.FindExternalName Result.Owner<>Self Owner='+GetObjName(Result.Owner));
+    raise Exception.Create('20170322235814');
+    end;
+  {$ENDIF}
+end;
+
+procedure TPas2JSResolver.AddExternalPath(aName: string; El: TPasElement);
+// add aName and the first identifier of aName
+var
+  p: PChar;
+  l: integer;
+begin
+  aName:=Trim(aName);
+  if aName='' then exit;
+  AddExternalName(aName,El);
+  p:=PChar(aName);
+  while p^ in ['a'..'z','A'..'Z','0'..'9','_','$'] do inc(p);
+  l:=p-PChar(aName);
+  if l=length(aName) then exit;
+  AddExternalName(LeftStr(aName,l),El);
+end;
+
+procedure TPas2JSResolver.ClearElementData;
+var
+  Data, Next: TPas2JsElementData;
+begin
+  Data:=FFirstElementData;
+  while Data<>nil do
+    begin
+    Next:=Data.Next;
+    Data.Free;
+    Data:=Next;
+    end;
+  FFirstElementData:=nil;
+  FLastElementData:=nil;
+
+  FExternalNames.ForEachCall(@OnClearHashItem,nil);
+  FExternalNames.Clear;
+end;
+
+function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType
+  ): TResElDataPas2JSBaseType;
+var
+  El: TPasUnresolvedSymbolRef;
+begin
+  El:=AddCustomBaseType(aName,TResElDataPas2JSBaseType);
+  if Typ<>pbtNone then
+    FJSBaseTypes[Typ]:=El;
+  Result:=TResElDataPas2JSBaseType(El.CustomData);
+  Result.JSBaseType:=Typ;
+end;
+
+function TPas2JSResolver.IsJSBaseType(TypeEl: TPasType; Typ: TPas2jsBaseType
+  ): boolean;
+begin
+  Result:=(TypeEl is TPasUnresolvedSymbolRef)
+    and (CompareText(TypeEl.Name,Pas2jsBaseTypeNames[Typ])=0)
+    and (TypeEl.CustomData is TResElDataPas2JSBaseType);
+end;
+
+function TPas2JSResolver.IsJSBaseType(const TypeResolved: TPasResolverResult;
+  Typ: TPas2jsBaseType; HasValue: boolean): boolean;
+begin
+  if (TypeResolved.BaseType<>btCustom) or not IsJSBaseType(TypeResolved.TypeEl,Typ) then
+    exit(false);
+  if HasValue and not (rrfReadable in TypeResolved.Flags) then
+    exit(false);
+  Result:=true;
+end;
+
+function TPas2JSResolver.CheckAssignCompatibilityCustom(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
+  var Handled: boolean): integer;
+var
+  LeftBaseType: TPas2jsBaseType;
+  LArray: TPasArrayType;
+  ElTypeResolved: TPasResolverResult;
+begin
+  Result:=cIncompatible;
+  if LHS.BaseType=btCustom then
+    begin
+    if not (LHS.TypeEl is TPasUnresolvedSymbolRef) then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JSResolver.CheckAssignCompatibilityCustomBaseType LHS=',GetResolverResultDbg(LHS));
+      {$ENDIF}
+      RaiseInternalError(20170325114554);
+      end;
+    if not (LHS.TypeEl.CustomData is TResElDataPas2JSBaseType) then
+      exit;
+    Handled:=true;
+    LeftBaseType:=TResElDataPas2JSBaseType(LHS.TypeEl.CustomData).JSBaseType;
+    if LeftBaseType=pbtJSValue then
+      begin
+      // assign to a JSValue
+      if rrfReadable in RHS.Flags then
+        begin
+        // RHS is a value
+        if (RHS.BaseType in btAllJSValueSrcTypes) then
+          Result:=cJSValueConversion // type cast to JSValue
+        else if RHS.BaseType=btCustom then
+          begin
+          if IsJSBaseType(RHS,pbtJSValue) then
+            Result:=cExact;
+          end
+        else if RHS.BaseType=btContext then
+          Result:=cJSValueConversion;
+        end
+      else if RHS.BaseType=btContext then
+        begin
+        // RHS is not a value
+        if RHS.IdentEl<>nil then
+          begin
+          if RHS.IdentEl.ClassType=TPasClassType then
+            Result:=cJSValueConversion; // RHS is a class type
+          end;
+        end;
+      end;
+    end
+  else if (LHS.BaseType=btContext) and (LHS.TypeEl.ClassType=TPasArrayType)
+      and (rrfReadable in RHS.Flags) then
+    begin
+    LArray:=TPasArrayType(LHS.TypeEl);
+    if length(LArray.Ranges)>0 then
+      exit;
+    if (RHS.BaseType<>btContext) or (RHS.TypeEl.ClassType<>TPasArrayType) then
+      exit;
+    ComputeElement(LArray.ElType,ElTypeResolved,[rcType]);
+    if IsJSBaseType(ElTypeResolved,pbtJSValue) then
+      begin
+      // array of jsvalue := array
+      Handled:=true;
+      Result:=cJSValueConversion;
+      end;
+    end;
+
+  if RaiseOnIncompatible then ;
+  if ErrorEl=nil then ;
+end;
+
+function TPas2JSResolver.CheckTypeCastClassInstanceToClass(const FromClassRes,
+  ToClassRes: TPasResolverResult; ErrorEl: TPasElement): integer;
+var
+  ToClass: TPasClassType;
+  ClassScope: TPasClassScope;
+begin
+  if FromClassRes.BaseType=btNil then exit(cExact);
+  ToClass:=(ToClassRes.TypeEl as TPasClassType);
+  ClassScope:=ToClass.CustomData as TPasClassScope;
+  if ClassScope.AncestorScope=nil then
+    // type cast to root class
+    Result:=cTypeConversion+1
+  else
+    Result:=cIncompatible;
+  if ErrorEl=nil then ;
+end;
+
+function TPas2JSResolver.CheckEqualCompatibilityCustomType(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+var
+  LeftBaseType: TPas2jsBaseType;
+begin
+  Result:=cIncompatible;
+  if LHS.BaseType=btCustom then
+    begin
+    if not (LHS.TypeEl is TPasUnresolvedSymbolRef) then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JSResolver.CheckEqualCompatibilityCustomType LHS=',GetResolverResultDbg(LHS));
+      {$ENDIF}
+      RaiseInternalError(20170330005841);
+      end;
+    if not (LHS.TypeEl.CustomData is TResElDataPas2JSBaseType) then
+      exit;
+    LeftBaseType:=TResElDataPas2JSBaseType(LHS.TypeEl.CustomData).JSBaseType;
+    if LeftBaseType=pbtJSValue then
+      begin
+      if (rrfReadable in LHS.Flags) then
+        begin
+        if (rrfReadable in RHS.Flags) then
+          begin
+          if RHS.BaseType in btAllJSValueSrcTypes then
+            Result:=cJSValueConversion
+          else if RHS.BaseType=btCustom then
+            begin
+            if IsJSBaseType(RHS,pbtJSValue) then
+              Result:=cExact;
+            end
+          else if RHS.BaseType=btContext then
+            Result:=cJSValueConversion;
+          end
+        else if RHS.BaseType=btContext then
+          begin
+          // right side is not a value
+          if RHS.IdentEl<>nil then
+            begin
+            if RHS.IdentEl.ClassType=TPasClassType then
+              Result:=cJSValueConversion; // RHS is a class
+            end;
+          end;
+        end;
+      end;
+    end
+  else if RHS.BaseType=btCustom then
+    exit(CheckEqualCompatibilityCustomType(RHS,LHS,ErrorEl,RaiseOnIncompatible))
+  else
+    RaiseInternalError(20170330005725);
+end;
+
+procedure TPas2JSResolver.BI_TypeInfo_OnGetCallResult(
+  Proc: TResElDataBuiltInProc; Params: TParamsExpr; out
+  ResolvedEl: TPasResolverResult);
+// if an external type with the right name and external name is in scope return
+// that, otherwise btPointer
+var
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  C: TClass;
+  TIName: String;
+  FindData: TPRFindData;
+  Abort: boolean;
+  bt: TResolverBaseType;
+  jbt: TPas2jsBaseType;
+  TypeEl: TPasType;
+  FoundClass: TPasClassType;
+begin
+  Param:=Params.Params[0];
+  ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  if ParamResolved.TypeEl=nil then
+    RaiseInternalError(20170413090726);
+  if (ParamResolved.BaseType=btProc) and (ParamResolved.IdentEl is TPasFunction) then
+    begin
+    // typeinfo of function result -> resolve once
+    TypeEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType;
+    ComputeElement(TypeEl,ParamResolved,[rcNoImplicitProc]);
+    Include(ParamResolved.Flags,rrfReadable);
+    if ParamResolved.TypeEl=nil then
+      RaiseInternalError(20170421124923);
+    end;
+
+  TypeEl:=ResolveAliasType(ParamResolved.TypeEl);
+  C:=TypeEl.ClassType;
+  TIName:='';
+  //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TypeEl=',GetObjName(TypeEl));
+
+  if C=TPasUnresolvedSymbolRef then
+    begin
+    if TypeEl.CustomData is TResElDataPas2JSBaseType then
+      begin
+      jbt:=TResElDataPas2JSBaseType(TypeEl.CustomData).JSBaseType;
+      if jbt=pbtJSValue then
+        TIName:=Pas2JSBuiltInNames[pbitnTI];
+      end
+    else if TypeEl.CustomData is TResElDataBaseType then
+      begin
+      bt:=TResElDataBaseType(TypeEl.CustomData).BaseType;
+      if bt in btAllJSInteger then
+        TIName:=Pas2JSBuiltInNames[pbitnTIInteger]
+      else if bt in [btString,btChar,btDouble,btBoolean] then
+        TIName:=Pas2JSBuiltInNames[pbitnTI]
+      else if bt=btPointer then
+        TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
+      end;
+    end
+  else if ParamResolved.BaseType=btContext then
+    begin
+    if C=TPasEnumType then
+      TIName:=Pas2JSBuiltInNames[pbitnTIEnum]
+    else if C=TPasSetType then
+      TIName:=Pas2JSBuiltInNames[pbitnTISet]
+    else if C.InheritsFrom(TPasProcedureType) then
+      begin
+      if TPasProcedureType(TypeEl).IsReferenceTo then
+        TIName:=Pas2JSBuiltInNames[pbitnTIRefToProcVar]
+      else if TPasProcedureType(TypeEl).IsOfObject then
+        TIName:=Pas2JSBuiltInNames[pbitnTIMethodVar]
+      else
+        TIName:=Pas2JSBuiltInNames[pbitnTIProcVar];
+      end
+    else if C=TPasRecordType then
+      TIName:=Pas2JSBuiltInNames[pbitnTIRecord]
+    else if C=TPasClassType then
+      TIName:=Pas2JSBuiltInNames[pbitnTIClass]
+    else if C=TPasClassOfType then
+      begin
+      if rrfReadable in ParamResolved.Flags then
+        TIName:=Pas2JSBuiltInNames[pbitnTIClass]
+      else
+        TIName:=Pas2JSBuiltInNames[pbitnTIClassRef];
+      end
+    else if C=TPasArrayType then
+      begin
+      if length(TPasArrayType(TypeEl).Ranges)>0 then
+        TIName:=Pas2JSBuiltInNames[pbitnTIStaticArray]
+      else
+        TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
+      end
+    else if C=TPasPointerType then
+      TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
+    end
+  else if ParamResolved.BaseType=btSet then
+    begin
+    if ParamResolved.IdentEl is TPasSetType then
+      TIName:=Pas2JSBuiltInNames[pbitnTISet];
+    end;
+  if TIName='' then
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult ',GetResolverResultDbg(ParamResolved));
+    {$ENDIF}
+    RaiseMsg(20170413091852,nTypeIdentifierExpected,sTypeIdentifierExpected,[],Param);
+    end;
+
+  // search for TIName
+  FindData:=Default(TPRFindData);
+  FindData.ErrorPosEl:=Params;
+  Abort:=false;
+  IterateElements(TIName,@OnFindFirstElement,@FindData,Abort);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName="',TIName,'" FindData.Found="',GetObjName(FindData.Found),'"');
+  {$ENDIF}
+  if (FindData.Found<>nil) and (FindData.Found.ClassType=TPasClassType) then
+    begin
+    FoundClass:=TPasClassType(FindData.Found);
+    if FoundClass.IsExternal
+        and (FoundClass.ExternalName=Pas2JSBuiltInNames[pbivnRTL]+'.'+TIName) then
+      begin
+      // use external class definition
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult FindData.Found="',FindData.Found.FullName,'"');
+      {$ENDIF}
+      SetResolverTypeExpr(ResolvedEl,btContext,TPasClassType(FindData.Found),[rrfReadable]);
+      exit;
+      end;
+    end;
+
+  // default: btPointer
+  SetResolverTypeExpr(ResolvedEl,btPointer,BaseTypes[btPointer],[rrfReadable]);
+
+  if Proc=nil then ;
+end;
+
+constructor TPas2JSResolver.Create;
+var
+  bt: TPas2jsBaseType;
+begin
+  inherited;
+  FExternalNames:=TFPHashList.Create;
+  StoreSrcColumns:=true;
+  Options:=Options+DefaultPasResolverOptions;
+  ScopeClass_Class:=TPas2JSClassScope;
+  ScopeClass_WithExpr:=TPas2JSWithExprScope;
+  for bt in [pbtJSValue] do
+    AddJSBaseType(Pas2jsBaseTypeNames[bt],bt);
+  AnonymousElTypePostfix:=Pas2JSBuiltInNames[pbitnAnonymousPostfix];
+  BaseTypeChar:=btWideChar;
+  BaseTypeString:=btUnicodeString;
+  BaseTypeLength:=btIntDouble;
+end;
+
+destructor TPas2JSResolver.Destroy;
+begin
+  ClearElementData;
+  FreeAndNil(FExternalNames);
+  inherited Destroy;
+end;
+
+procedure TPas2JSResolver.AddObjFPCBuiltInIdentifiers(
+  const TheBaseTypes: TResolveBaseTypes;
+  const TheBaseProcs: TResolverBuiltInProcs);
+var
+  InvalidTypes: TResolveBaseTypes;
+  bt: TResolverBaseType;
+  InvalidProcs: TResolverBuiltInProcs;
+  bf: TResolverBuiltInProc;
+begin
+  InvalidTypes:=TheBaseTypes-btAllJSBaseTypes;
+  if InvalidTypes<>[] then
+    for bt in InvalidTypes do
+      RaiseInternalError(20170409180202,BaseTypeNames[bt]);
+  InvalidProcs:=TheBaseProcs-bfAllJSBaseProcs;
+  if InvalidProcs<>[] then
+    for bf in InvalidProcs do
+      RaiseInternalError(20170409180246,ResolverBuiltInProcNames[bf]);
+  inherited AddObjFPCBuiltInIdentifiers(TheBaseTypes-[btUIntDouble,btIntDouble],TheBaseProcs);
+  if btUIntDouble in TheBaseTypes then
+    AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble);
+  if btIntDouble in TheBaseTypes then
+    AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble);
+end;
+
+function TPas2JSResolver.CheckTypeCastRes(const FromResolved,
+  ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
+  ): integer;
+var
+  JSBaseType: TPas2jsBaseType;
+  C: TClass;
+  ToClass: TPasClassType;
+begin
+  Result:=cIncompatible;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPas2JSResolver.CheckTypeCastCustomBaseType To=',GetResolverResultDbg(ToResolved),' From=',GetResolverResultDbg(FromResolved));
+  {$ENDIF}
+  if rrfReadable in FromResolved.Flags then
+    begin
+    if (ToResolved.BaseType=btCustom) then
+      begin
+      if not (ToResolved.TypeEl is TPasUnresolvedSymbolRef) then
+        RaiseInternalError(20170325142826);
+      if (ToResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
+        begin
+        // type cast to pas2js type, e.g. JSValue(V)
+        JSBaseType:=TResElDataPas2JSBaseType(ToResolved.TypeEl.CustomData).JSBaseType;
+        if JSBaseType=pbtJSValue then
+          begin
+          if rrfReadable in FromResolved.Flags then
+            begin
+            if (FromResolved.BaseType in btAllJSValueSrcTypes) then
+              Result:=cExact+1 // type cast to JSValue
+            else if FromResolved.BaseType=btCustom then
+              begin
+              if IsJSBaseType(FromResolved,pbtJSValue) then
+                Result:=cExact;
+              end
+            else if FromResolved.BaseType=btContext then
+              Result:=cExact+1;
+            end;
+          end;
+        exit;
+        end;
+      end
+    else if FromResolved.BaseType=btCustom then
+      begin
+      if not (FromResolved.TypeEl is TPasUnresolvedSymbolRef) then
+        RaiseInternalError(20170325143016);
+      if (FromResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
+        begin
+        // type cast a pas2js value, e.g. T(jsvalue)
+        if not (rrfReadable in FromResolved.Flags) then
+          exit;
+        JSBaseType:=TResElDataPas2JSBaseType(FromResolved.TypeEl.CustomData).JSBaseType;
+        if JSBaseType=pbtJSValue then
+          begin
+          if (ToResolved.BaseType in btAllJSValueTypeCastTo) then
+            Result:=cExact+1 // type cast JSValue to simple base type
+          else if ToResolved.BaseType=btContext then
+            begin
+            // typecast JSValue to user type
+            Result:=cExact+1;
+            end;
+          end;
+        exit;
+        end;
+      end
+    else if ToResolved.BaseType=btContext then
+      begin
+      C:=ToResolved.TypeEl.ClassType;
+      if C=TPasClassType then
+        begin
+        ToClass:=TPasClassType(ToResolved.TypeEl);
+        if ToClass.IsExternal then
+          begin
+          if IsExternalClassName(ToClass,'String')
+              and (FromResolved.BaseType in btAllJSStringAndChars) then
+            exit(cExact);
+          if IsExternalClassName(ToClass,'Array')
+              and (FromResolved.BaseType=btContext) then
+            exit(cExact);
+          end;
+        end
+      else if C=TPasArrayType then
+        begin
+        if (FromResolved.BaseType=btContext)
+            and (FromResolved.TypeEl.ClassType=TPasClassType)
+            and TPasClassType(FromResolved.TypeEl).IsExternal
+            and IsExternalClassName(TPasClassType(FromResolved.TypeEl),'Array') then
+          begin
+            // type cast external Array to an array
+            exit(cExact+1);
+          end;
+        end;
+      end;
+    end;
+  Result:=inherited CheckTypeCastRes(FromResolved,ToResolved,ErrorEl,RaiseOnError);
+end;
+
+function TPas2JSResolver.ExtractPasStringLiteral(El: TPasElement;
+  const S: String): TJSString;
+{ Extracts the value from a Pascal string literal
+
+  S is a Pascal string literal e.g. 'Line'#10
+    ''  empty string
+    '''' => "'"
+    #decimal
+    #$hex
+    ^l  l is a letter a-z
 }
+var
+  p, StartP: PChar;
+  c: Char;
+  i: Integer;
+begin
+  Result:='';
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ExtractPasStringLiteral "',S,'"');
+  {$ENDIF}
+  if S='' then
+    RaiseInternalError(20170207154543);
+  p:=PChar(S);
+  repeat
+    case p^ of
+    #0: break;
+    '''':
+      begin
+      inc(p);
+      StartP:=p;
+      repeat
+        c:=p^;
+        case c of
+        #0:
+          RaiseInternalError(20170207155120);
+        '''':
+          begin
+          if p>StartP then
+            Result:=Result+TJSString(copy(S,StartP-PChar(S)+1,p-StartP));
+          inc(p);
+          StartP:=p;
+          if p^<>'''' then
+            break;
+          Result:=Result+'''';
+          inc(p);
+          StartP:=p;
+          end;
+        else
+          inc(p);
+        end;
+      until false;
+      if p>StartP then
+        Result:=Result+TJSString(copy(S,StartP-PChar(S)+1,p-StartP));
+      end;
+    '#':
+      begin
+      inc(p);
+      if p^='$' then
+        begin
+        // #$hexnumber
+        inc(p);
+        StartP:=p;
+        i:=0;
+        repeat
+          c:=p^;
+          case c of
+          #0: break;
+          '0'..'9': i:=i*16+ord(c)-ord('0');
+          'a'..'f': i:=i*16+ord(c)-ord('a')+10;
+          'A'..'F': i:=i*16+ord(c)-ord('A')+10;
+          else break;
+          end;
+          if i>$10ffff then
+            RaiseNotYetImplemented(20170207164657,El,'maximum codepoint is $10ffff');
+          inc(p);
+        until false;
+        if p=StartP then
+          RaiseInternalError(20170207164956);
+        Result:=Result+CodePointToJSString(i);
+        end
+      else
+        begin
+        // #decimalnumber
+        StartP:=p;
+        i:=0;
+        repeat
+          c:=p^;
+          case c of
+          #0: break;
+          '0'..'9': i:=i*10+ord(c)-ord('0');
+          else break;
+          end;
+          if i>$10ffff then
+            RaiseNotYetImplemented(20170207171140,El,'maximum codepoint is $10ffff');
+          inc(p);
+        until false;
+        if p=StartP then
+          RaiseInternalError(20170207171148);
+        Result:=Result+CodePointToJSString(i);
+        end;
+      end;
+    '^':
+      begin
+      // ^A is #1
+      inc(p);
+      c:=p^;
+      case c of
+      'a'..'z': Result:=Result+TJSChar(ord(c)-ord('a')+1);
+      'A'..'Z': Result:=Result+TJSChar(ord(c)-ord('A')+1);
+      else RaiseInternalError(20170207160412);
+      end;
+      inc(p);
+      end;
+    else
+      RaiseNotYetImplemented(20170207154653,El,'ord='+IntToStr(ord(p^)));
+    end;
+  until false;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ExtractPasStringLiteral Result="',Result,'"');
+  {$ENDIF}
 end;
 
-Function TPasToJSConverter.CreateElement(C : TJSElementClass; Src : TPasElement) : TJSElement;
+function TPas2JSResolver.ComputeConst(Expr: TPasExpr; StoreCustomData: boolean
+  ): TJSValue;
+var
+  Prim: TPrimitiveExpr;
+  V: TJSValue;
+  ConstData: TP2JConstExprData;
+begin
+  Result:=nil;
+  if Expr=nil then
+    RaiseInternalError(20170215123600);
+  if StoreCustomData and (Expr.CustomData is TPasElementBase) then
+    begin
+    ConstData:=TP2JConstExprData(GetElementData(
+                           TPasElementBase(Expr.CustomData),TP2JConstExprData));
+    if ConstData<>nil then
+      begin
+      // use stored result
+      Result:=ConstData.Value;
+      exit;
+      end;
+    end;
+
+  V:=nil;
+  try
+    if Expr.ClassType=TPrimitiveExpr then
+      begin
+      Prim:=TPrimitiveExpr(Expr);
+      if Prim.Kind=pekString then
+        V:=TJSValue.Create(ExtractPasStringLiteral(Prim,Prim.Value))
+      else
+        RaiseNotYetImplemented(20170215124733,Prim);
+      end
+    else
+      RaiseNotYetImplemented(20170215124746,Expr);
+    Result:=V;
+
+    if StoreCustomData then
+      begin
+      // store result
+      ConstData:=TP2JConstExprData(CreateElementData(TP2JConstExprData,Expr));
+      ConstData.Value:=V;
+      end;
+  finally
+    if Result=nil then
+      V.Free;
+  end;
+end;
 
+function TPas2JSResolver.ComputeConstString(Expr: TPasExpr; StoreCustomData,
+  NotEmpty: boolean): String;
+var
+  V: TJSValue;
 begin
-  if Assigned(Src) then
-    Result:=C.Create(Src.SourceLinenumber,1,Src.SourceFilename)
+  V:=ComputeConst(Expr,StoreCustomData);
+  if V.ValueType<>jsbase.jstString then
+    RaiseNotYetImplemented(20170320220728,Expr,'expected string constant');
+  if V.ValueType<>jstString then
+    RaiseMsg(20170211221121,nExpectedXButFoundY,sExpectedXButFoundY,['string literal',JSTypeCaptions[V.ValueType]],Expr);
+  if NotEmpty and (V.AsString='') then
+    RaiseMsg(20170321085318,nExpectedXButFoundY,sExpectedXButFoundY,['string literal','empty'],Expr);
+  Result:=String(V.AsString);
+end;
+
+function TPas2JSResolver.GetElementData(El: TPasElementBase;
+  DataClass: TPas2JsElementDataClass): TPas2JsElementData;
+begin
+  Result:=nil;
+  repeat
+    if El.InheritsFrom(DataClass) then
+      exit(TPas2JsElementData(El));
+    if El.CustomData=nil then exit;
+    El:=El.CustomData as TPasElementBase;
+  until false;
+end;
+
+procedure TPas2JSResolver.AddElementData(Data: TPas2JsElementData);
+begin
+  Data.Owner:=Self;
+  if FFirstElementData<>nil then
+    begin
+    FLastElementData.Next:=Data;
+    FLastElementData:=Data;
+    end
+  else
+    begin
+    FFirstElementData:=Data;
+    FLastElementData:=Data;
+    end;
+end;
+
+function TPas2JSResolver.CreateElementData(DataClass: TPas2JsElementDataClass;
+  El: TPasElement): TPas2JsElementData;
+begin
+  Result:=DataClass.Create;
+  Result.Element:=El;
+  AddElementData(Result);
+end;
+
+function TPas2JSResolver.GetBaseDescription(const R: TPasResolverResult;
+  AddPath: boolean): string;
+begin
+  if (R.BaseType=btCustom) and (R.TypeEl.CustomData is TResElDataPas2JSBaseType) then
+    Result:=Pas2jsBaseTypeNames[TResElDataPas2JSBaseType(R.TypeEl.CustomData).JSBaseType]
   else
-    Result:=C.Create(0,0,'');
+    Result:=inherited GetBaseDescription(R, AddPath);
+end;
+
+function TPas2JSResolver.HasTypeInfo(El: TPasType): boolean;
+begin
+  Result:=inherited HasTypeInfo(El);
+  if not Result then exit;
+  if (El.ClassType=TPasClassType) and TPasClassType(El).IsExternal then
+    exit(false);
+  if El.Parent is TProcedureBody then
+    Result:=false;
+end;
+
+function TPas2JSResolver.IsTObjectFreeMethod(El: TPasExpr): boolean;
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if El.ClassType<>TPrimitiveExpr then exit;
+  if not (El.CustomData is TResolvedReference) then exit;
+  Ref:=TResolvedReference(El.CustomData);
+  if CompareText(TPrimitiveExpr(El).Value,'free')<>0 then exit;
+  Decl:=Ref.Declaration;
+  if not (Decl.ClassType=TPasProcedure)
+      or (Decl.Parent.ClassType<>TPasClassType)
+      or (CompareText(Decl.Parent.Name,'tobject')<>0)
+      or (pmExternal in TPasProcedure(Decl).Modifiers)
+      or (TPasProcedure(Decl).ProcType.Args.Count>0) then
+    exit;
+  Result:=true;
+end;
+
+function TPas2JSResolver.IsExternalBracketAccessor(El: TPasElement): boolean;
+var
+  ExtName: String;
+begin
+  if (not (El is TPasProcedure)) or (TPasProcedure(El).LibrarySymbolName=nil) then
+    exit(false);
+  ExtName:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,false,false);
+  Result:=ExtName=ExtClassBracketAccessor;
 end;
 
-Function TPasToJSConverter.ConvertUnaryExpression(El: TUnaryExpr; AContext : TConvertContext): TJSElement;
+{ TP2JConstExprData }
+
+destructor TP2JConstExprData.Destroy;
+begin
+  FreeAndNil(Value);
+  inherited Destroy;
+end;
+
+{ TParamContext }
+
+constructor TParamContext.Create(PasEl: TPasElement; JSEl: TJSElement;
+  aParent: TConvertContext);
+begin
+  inherited Create(PasEl, JSEl, aParent);
+  Access:=caAssign;
+  AccessContext:=Self;
+end;
+
+{ TPas2JsElementData }
+
+procedure TPas2JsElementData.SetElement(const AValue: TPasElement);
+var
+  Data: TPasElementBase;
+begin
+  if FElement=AValue then Exit;
+  if FElement<>nil then
+    begin
+    Data:=FElement;
+    while Data.CustomData<>Self do
+      if Data.CustomData is TPasElementBase then
+        Data:=TPasElementBase(Data.CustomData)
+      else
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPas2JsElementData.SetElement REMOVE ',ClassName);
+        writeln('  ',GetObjName(Data.CustomData));
+        {$ENDIF}
+        raise EPas2JS.Create('');
+        end;
+    Data.CustomData:=CustomData;
+    TPasElement(FElement).Release;
+    end;
+  FElement:=AValue;
+  if FElement<>nil then
+    begin
+    TPasElement(FElement).AddRef;
+    Data:=FElement;
+    while Data.CustomData is TPasElementBase do
+      Data:=TPasElementBase(Data.CustomData);
+    if Data.CustomData<>nil then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPas2JsElementData.SetElement INSERT ',ClassName);
+      writeln('  ',GetObjName(Data.CustomData));
+      {$ENDIF}
+      raise EPas2JS.Create('');
+      end;
+    Data.CustomData:=Self;
+    end;
+end;
+
+constructor TPas2JsElementData.Create;
+begin
+
+end;
+
+destructor TPas2JsElementData.Destroy;
+begin
+  Element:=nil;
+  Next:=nil;
+  Owner:=nil;
+  inherited Destroy;
+end;
+
+{ TAssignContext }
+
+constructor TAssignContext.Create(PasEl: TPasElement; JSEl: TJSElement;
+  aParent: TConvertContext);
+begin
+  inherited Create(PasEl, JSEl, aParent);
+  Access:=caAssign;
+  AccessContext:=Self;
+end;
+
+{ TSectionContext }
+
+constructor TSectionContext.Create(PasEl: TPasElement; JSEl: TJSElement;
+  aParent: TConvertContext);
+begin
+  inherited;
+  IsGlobal:=true;
+end;
+
+{ TFunctionContext }
+
+destructor TFunctionContext.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to length(LocalVars)-1 do
+    FreeAndNil(LocalVars[i]);
+  inherited Destroy;
+end;
+
+procedure TFunctionContext.AddLocalVar(const aName: string; El: TPasElement);
+var
+  l: Integer;
+begin
+  l:=length(LocalVars);
+  SetLength(LocalVars,l+1);
+  LocalVars[l]:=TFCLocalVar.Create(aName,El);
+end;
+
+function TFunctionContext.ToString: string;
+var
+  V: TFCLocalVar;
+begin
+  Result:=inherited ToString;
+  if ThisPas<>nil then
+    begin
+    Result:=Result+' this';
+    V:=FindLocalVar(ThisPas);
+    if V<>nil then
+      Result:=Result+'="'+V.Name+'"';
+    Result:=Result+'='+GetObjName(ThisPas);
+    end;
+end;
+
+function TFunctionContext.GetLocalName(El: TPasElement): string;
+var
+  V: TFCLocalVar;
+begin
+  if El=nil then exit('');
+  V:=FindLocalVar(El);
+  if V<>nil then
+    Result:=V.Name
+  else if El=ThisPas then
+    Result:='this'
+  else
+    Result:=inherited GetLocalName(El);
+end;
+
+function TFunctionContext.IndexOfLocalVar(const aName: string): integer;
+var
+  i: Integer;
+begin
+  for i:=0 to length(LocalVars)-1 do
+    if LocalVars[i].Name=aName then exit(i);
+  Result:=-1;
+end;
+
+function TFunctionContext.IndexOfLocalVar(El: TPasElement): integer;
+var
+  i: Integer;
+begin
+  if El=nil then exit(-1);
+  for i:=0 to length(LocalVars)-1 do
+    if LocalVars[i].Element=El then exit(i);
+  Result:=-1;
+end;
+
+function TFunctionContext.FindLocalVar(const aName: string): TFCLocalVar;
+var
+  i: Integer;
+begin
+  i:=IndexOfLocalVar(aName);
+  if i>=0 then
+    Result:=LocalVars[i]
+  else
+    Result:=nil;
+end;
+
+function TFunctionContext.FindLocalVar(El: TPasElement): TFCLocalVar;
+var
+  i: Integer;
+begin
+  i:=IndexOfLocalVar(El);
+  if i>=0 then
+    Result:=LocalVars[i]
+  else
+    Result:=nil;
+end;
+
+procedure TFunctionContext.DoWriteStack(Index: integer);
+var
+  i: Integer;
+begin
+  inherited DoWriteStack(Index);
+  for i:=0 to length(LocalVars)-1 do
+    writeln('    ',i,' ',LocalVars[i].Name,': ',GetObjName(LocalVars[i].Element));
+end;
+
+{ TConvertContext }
+
+constructor TConvertContext.Create(PasEl: TPasElement; JSEl: TJSElement;
+  aParent: TConvertContext);
+begin
+  PasElement:=PasEl;
+  JSElement:=JsEl;
+  Parent:=aParent;
+  if Parent<>nil then
+    begin
+    Resolver:=Parent.Resolver;
+    Access:=aParent.Access;
+    AccessContext:=aParent.AccessContext;
+    end;
+end;
+
+function TConvertContext.GetRootModule: TPasModule;
+var
+  aContext: TConvertContext;
+begin
+  aContext:=Self;
+  while aContext.Parent<>nil do
+    aContext:=aContext.Parent;
+  if aContext.PasElement is TPasModule then
+    Result:=TPasModule(aContext.PasElement)
+  else
+    Result:=nil;
+end;
+
+function TConvertContext.GetFunctionContext: TFunctionContext;
+begin
+  Result:=TFunctionContext(GetContextOfType(TFunctionContext));
+end;
+
+function TConvertContext.GetLocalName(El: TPasElement): string;
+begin
+  if Parent<>nil then
+    Result:=Parent.GetLocalName(El)
+  else
+    Result:='';
+end;
+
+function TConvertContext.GetSelfContext: TFunctionContext;
+var
+  Ctx: TConvertContext;
+begin
+  Ctx:=Self;
+  while Ctx<>nil do
+    begin
+    if (Ctx is TFunctionContext) and (TFunctionContext(Ctx).ThisPas is TPasClassType) then
+      exit(TFunctionContext(Ctx));
+    Ctx:=Ctx.Parent;
+    end;
+  Result:=nil;
+end;
+
+function TConvertContext.GetContextOfType(aType: TConvertContextClass
+  ): TConvertContext;
+var
+  ctx: TConvertContext;
+begin
+  Result:=nil;
+  ctx:=Self;
+  repeat
+    if ctx is aType then
+      exit(ctx);
+    ctx:=ctx.Parent;
+  until ctx=nil;
+end;
+
+function TConvertContext.CreateLocalIdentifier(const Prefix: string): string;
+begin
+  inc(TmpVarCount);
+  Result:=Prefix+IntToStr(TmpVarCount);
+end;
+
+function TConvertContext.CurrentModeSwitches: TModeSwitches;
+begin
+  if Resolver=nil then
+    Result:=OBJFPCModeSwitches
+  else
+    Result:=Resolver.CurrentParser.CurrentModeswitches;
+end;
+
+function TConvertContext.GetGlobalFunc: TFunctionContext;
+var
+  Ctx: TConvertContext;
+begin
+  Ctx:=Self;
+  while (Ctx<>nil) do
+    begin
+    if Ctx.IsGlobal and (Ctx.JSElement<>nil) and (Ctx is TFunctionContext) then
+      exit(TFunctionContext(Ctx));
+    Ctx:=Ctx.Parent;
+    end;
+end;
+
+procedure TConvertContext.WriteStack;
+
+  procedure W(Index: integer; AContext: TConvertContext);
+  begin
+    AContext.DoWriteStack(Index);
+    if AContext.Parent<>nil then
+      W(Index+1,AContext.Parent);
+  end;
+
+begin
+  writeln('TConvertContext.WriteStack: ');
+  W(1,Self);
+end;
+
+procedure TConvertContext.DoWriteStack(Index: integer);
+begin
+  writeln('  ',Index,' ',ToString);
+end;
+
+function TConvertContext.ToString: string;
+begin
+  Result:='['+ClassName+']'
+    +' pas='+GetObjName(PasElement)
+    +' js='+GetObjName(JSElement)
+    +' Global='+BoolToStr(IsGlobal,true);
+end;
+
+{ TPasToJSConverter }
+
+// inline
+function TPasToJSConverter.GetUseEnumNumbers: boolean;
+begin
+  Result:=coEnumNumbers in FOptions;
+end;
+
+// inline
+function TPasToJSConverter.GetUseLowerCase: boolean;
+begin
+  Result:=coLowerCase in FOptions;
+end;
+
+// inline
+function TPasToJSConverter.GetUseSwitchStatement: boolean;
+begin
+  Result:=coSwitchStatement in FOptions;
+end;
+
+procedure TPasToJSConverter.AddToSourceElements(Src: TJSSourceElements;
+  El: TJSElement);
 
 Var
-  C : TJSElementClass;
-  U : TJSUnaryExpression;
-  E : TJSElement;
+  List : TJSStatementList;
+  AddEl : TJSElement;
 
 begin
-  Result:=Nil;
-  E:=ConvertElement(El.Operand);
-  Case el.OpCode of
-    eopAdd:
+  While El<>nil do
+  begin
+    if El is TJSStatementList then
       begin
-      U:=TJSUnaryPlusExpression(CreateElement(TJSUnaryPlusExpression,El));
-      U.A:=E;
+      List:=El as TJSStatementList;
+      // List.A is first statement, List.B is next in list, chained.
+      // -> add A, continue with B and free List
+      AddEl:=List.A;
+      El:=List.B;
+      List.A:=Nil;
+      List.B:=Nil;
+      FreeAndNil(List);
+      end
+    else
+      begin
+      AddEl:=El;
+      El:=Nil;
       end;
-    eopSubtract:
+    Src.Statements.AddNode.Node:=AddEl;
+  end;
+end;
+
+procedure TPasToJSConverter.RemoveFromSourceElements(Src: TJSSourceElements;
+  El: TJSElement);
+var
+  Statements: TJSElementNodes;
+  i: Integer;
+begin
+  Statements:=Src.Statements;
+  for i:=Statements.Count-1 downto 0 do
+    if Statements[i].Node=El then
+      Statements.Delete(i);
+end;
+
+function TPasToJSConverter.GetBuildInNames(bin: TPas2JSBuiltInName): string;
+begin
+  Result:=FBuiltInNames[bin];
+end;
+
+procedure TPasToJSConverter.SetBuildInNames(bin: TPas2JSBuiltInName;
+  const AValue: string);
+begin
+  FBuiltInNames[bin]:=AValue;
+end;
+
+procedure TPasToJSConverter.SetPreservedWords(const AValue: TJSReservedWordList
+  );
+var
+  i: Integer;
+begin
+  if FPreservedWords=AValue then Exit;
+  for i:=0 to length(AValue)-2 do
+    if CompareStr(AValue[i],AValue[i+1])>=0 then
+      raise Exception.Create('TPasToJSConverter.SetPreservedWords "'+AValue[i]+'" >= "'+AValue[i+1]+'"');
+  FPreservedWords:=AValue;
+end;
+
+function TPasToJSConverter.ConvertModule(El: TPasModule;
+  AContext: TConvertContext): TJSElement;
+(*
+Program:
+ rtl.module('program',
+    [<uses1>,<uses2>, ...],
+    function(){
+      <programsection>
+      this.$main=function(){
+        <initialization>
+        };
+    });
+
+Unit:
+ rtl.module('<unitname>',
+    [<interface uses1>,<uses2>, ...],
+    function(){
+      var $impl = {};
+      this.$impl = $impl;
+      <interface>
+      this.$init=function(){
+        <initialization>
+        };
+    },
+    [<implementation uses1>,<uses2>, ...],
+    function(){
+      var $impl = this.$impl;
+      <implementation>
+    });
+*)
+Var
+  OuterSrc , Src: TJSSourceElements;
+  RegModuleCall: TJSCallExpression;
+  ArgArray: TJSArguments;
+  FunDecl, ImplFunc: TJSFunctionDeclarationStatement;
+  UsesSection: TPasSection;
+  ModuleName, ModVarName: String;
+  IntfContext: TSectionContext;
+  ImplVarSt: TJSVariableStatement;
+  HasImplUsesClause: Boolean;
+  UsesClause: TPasUsesClause;
+begin
+  Result:=Nil;
+  OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
+  Result:=OuterSrc;
+
+  // create 'rtl.module(...)'
+  RegModuleCall:=CreateCallExpression(El);
+  AddToSourceElements(OuterSrc,RegModuleCall);
+  RegModuleCall.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],'module']);
+  ArgArray := RegModuleCall.Args;
+  RegModuleCall.Args:=ArgArray;
+
+  // add unitname parameter: unitname
+  ModuleName:=TransformModuleName(El,false,AContext);
+  ArgArray.Elements.AddElement.Expr:=CreateLiteralString(El,ModuleName);
+
+  // add interface-uses-section parameter: [<interface uses1>,<uses2>, ...]
+  UsesSection:=nil;
+  if (El is TPasProgram) then
+    UsesSection:=TPasProgram(El).ProgramSection
+  else if (El is TPasLibrary) then
+    UsesSection:=TPasLibrary(El).LibrarySection
+  else
+    UsesSection:=El.InterfaceSection;
+  ArgArray.Elements.AddElement.Expr:=CreateUsesList(UsesSection,AContext);
+
+  // add interface parameter: function(){}
+  FunDecl:=CreateFunction(El,true,true);
+  ArgArray.Elements.AddElement.Expr:=FunDecl;
+  Src:=FunDecl.AFunction.Body.A as TJSSourceElements;
+
+  if coUseStrict in Options then
+    AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
+
+  ImplVarSt:=nil;
+  HasImplUsesClause:=false;
+
+  IntfContext:=TSectionContext.Create(El,Src,AContext);
+  try
+    // add "var $mod = this;"
+    IntfContext.ThisPas:=El;
+    ModVarName:=FBuiltInNames[pbivnModule];
+    IntfContext.AddLocalVar(ModVarName,El);
+    AddToSourceElements(Src,CreateVarStatement(ModVarName,
+      CreatePrimitiveDotExpr('this'),El));
+
+    if (El is TPasProgram) then
+      begin // program
+      if Assigned(TPasProgram(El).ProgramSection) then
+        AddToSourceElements(Src,ConvertDeclarations(TPasProgram(El).ProgramSection,IntfContext));
+      CreateInitSection(El,Src,IntfContext);
+      end
+    else if El is TPasLibrary then
+      begin // library
+      if Assigned(TPasLibrary(El).LibrarySection) then
+        AddToSourceElements(Src,ConvertDeclarations(TPasLibrary(El).LibrarySection,IntfContext));
+      CreateInitSection(El,Src,IntfContext);
+      end
+    else
+      begin // unit
+      if Assigned(El.ImplementationSection) then
+        begin
+        // add var $impl = $mod.$impl
+        ImplVarSt:=CreateVarStatement(FBuiltInNames[pbivnImplementation],
+          CreateMemberExpression([ModVarName,FBuiltInNames[pbivnImplementation]]),El);
+        AddToSourceElements(Src,ImplVarSt);
+        // register local var $impl
+        IntfContext.AddLocalVar(FBuiltInNames[pbivnImplementation],El.ImplementationSection);
+        end;
+      if Assigned(El.InterfaceSection) then
+        AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
+      CreateInitSection(El,Src,IntfContext);
+
+      // add optional implementation uses list: [<implementation uses1>,<uses2>, ...]
+      if Assigned(El.ImplementationSection) then
+        begin
+        UsesClause:=El.ImplementationSection.UsesClause;
+        if length(UsesClause)>0 then
+          begin
+          ArgArray.Elements.AddElement.Expr:=CreateUsesList(El.ImplementationSection,AContext);
+          HasImplUsesClause:=true;
+          end;
+        end;
+
+      end;
+  finally
+    IntfContext.Free;
+  end;
+
+  // add implementation function
+  if ImplVarSt<>nil then
+    begin
+    ImplFunc:=CreateImplementationSection(El,AContext);
+    if ImplFunc=nil then
       begin
-      U:=TJSUnaryPlusExpression(CreateElement(TJSUnaryMinusExpression,El));
-      U.A:=E;
+      // remove unneeded $impl from interface
+      RemoveFromSourceElements(Src,ImplVarSt);
+      end
+    else
+      begin
+      // add param
+      if not HasImplUsesClause then
+        ArgArray.Elements.AddElement.Expr:=CreateLiteralNull(El);
+      ArgArray.Elements.AddElement.Expr:=ImplFunc;
       end;
+    end;
+end;
+
+function TPasToJSConverter.CreateElement(C: TJSElementClass; Src: TPasElement
+  ): TJSElement;
+
+var
+  Line, Col: Integer;
+begin
+  if Assigned(Src) then
+    begin
+    TPasResolver.UnmangleSourceLineNumber(Src.SourceLinenumber,Line,Col);
+    Result:=C.Create(Line,Col,Src.SourceFilename);
+    end
+  else
+    Result:=C.Create(0,0);
+end;
+
+function TPasToJSConverter.CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
+  AContext: TConvertContext): TJSCallExpression;
+// create "$create("funcname");"
+var
+  ok: Boolean;
+  C: TJSCallExpression;
+  Proc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+  ClassScope: TPasClassScope;
+  aClass: TPasElement;
+  ArgEx: TJSLiteral;
+  ArgElems: TJSArrayLiteralElements;
+  FunName: String;
+begin
+  Result:=nil;
+  //writeln('TPasToJSConverter.CreateNewInstanceStatement Ref.Declaration=',GetObjName(Ref.Declaration));
+  Proc:=Ref.Declaration as TPasProcedure;
+  if Proc.Name='' then
+    RaiseInconsistency(20170125191914);
+  //writeln('TPasToJSConverter.CreateNewInstanceStatement Proc.Name=',Proc.Name);
+  ProcScope:=Proc.CustomData as TPasProcedureScope;
+  //writeln('TPasToJSConverter.CreateNewInstanceStatement ProcScope.Element=',GetObjName(ProcScope.Element),' ProcScope.ClassScope=',GetObjName(ProcScope.ClassScope),' ProcScope.DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ProcScope.ImplProc=',GetObjName(ProcScope.ImplProc),' ProcScope.CustomData=',GetObjName(ProcScope.CustomData));
+  ClassScope:=ProcScope.ClassScope;
+  aClass:=ClassScope.Element;
+  if aClass.Name='' then
+    RaiseInconsistency(20170125191923);
+  //writeln('TPasToJSConverter.CreateNewInstanceStatement aClass.Name=',aClass.Name);
+  C:=CreateCallExpression(Ref.Element);
+  ok:=false;
+  try
+    // add "$create()"
+    if rrfNewInstance in Ref.Flags then
+      FunName:=FBuiltInNames[pbifnClassInstanceNew]
+    else
+      FunName:=FBuiltInNames[pbifnClassInstanceFree];
+    FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName;
+    C.Expr:=CreatePrimitiveDotExpr(FunName);
+    ArgElems:=C.Args.Elements;
+    // parameter: "funcname"
+    ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext));
+    ArgElems.AddElement.Expr:=ArgEx;
+    ok:=true;
+  finally
+    if not ok then
+      C.Free;
   end;
-  Result:=U;
+  Result:=C;
 end;
 
-Function TPasToJSConverter.ConvertCallExpression(El: TParamsExpr;
+function TPasToJSConverter.CreateFunction(El: TPasElement; WithBody: boolean;
+  WithSrc: boolean): TJSFunctionDeclarationStatement;
+var
+  FuncDef: TJSFuncDef;
+  FuncSt: TJSFunctionDeclarationStatement;
+  Src: TJSSourceElements;
+begin
+  FuncSt:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,El));
+  Result:=FuncSt;
+  FuncDef:=TJSFuncDef.Create;
+  FuncSt.AFunction:=FuncDef;
+  if WithBody then
+    begin
+    FuncDef.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
+    if WithSrc then
+      begin
+      Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
+      FuncDef.Body.A:=Src;
+      end;
+    end;
+end;
+
+function TPasToJSConverter.ConvertUnaryExpression(El: TUnaryExpr;
   AContext: TConvertContext): TJSElement;
+
+  procedure NotSupported;
+  begin
+    DoError(20170215134950,nUnaryOpcodeNotSupported,sUnaryOpcodeNotSupported,
+            [OpcodeStrings[El.OpCode]],El);
+  end;
+
 Var
-  C : TJSElementClass;
   U : TJSUnaryExpression;
   E : TJSElement;
-  Id : TJSPrimaryExpressionIdent;
+  ResolvedOp, ResolvedEl: TPasResolverResult;
+  BitwiseNot: Boolean;
 
 begin
-  Raise EPasToJS.CreateFmt(SErrUnexpected,[EL.ClassName]);
+  if AContext=nil then ;
   Result:=Nil;
-  ID:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,EL));
-  Case el.OpCode of
+  U:=nil;
+  Case El.OpCode of
     eopAdd:
       begin
+      E:=ConvertElement(El.Operand,AContext);
       U:=TJSUnaryPlusExpression(CreateElement(TJSUnaryPlusExpression,El));
       U.A:=E;
       end;
     eopSubtract:
       begin
-      U:=TJSUnaryPlusExpression(CreateElement(TJSUnaryMinusExpression,El));
+      E:=ConvertElement(El.Operand,AContext);
+      U:=TJSUnaryMinusExpression(CreateElement(TJSUnaryMinusExpression,El));
       U.A:=E;
       end;
+    eopNot:
+      begin
+      E:=ConvertElement(El.Operand,AContext);
+      BitwiseNot:=true;
+      if AContext.Resolver<>nil then
+        begin
+        AContext.Resolver.ComputeElement(El.Operand,ResolvedOp,[]);
+        BitwiseNot:=ResolvedOp.BaseType in btAllJSInteger;
+        end;
+      if BitwiseNot then
+        U:=TJSUnaryInvExpression(CreateElement(TJSUnaryInvExpression,El))
+      else
+        U:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
+      U.A:=E;
+      end;
+    eopAddress:
+      begin
+      if AContext.Resolver=nil then
+        NotSupported;
+      AContext.Resolver.ComputeElement(El.Operand,ResolvedEl,[rcNoImplicitProc]);
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertUnaryExpression ',GetResolverResultDbg(ResolvedEl));
+      {$ENDIF}
+      if ResolvedEl.BaseType=btProc then
+        begin
+        if ResolvedEl.IdentEl is TPasProcedure then
+          begin
+          Result:=CreateCallback(El.Operand,ResolvedEl,AContext);
+          exit;
+          end;
+        end;
+      end;
   end;
+  if U=nil then
+    NotSupported;
   Result:=U;
 end;
 
-Function TPasToJSConverter.TransFormStringLiteral(S: String): String;
-begin
-  // This needs some more complicated algorithm that handles #13"abc etc.
-  Result:=Copy(S,2,Length(S)-2);
-  Result:=StringReplace(Result,'''''','''',[rfReplaceAll]);
-end;
-
-
-Function TPasToJSConverter.GetIdentValueType(AName : String; AContext : TConvertContext): TJSType;
-
-begin
-  Result:=jstUNDEFINED;
-end;
-
-
-Function TPasToJSConverter.GetExpressionValueType(El : TPasExpr; AContext : TConvertContext) : TJSType;
+function TPasToJSConverter.GetExpressionValueType(El: TPasExpr;
+  AContext: TConvertContext): TJSType;
 
   Function CombineValueType(A,B : TJSType) : TJSType;
 
   begin
-    If (A=jstUndefined) then
+    If (A=jstUNDEFINED) then
       Result:=B
-    else if (B=jstundefined) then
+    else if (B=jstUNDEFINED) then
       Result:=A
     else
       Result:=A; // pick the first
@@ -284,10 +3829,10 @@ Var
 begin
   if (El is TBoolConstExpr) then
     Result:=jstBoolean
-  else  If (EL is TPrimitiveExpr) then
+  else if (El is TPrimitiveExpr) then
     begin
-    Case EL.Kind of
-      pekIdent : Result:=GetIdentValueType(El.Name,AContext);
+    Case El.Kind of
+      pekIdent : Result:=GetPasIdentValueType(El.Name,AContext);
       pekNumber : Result:=jstNumber;
       pekString : Result:=jstString;
       pekSet : Result:=jstUNDEFINED;
@@ -301,9 +3846,9 @@ begin
       pekSelf : Result:=jstObject;
     end
     end
-  else if (EL is TUnaryExpr) then
+  else if (El is TUnaryExpr) then
     Result:=GetExpressionValueType(TUnaryExpr(El).Operand,AContext)
-  else if (EL is TBinaryExpr) then
+  else if (El is TBinaryExpr) then
     begin
     A:=GetExpressionValueType(TBinaryExpr(El).Left,AContext);
     B:=GetExpressionValueType(TBinaryExpr(El).Right,AContext);
@@ -313,23 +3858,137 @@ begin
     result:=jstUndefined
 end;
 
-Function TPasToJSConverter.ConvertBinaryExpression(El: TBinaryExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.GetPasIdentValueType(AName: String;
+  AContext: TConvertContext): TJSType;
 
-Type
-  TJSBinaryClass = Class of TJSBinary;
+begin
+  if AContext=nil then ;
+  if AName='' then ;
+  Result:=jstUNDEFINED;
+end;
+
+function TPasToJSConverter.ComputeConstString(Expr: TPasExpr;
+  AContext: TConvertContext; NotEmpty: boolean): String;
+var
+  Prim: TPrimitiveExpr;
+begin
+  if AContext.Resolver<>nil then
+    Result:=AContext.Resolver.ComputeConstString(Expr,false,NotEmpty)
+  else
+    begin
+    // fall back:
+    Result:='';
+    if Expr is TPrimitiveExpr then
+      begin
+      Prim:=TPrimitiveExpr(Expr);
+      if Prim.Kind=pekString then
+        Result:=Prim.Value
+      else
+        RaiseNotSupported(Prim,AContext,20170215124733);
+      end
+    else
+      RaiseNotSupported(Expr,AContext,20170322121331);
+    end;
+end;
 
+function TPasToJSConverter.IsExternalClassConstructor(El: TPasElement): boolean;
+var
+  P: TPasElement;
+begin
+  if (El.ClassType=TPasConstructor)
+      and (pmExternal in TPasConstructor(El).Modifiers) then
+    begin
+    P:=El.Parent;
+    if (P<>nil) and (P.ClassType=TPasClassType) and TPasClassType(P).IsExternal then
+      exit(true);
+    end;
+  Result:=false;
+end;
+
+procedure TPasToJSConverter.ComputeRange(
+  const RangeResolved: TPasResolverResult; AContext: TConvertContext; out
+  MinValue, MaxValue: int64; ErrorEl: TPasElement);
+var
+  EnumType: TPasEnumType;
+begin
+  if RangeResolved.BaseType in btAllJSBooleans then
+    begin
+    MinValue:=0;
+    MaxValue:=1;
+    end
+  else if RangeResolved.BaseType=btShortInt then
+    begin
+    MinValue:=-$80;
+    MaxValue:=-$7f;
+    end
+  else if RangeResolved.BaseType=btByte then
+    begin
+    MinValue:=0;
+    MaxValue:=$ff;
+    end
+  else if RangeResolved.BaseType=btSmallInt then
+    begin
+    MinValue:=-$8000;
+    MaxValue:=$7fff;
+    end
+  else if RangeResolved.BaseType=btWord then
+    begin
+    MinValue:=0;
+    MaxValue:=$ffff;
+    end
+  else if RangeResolved.BaseType=btLongint then
+    begin
+    MinValue:=-$80000000;
+    MaxValue:=$7fffffff;
+    end
+  else if RangeResolved.BaseType=btLongWord then
+    begin
+    MinValue:=0;
+    MaxValue:=$ffffffff;
+    end
+  else if RangeResolved.BaseType=btUIntDouble then
+    begin
+    MinValue:=0;
+    MaxValue:=HighJSNativeInt;
+    end
+  else if RangeResolved.BaseType=btIntDouble then
+    begin
+    MinValue:=LowJSNativeInt;
+    MaxValue:=HighJSNativeInt;
+    end
+  else if RangeResolved.BaseType in btAllJSChars then
+    begin
+    MinValue:=0;
+    MaxValue:=$ffff;
+    end
+  else if RangeResolved.BaseType=btContext then
+    begin
+    if RangeResolved.TypeEl.ClassType=TPasEnumType then
+      begin
+      EnumType:=TPasEnumType(RangeResolved.TypeEl);
+      MinValue:=0;
+      MaxValue:=EnumType.Values.Count-1;
+      end;
+    end
+  else
+    DoError(20170411224022,nPasElementNotSupported,sPasElementNotSupported,
+      [AContext.Resolver.BaseTypeNames[RangeResolved.BaseType]],ErrorEl);
+end;
+
+function TPasToJSConverter.ConvertBinaryExpression(El: TBinaryExpr;
+  AContext: TConvertContext): TJSElement;
 Const
   BinClasses : Array [TExprOpCode] of TJSBinaryClass = (
    Nil, //eopEmpty,
-   TJSAdditiveExpressionPlus,
-   TJSAdditiveExpressionMinus,
-   TJSMultiplicativeExpressionMul,
-   TJSMultiplicativeExpressionDiv,
-   TJSMultiplicativeExpressionDiv,
-   TJSMultiplicativeExpressionMod,
+   TJSAdditiveExpressionPlus, // +
+   TJSAdditiveExpressionMinus, // -
+   TJSMultiplicativeExpressionMul, // *
+   TJSMultiplicativeExpressionDiv, // /
+   TJSMultiplicativeExpressionDiv, // div
+   TJSMultiplicativeExpressionMod, // mod
    Nil, //eopPower
-   TJSRShiftExpression,
-   TJSLShiftExpression,
+   TJSURShiftExpression, // shr
+   TJSLShiftExpression, // shl
    Nil, // Not
    Nil, // And
    Nil, // Or
@@ -352,235 +4011,3168 @@ Const
 Var
   R : TJSBinary;
   C : TJSBinaryClass;
-  A,B : TJSElement;
-  funname:String;
-  pex : TJSPrimaryExpressionIdent;
+  A,B: TJSElement;
+  UseBitwiseOp: Boolean;
+  Call: TJSCallExpression;
+  LeftResolved, RightResolved: TPasResolverResult;
+  Flags: TPasResolverComputeFlags;
+  ModeSwitches: TModeSwitches;
 begin
   Result:=Nil;
-  C:=BinClasses[EL.OpCode];
-  A:=ConvertElement(EL.left,AContext);
+
+  case El.OpCode of
+  eopSubIdent:
+    begin
+    Result:=ConvertSubIdentExpression(El,AContext);
+    exit;
+    end;
+  eopNone:
+    if El.left is TInheritedExpr then
+      begin
+      Result:=ConvertInheritedExpression(TInheritedExpr(El.left),AContext);
+      exit;
+      end;
+  end;
+
+  if AContext.Access<>caRead then
+    DoError(20170209152633,nVariableIdentifierExpected,sVariableIdentifierExpected,[],El);
+
+  Call:=nil;
+  A:=ConvertElement(El.left,AContext);
+  B:=nil;
   try
-    B:=ConvertElement(EL.right,AContext);
-  except
-    FreeAndNil(A);
-    Raise;
-  end;
-  if (C=Nil) then
-    Case EL.OpCode of
-      eopAs : begin
-              Result:=ConvertElement(El.Left,AContext);
-              end;
-      eopAnd,
-      eopOr,
-      eopXor :
-        begin
-        if (GetExpressionValueType(EL.Left,AContext)=jstNumber)
-            or (GetExpressionValueType(EL.Right,AContext)=jstNumber) then
-          Case EL.OpCode of
-            eopAnd : C:=TJSBitwiseAndExpression;
-            eopOr : C:=TJSBitwiseOrExpression;
-            eopXor : C:=TJSBitwiseXOrExpression;
-          end
+    B:=ConvertElement(El.right,AContext);
+
+    if AContext.Resolver<>nil then
+      begin
+      ModeSwitches:=AContext.CurrentModeSwitches;
+      // compute left
+      Flags:=[];
+      if El.OpCode in [eopEqual,eopNotEqual] then
+        if not (msDelphi in ModeSwitches) then
+          Flags:=[rcNoImplicitProcType];
+      AContext.Resolver.ComputeElement(El.left,LeftResolved,Flags);
+
+      // compute right
+      Flags:=[];
+      if (El.OpCode in [eopEqual,eopNotEqual])
+          and not (msDelphi in ModeSwitches) then
+        begin
+        if LeftResolved.BaseType=btNil then
+          Flags:=[rcNoImplicitProcType]
+        else if AContext.Resolver.IsProcedureType(LeftResolved,true) then
+          Flags:=[rcNoImplicitProcType]
         else
-          Case EL.OpCode of
-            eopAnd : C:=TJSLogicalAndExpression;
-            eopOr : C:=TJSLogicalOrExpression;
-            eopXOR : DoError('Logical XOR not supported yet');
+          Flags:=[];
+        end;
+      AContext.Resolver.ComputeElement(El.right,RightResolved,Flags);
+
+      Result:=ConvertBinaryExpressionRes(El,AContext,LeftResolved,RightResolved,A,B);
+      if Result<>nil then exit;
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertBinaryExpression Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
+      {$ENDIF}
+      end;
+
+    C:=BinClasses[El.OpCode];
+    if C=nil then
+      Case El.OpCode of
+        eopAs :
+          begin
+          // "A as B"
+          Call:=CreateCallExpression(El);
+          if (RightResolved.TypeEl is TPasClassType) and TPasClassType(RightResolved.TypeEl).IsExternal then
+            // B is external class -> "rtl.asExt(A,B)"
+            Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnAsExt])
+          else
+            // otherwise -> "rtl.as(A,B)"
+            Call.Expr:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTL]+'.'+FBuiltInNames[pbifnAs]);
+          Call.AddArg(A);
+          Call.AddArg(B);
+          Result:=Call;
+          exit;
+          end;
+        eopAnd,
+        eopOr,
+        eopXor:
+          begin
+          if AContext.Resolver<>nil then
+            UseBitwiseOp:=((LeftResolved.BaseType in btAllJSInteger)
+                       or (RightResolved.BaseType in btAllJSInteger))
+          else
+            UseBitwiseOp:=(GetExpressionValueType(El.left,AContext)=jstNumber)
+              or (GetExpressionValueType(El.right,AContext)=jstNumber);
+          if UseBitwiseOp then
+            Case El.OpCode of
+              eopAnd : C:=TJSBitwiseAndExpression;
+              eopOr : C:=TJSBitwiseOrExpression;
+              eopXor : C:=TJSBitwiseXOrExpression;
+            end
+          else
+            Case El.OpCode of
+              eopAnd : C:=TJSLogicalAndExpression;
+              eopOr : C:=TJSLogicalOrExpression;
+            else
+              DoError(20161024191234,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,['logical XOR'],El);
+            end;
           end;
+        eopPower:
+          begin
+          Call:=CreateCallExpression(El);
+          Call.Expr:=CreatePrimitiveDotExpr('Math.pow');
+          Call.AddArg(A);
+          Call.AddArg(B);
+          Result:=Call;
+          end
+        else
+          if C=nil then
+            DoError(20161024191244,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
+      end;
+    if (Result=Nil) and (C<>Nil) then
+      begin
+      R:=TJSBinary(CreateElement(C,El));
+      R.A:=A; A:=nil;
+      R.B:=B; B:=nil;
+      Result:=R;
+
+      if El.OpCode=eopDiv then
+        begin
+        // convert "a div b" to "Math.floor(a/b)"
+        Call:=CreateCallExpression(El);
+        Call.AddArg(R);
+        Call.Expr:=CreatePrimitiveDotExpr('Math.floor');
+        Result:=Call;
         end;
-      eopSubIdent :
+      end;
+  finally
+    if Result=nil then
+      begin
+      A.Free;
+      B.Free;
+      end;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBinaryExpressionRes(El: TBinaryExpr;
+  AContext: TConvertContext; const LeftResolved,
+  RightResolved: TPasResolverResult; var A, B: TJSElement): TJSElement;
+
+  function CreateEqualCallback: TJSElement;
+  var
+    Call: TJSCallExpression;
+    NotEl: TJSUnaryNotExpression;
+  begin
+    // convert "proctypeA = proctypeB" to "rtl.eqCallback(proctypeA,proctypeB)"
+    Call:=CreateCallExpression(El);
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnProcType_Equal]]);
+    Call.AddArg(A);
+    A:=nil;
+    Call.AddArg(B);
+    B:=nil;
+    if El.OpCode=eopNotEqual then
+      begin
+      // convert "proctypeA <> proctypeB" to "!rtl.eqCallback(proctypeA,proctypeB)"
+      NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
+      NotEl.A:=Call;
+      Result:=NotEl;
+      end
+    else
+      Result:=Call;
+  end;
+
+var
+  FunName: String;
+  Call: TJSCallExpression;
+  DotExpr: TJSDotMemberExpression;
+  NotEl: TJSUnaryNotExpression;
+  InOp: TJSRelationalExpressionIn;
+begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertBinaryExpressionRes OpCode="',OpcodeStrings[El.OpCode],'" Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
+  {$ENDIF}
+  Result:=nil;
+  if LeftResolved.BaseType=btSet then
+    begin
+    // set operators -> rtl.operatorfunction(a,b)
+    case El.OpCode of
+    eopAdd: FunName:=FBuiltInNames[pbifnSet_Union];
+    eopSubtract: FunName:=FBuiltInNames[pbifnSet_Difference];
+    eopMultiply: FunName:=FBuiltInNames[pbifnSet_Intersect];
+    eopSymmetricaldifference: FunName:=FBuiltInNames[pbifnSet_SymDiffSet];
+    eopEqual: FunName:=FBuiltInNames[pbifnSet_Equal];
+    eopNotEqual: FunName:=FBuiltInNames[pbifnSet_NotEqual];
+    eopGreaterThanEqual: FunName:=FBuiltInNames[pbifnSet_GreaterEqual];
+    eopLessthanEqual: FunName:=FBuiltInNames[pbifnSet_LowerEqual];
+    else
+      DoError(20170209151300,nBinaryOpcodeNotSupported,sBinaryOpcodeNotSupported,[OpcodeStrings[El.OpCode]],El);
+    end;
+    Call:=CreateCallExpression(El);
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FunName]);
+    Call.AddArg(A);
+    A:=nil;
+    Call.AddArg(B);
+    B:=nil;
+    Result:=Call;
+    exit;
+    end
+  else if (RightResolved.BaseType=btSet) and (El.OpCode=eopIn) then
+    begin
+    // a in b -> a in b
+    if not (A is TJSLiteral) or (TJSLiteral(A).Value.ValueType<>jstNumber) then
+      begin
+      FreeAndNil(A);
+      A:=CreateSetLiteralElement(El.left,AContext);
+      end;
+    InOp:=TJSRelationalExpressionIn(CreateElement(TJSRelationalExpressionIn,El));
+    InOp.A:=A;
+    A:=nil;
+    InOp.B:=B;
+    B:=nil;
+    Result:=InOp;
+    exit;
+    end
+  else if (El.OpCode=eopIs) then
+    begin
+    // "A is B"
+    Call:=CreateCallExpression(El);
+    Result:=Call;
+    Call.AddArg(A); A:=nil;
+    if RightResolved.IdentEl is TPasClassOfType then
+      begin
+      // "A is class-of-type" -> "A is class"
+      FreeAndNil(B);
+      B:=CreateReferencePathExpr(TPasClassOfType(RightResolved.IdentEl).DestType,AContext);
+      end;
+    if (RightResolved.TypeEl is TPasClassType) and TPasClassType(RightResolved.TypeEl).IsExternal then
+      begin
+      // B is an external class -> "rtl.isExt(A,B)"
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIsExt]]);
+      Call.AddArg(B); B:=nil;
+      end
+    else if LeftResolved.TypeEl is TPasClassOfType then
+      begin
+      // A is a TPasClassOfType -> "rtl.is(A,B)"
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnIs]]);
+      Call.AddArg(B); B:=nil;
+      end
+    else
+      begin
+      // use directly "B.isPrototypeOf(A)"
+      DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+      DotExpr.MExpr:=B; B:=nil;
+      DotExpr.Name:='isPrototypeOf';
+      Call.Expr:=DotExpr;
+      end;
+    exit;
+    end
+  else if (El.OpCode in [eopEqual,eopNotEqual]) then
+    begin
+    if AContext.Resolver.IsProcedureType(LeftResolved,true) then
+      begin
+      if RightResolved.BaseType=btNil then
+      else if AContext.Resolver.IsProcedureType(RightResolved,true)
+          or AContext.Resolver.IsJSBaseType(RightResolved,pbtJSValue,true) then
+        exit(CreateEqualCallback);
+      end
+    else if AContext.Resolver.IsProcedureType(RightResolved,true) then
+      begin
+      if LeftResolved.BaseType=btNil then
+      else if AContext.Resolver.IsJSBaseType(LeftResolved,pbtJSValue,true) then
+        exit(CreateEqualCallback);
+      end
+    else if LeftResolved.TypeEl is TPasRecordType then
+      begin
+      // convert "recordA = recordB" to "recordA.$equal(recordB)"
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateDotExpression(El,A,CreatePrimitiveDotExpr(FBuiltInNames[pbifnRecordEqual]));
+      A:=nil;
+      Call.AddArg(B);
+      B:=nil;
+      if El.OpCode=eopNotEqual then
         begin
-        if (B is TJSPrimaryExpressionIdent) then
+        // convert "recordA = recordB" to "!recordA.$equal(recordB)"
+        NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
+        NotEl.A:=Call;
+        Result:=NotEl;
+        end
+      else
+        Result:=Call;
+      exit;
+      end
+    else if LeftResolved.TypeEl is TPasArrayType then
+      begin
+      if RightResolved.BaseType=btNil then
         begin
-          Result := TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
-          TJSDotMemberExpression(Result).Mexpr := A;
-          TJSDotMemberExpression(Result).Name := TJSPrimaryExpressionIdent(B).Name;
-          FreeAndNil(B);
+        // convert "array = nil" to "rtl.length(array) > 0"
+        FreeAndNil(B);
+        Result:=CreateCmpArrayWithNil(El,A,El.OpCode);
+        A:=nil;
+        exit;
         end;
-        if (B is TJSCallExpression) then
+      end
+    else if RightResolved.TypeEl is TPasArrayType then
+      begin
+      if LeftResolved.BaseType=btNil then
         begin
-          Result := B;
-          funname := TJSPrimaryExpressionIdent(TJSCallExpression(B).Expr).Name;
-          TJSCallExpression(B).Expr :=
-            TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
-          TJSDotMemberExpression(TJSCallExpression(B).Expr).Mexpr := A;
-          TJSDotMemberExpression(TJSCallExpression(B).Expr).Name := funname;
+        // convert "nil = array" to "0 < rtl.length(array)"
+        FreeAndNil(A);
+        Result:=CreateCmpArrayWithNil(El,B,El.OpCode);
+        B:=nil;
+        exit;
         end;
-        if not ((B is TJSPrimaryExpressionIdent) or (B is TJSCallExpression)) then;
-        // DOError('Member expression must be an identifier');
-      end
-      else
-        if (A is TJSPrimaryExpressionIdent) and
-          (TJSPrimaryExpressionIdent(A).Name = '_super') then
-        begin
-          Result := B;
-          funname := TJSPrimaryExpressionIdent(TJSCallExpression(b).Expr).Name;
-          pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
-          pex.Name := 'self';
-          TJSCallExpression(b).Args.Elements.AddElement.Expr := pex;
-          if TJSCallExpression(b).Args.Elements.Count > 1 then
-            TJSCallExpression(b).Args.Elements.Exchange(
-              0, TJSCallExpression(b).Args.Elements.Count - 1);
-          if CompareText(funname, 'Create') = 0 then
-          begin
-            TJSCallExpression(B).Expr :=
-              TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, El));
-            TJSDotMemberExpression(TJSCallExpression(b).Expr).Mexpr := A;
-            TJSDotMemberExpression(TJSCallExpression(b).Expr).Name := funname;
-          end
-          else
-          begin
-            TJSCallExpression(B).Expr :=
-              CreateMemberExpression(['call', funname, 'prototype', '_super']);
-          end;
+      end;
+    end;
+end;
+
+function TPasToJSConverter.ConvertSubIdentExpression(El: TBinaryExpr;
+  AContext: TConvertContext): TJSElement;
+// connect El.left and El.right with a dot.
+var
+  Left, Right: TJSElement;
+  DotContext: TDotContext;
+  OldAccess: TCtxAccess;
+  LeftResolved: TPasResolverResult;
+  RightRef: TResolvedReference;
+  ParamsExpr: TParamsExpr;
+  RightEl: TPasExpr;
+begin
+  Result:=nil;
+
+  ParamsExpr:=nil;
+  RightEl:=El.right;
+  while RightEl.ClassType=TParamsExpr do
+    begin
+    ParamsExpr:=TParamsExpr(RightEl);
+    RightEl:=ParamsExpr.Value;
+    end;
+
+  if (RightEl.ClassType=TPrimitiveExpr)
+      and (RightEl.CustomData is TResolvedReference) then
+    begin
+    RightRef:=TResolvedReference(RightEl.CustomData);
+    if IsExternalClassConstructor(RightRef.Declaration) then
+      begin
+      if ParamsExpr<>nil then
+        begin
+        // left side is done in ConvertFuncParams
+        Result:=ConvertParamsExpression(El.right as TParamsExpr,AContext);
         end
-        else
-      DoError('Unknown/Unsupported operand type for binary expression');
+      else
+        Result:=ConvertExternalConstructor(El.left,RightRef,nil,AContext);
+      exit;
+      end
+    else if AContext.Resolver.IsTObjectFreeMethod(RightEl) then
+      begin
+      Result:=ConvertTObjectFree(El,RightEl,AContext);
+      exit;
+      end;
     end;
-  if (Result=Nil) and (C<>Nil) then
+
+  if AContext.Resolver<>nil then
     begin
-    R:=TJSBinary(CreateElement(C,EL));
-    R.A:=A;
-    R.B:=B;
-    Result:=R;
+    AContext.Resolver.ComputeElement(El.left,LeftResolved,[]);
+    if LeftResolved.BaseType=btModule then
+      begin
+      // e.g. System.ExitCode
+      // unit prefix is automatically created -> omit
+      Result:=ConvertElement(El.right,AContext);
+      exit;
+      end;
     end;
+  // convert left side
+  OldAccess:=AContext.Access;
+  AContext.Access:=caRead;
+  Left:=ConvertElement(El.left,AContext);
+  if Left=nil then
+    RaiseInconsistency(20170201140821);
+  AContext.Access:=OldAccess;
+  // convert right side
+  DotContext:=TDotContext.Create(El,Left,AContext);
+  Right:=nil;
+  try
+    DotContext.LeftResolved:=LeftResolved;
+    Right:=ConvertElement(El.right,DotContext);
+  finally
+    DotContext.Free;
+    if Right=nil then
+      Left.Free;
+  end;
+  // connect via dot
+  Result:=CreateDotExpression(El,Left,Right);
 end;
 
-Function TPasToJSConverter.TransFormIdent(El: TJSPrimaryExpressionIdent; AContext : TConvertContext): TJSElement;
-
+function TPasToJSConverter.CreateIdentifierExpr(El: TPasElement;
+  AContext: TConvertContext): TJSElement;
 begin
-  EL.Name:=LowerCase(EL.Name);
-  Result:=El;
+  Result:=CreatePrimitiveDotExpr(TransformVariableName(El,AContext),El);
 end;
 
+function TPasToJSConverter.CreateIdentifierExpr(AName: string; El: TPasElement;
+  AContext: TConvertContext): TJSElement;
+begin
+  Result:=CreatePrimitiveDotExpr(TransformVariableName(El,AName,AContext),El);
+end;
 
-Function TPasToJSConverter.CreateIdentifierExpr(AName : String; El : TPasElement; AContext : TConvertContext): TJSElement;
-
-Var
-  I : TJSPrimaryExpressionIdent;
-
+function TPasToJSConverter.CreateSubDeclNameExpr(El: TPasElement;
+  const Name: string; AContext: TConvertContext): TJSElement;
+var
+  CurName, ParentName: String;
 begin
-  I:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
-  I.Name:=AName;
-  Result:=TransFormIdent(I,AContext);
+  CurName:=TransformVariableName(El,Name,AContext);
+  ParentName:=AContext.GetLocalName(El.Parent);
+  if ParentName='' then
+    ParentName:='this';
+  CurName:=ParentName+'.'+CurName;
+  Result:=CreatePrimitiveDotExpr(CurName,El);
 end;
 
-Function TPasToJSConverter.ConvertPrimitiveExpression(El: TPrimitiveExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertPrimitiveExpression(El: TPrimitiveExpr;
+  AContext: TConvertContext): TJSElement;
 
 Var
   L : TJSLiteral;
-  D : TJSNumber;
-  C : Integer;
-
+  Number : TJSNumber;
+  ConversionError : Integer;
+  i: Int64;
+  S: String;
 begin
+  {$IFDEF VerbosePas2JS}
+  str(El.Kind,S);
+  writeln('TPasToJSConverter.ConvertPrimitiveExpression El=',GetObjName(El),' Context=',GetObjName(AContext),' El.Kind=',S);
+  {$ENDIF}
   Result:=Nil;
   case El.Kind of
     pekString:
       begin
-      L:=TJSLiteral(CreateElement(TJSLiteral,El));
-      L.Value.AsString:=TransFormStringLiteral(El.Value);
-      Result:=L;
+      if AContext.Resolver<>nil then
+        Result:=CreateLiteralJSString(El,
+          AContext.Resolver.ExtractPasStringLiteral(El,El.Value))
+      else
+        begin
+        S:=AnsiDequotedStr(El.Value,'''');
+        Result:=CreateLiteralString(El,S);
+        end;
+      //writeln('TPasToJSConverter.ConvertPrimitiveExpression Result="',TJSLiteral(Result).Value.AsString,'" ',GetObjName(AContext.Resolver));
       end;
     pekNumber:
       begin
-      L:=TJSLiteral(CreateElement(TJSLiteral,El));
-      Val(El.Value,D,C);
-      if C<>0 then
-        DoError('Invalid number: %s',[EL.Value]);
-      L.Value.AsNumber:=D;
+      case El.Value[1] of
+      '0'..'9':
+        begin
+        Val(El.Value,Number,ConversionError);
+        if ConversionError<>0 then
+          DoError(20161024191248,nInvalidNumber,sInvalidNumber,[El.Value],El);
+        L:=CreateLiteralNumber(El,Number);
+        L.Value.CustomValue:=TJSString(El.Value);
+        end;
+      '$','&','%':
+        begin
+          i:=StrToInt64Def(El.Value,-1);
+          if i<0 then
+            DoError(20161024224442,nInvalidNumber,sInvalidNumber,[El.Value],El);
+          Number:=i;
+          if Number<>i then
+            // number was rounded -> we lost precision
+            DoError(20161024230812,nInvalidNumber,sInvalidNumber,[El.Value],El);
+          L:=CreateLiteralNumber(El,Number);
+          S:=copy(El.Value,2,length(El.Value));
+          case El.Value[1] of
+          '$': S:='0x'+S;
+          '&': if TargetProcessor=ProcessorECMAScript5 then
+                 S:='0'+S
+               else
+                 S:='0o'+S;
+          '%': if TargetProcessor=ProcessorECMAScript5 then
+                 S:=''
+               else
+                 S:='0b'+S;
+          end;
+          L.Value.CustomValue:=TJSString(S);
+        end;
+      else
+        DoError(20161024223232,nInvalidNumber,sInvalidNumber,[El.Value],El);
+      end;
       Result:=L;
       end;
     pekIdent:
+      Result:=ConvertIdentifierExpr(El,El.Value,AContext);
+    else
+      RaiseNotSupported(El,AContext,20161024222543);
+  end;
+end;
+
+function TPasToJSConverter.ConvertIdentifierExpr(El: TPasExpr;
+  const aName: string; AContext: TConvertContext): TJSElement;
+
+  function IsClassSelf(Decl: TPasElement): boolean;
+  begin
+    if (Decl.ClassType<>TPasClassType) or (CompareText(aName,'Self')<>0) then
+      exit(false);
+    Result:=AContext.GetSelfContext<>nil;
+  end;
+
+var
+  Decl: TPasElement;
+  Name: String;
+  Ref: TResolvedReference;
+  Call: TJSCallExpression;
+  BuiltInProc: TResElDataBuiltInProc;
+  Prop: TPasProperty;
+  ImplicitCall: Boolean;
+  AssignContext: TAssignContext;
+  Arg: TPasArgument;
+  ParamContext: TParamContext;
+  ResolvedEl: TPasResolverResult;
+  ProcType: TPasProcedureType;
+begin
+  Result:=nil;
+  if not (El.CustomData is TResolvedReference) then
+    begin
+    if AContext.Resolver<>nil then
+      RaiseIdentifierNotFound(aName,El,20161024191306)
+    else
+      // simple mode
+      Result:=CreateIdentifierExpr(aName,El,AContext);
+    exit;
+    end;
+
+  Ref:=TResolvedReference(El.CustomData);
+  Decl:=Ref.Declaration;
+
+  if IsExternalClassConstructor(Decl) then
+    begin
+    // create external object/function
+    Result:=ConvertExternalConstructor(nil,Ref,nil,AContext);
+    exit;
+    end;
+
+  if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
+    begin
+    // call constructor, destructor
+    Result:=CreateFreeOrNewInstanceExpr(Ref,AContext);
+    exit;
+    end;
+
+  if (Ref.WithExprScope<>nil) and AContext.Resolver.IsTObjectFreeMethod(El) then
+    begin
+    Result:=ConvertTObjectFree(nil,El,AContext);
+    exit;
+    end;
+
+  Prop:=nil;
+  AssignContext:=nil;
+  ImplicitCall:=rrfImplicitCallWithoutParams in Ref.Flags;
+
+  if Decl.ClassType=TPasProperty then
+    begin
+    // Decl is a property -> redirect to getter/setter
+    Prop:=TPasProperty(Decl);
+    case AContext.Access of
+      caAssign:
+        begin
+        Decl:=AContext.Resolver.GetPasPropertySetter(Prop);
+        if Decl is TPasProcedure then
+          begin
+          AssignContext:=AContext.AccessContext as TAssignContext;
+          if AssignContext.Call<>nil then
+            RaiseNotSupported(El,AContext,20170206000310);
+          AssignContext.PropertyEl:=Prop;
+          AssignContext.Setter:=Decl;
+          // Setter
+          Call:=CreateCallExpression(El);
+          AssignContext.Call:=Call;
+          Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
+          Call.AddArg(AssignContext.RightSide);
+          AssignContext.RightSide:=nil;
+          Result:=Call;
+          exit;
+          end;
+        end;
+      caRead:
+        begin
+        Decl:=AContext.Resolver.GetPasPropertyGetter(Prop);
+        if (Decl is TPasFunction) and (Prop.Args.Count=0) then
+          ImplicitCall:=true;
+        end;
+      else
+        RaiseNotSupported(El,AContext,20170213212623);
+    end;
+    end
+  else if Decl.ClassType=TPasArgument then
+    begin
+    Arg:=TPasArgument(Decl);
+    if Arg.Access in [argVar,argOut] then
       begin
-      Result:=CreateIdentifierExpr(El.Value,El,AContext);
+      // Arg is a reference object
+      case AContext.Access of
+        caRead:
+          begin
+          // create arg.get()
+          Call:=CreateCallExpression(El);
+          Call.Expr:=CreateDotExpression(El,
+            CreateIdentifierExpr(Arg.Name,Arg,AContext),
+            CreatePrimitiveDotExpr(TempRefObjGetterName));
+          Result:=Call;
+          exit;
+          end;
+        caAssign:
+          begin
+          // create arg.set(RHS)
+          AssignContext:=AContext.AccessContext as TAssignContext;
+          if AssignContext.Call<>nil then
+            RaiseNotSupported(El,AContext,20170214120606);
+          Call:=CreateCallExpression(El);
+          AssignContext.Call:=Call;
+          Call.Expr:=CreateDotExpression(El,
+                        CreateIdentifierExpr(Arg.Name,Arg,AContext),
+                        CreatePrimitiveDotExpr(TempRefObjSetterName));
+          Call.AddArg(AssignContext.RightSide);
+          AssignContext.RightSide:=nil;
+          Result:=Call;
+          exit;
+          end;
+        caByReference:
+          begin
+          // simply pass the reference
+          ParamContext:=AContext.AccessContext as TParamContext;
+          ParamContext.ReusingReference:=true;
+          Result:=CreateIdentifierExpr(Arg.Name,Arg,AContext);
+          exit;
+          end;
+        else
+          RaiseNotSupported(El,AContext,20170214120739);
       end;
-  end;
+      end;
+    end;
+
+  //writeln('TPasToJSConverter.ConvertPrimitiveExpression pekIdent TResolvedReference ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData));
+  if Decl.CustomData is TResElDataBuiltInProc then
+    begin
+    BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.ConvertPrimitiveExpression ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+    {$ENDIF}
+    case BuiltInProc.BuiltIn of
+      bfBreak: Result:=ConvertBuiltInBreak(El,AContext);
+      bfContinue: Result:=ConvertBuiltInContinue(El,AContext);
+      bfExit: Result:=ConvertBuiltIn_Exit(El,AContext);
+    else
+      RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+    end;
+    if Result=nil then
+      RaiseInconsistency(20170214120048);
+    exit;
+    end;
+
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertIdentifierExpr ',GetObjName(El),' Decl=',GetObjName(Decl),' Decl.Parent=',GetObjName(Decl.Parent));
+  //if CompareText(aName,'Self')=0 then
+  //  begin
+  //  writeln('TPasToJSConverter.ConvertIdentifierExpr AContext=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext),' LocalVar=',AContext.GetLocalName(Decl),' ',GetObjName(Decl));
+  //  AContext.WriteStack;
+  //  end;
+  {$ENDIF}
+
+  if Decl is TPasModule then
+    Name:=TransformModuleName(TPasModule(Decl),true,AContext)
+  else if (Decl is TPasFunctionType) and (CompareText(ResolverResultVar,aName)=0) then
+    Name:=ResolverResultVar
+  else if Decl.ClassType=TPasEnumValue then
+    begin
+    if UseEnumNumbers then
+      begin
+      Result:=CreateLiteralNumber(El,(Decl.Parent as TPasEnumType).Values.IndexOf(Decl));
+      exit;
+      end
+    else
+      begin
+      // enums always need the full path
+      Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,true);
+      end;
+    end
+  else if (CompareText(aName,'Self')=0) and (AContext.GetSelfContext<>nil) then
+    Name:=AContext.GetLocalName(Decl)
+  else
+    Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
+  if Result=nil then
+    Result:=CreatePrimitiveDotExpr(Name);
+
+  if ImplicitCall then
+    begin
+    // create a call with default parameters
+    ProcType:=nil;
+    if Decl is TPasProcedure then
+      ProcType:=TPasProcedure(Decl).ProcType
+    else
+      begin
+      AContext.Resolver.ComputeElement(El,ResolvedEl,[rcNoImplicitProc]);
+      if ResolvedEl.TypeEl is TPasProcedureType then
+        ProcType:=TPasProcedureType(ResolvedEl.TypeEl)
+      else
+        RaiseNotSupported(El,AContext,20170217005025);
+      end;
+
+    Call:=nil;
+    try
+      CreateProcedureCall(Call,nil,ProcType,AContext);
+      Call.Expr:=Result;
+      Result:=Call;
+    finally
+      if Result<>Call then
+        Call.Free;
+    end;
+    end;
+end;
+
+function TPasToJSConverter.ConvertBoolConstExpression(El: TBoolConstExpr;
+  AContext: TConvertContext): TJSElement;
+
+begin
+  if AContext=nil then ;
+  Result:=CreateLiteralBoolean(El,El.Value);
 end;
 
+function TPasToJSConverter.ConvertNilExpr(El: TNilExpr;
+  AContext: TConvertContext): TJSElement;
+begin
+  if AContext=nil then ;
+  Result:=CreateLiteralNull(El);
+end;
 
-Function TPasToJSConverter.ConvertBoolConstExpression(El: TBoolConstExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr;
+  AContext: TConvertContext): TJSElement;
 
-Var
-  L : TJSLiteral;
+  function CreateAncestorCall(ParentEl: TPasElement; Apply: boolean;
+    AncestorProc: TPasProcedure; ParamsExpr: TParamsExpr): TJSElement;
+  var
+    FunName, SelfName: String;
+    Call: TJSCallExpression;
+    SelfContext: TFunctionContext;
+    ClassScope, AncestorScope: TPasClassScope;
+    AncestorClass, aClass: TPasClassType;
+  begin
+    Result:=nil;
+    SelfContext:=AContext.GetSelfContext;
+    if SelfContext=nil then
+      RaiseInconsistency(20170418114702);
+    SelfName:=SelfContext.GetLocalName(SelfContext.ThisPas);
+
+    if Apply and (SelfContext<>AContext) then
+      DoError(20170418204325,nNestedInheritedNeedsParameters,sNestedInheritedNeedsParameters,
+        [],El);
+
+    if (AncestorProc.Parent is TPasClassType)
+        and TPasClassType(AncestorProc.Parent).IsExternal then
+      begin
+      // ancestor is in an external class
+      // They could be overriden, without a Pascal declaration
+      // -> use the direct ancestor class of the current proc
+      aClass:=SelfContext.ThisPas as TPasClassType;
+      if aClass.CustomData=nil then
+        RaiseInconsistency(20170323111252);
+      ClassScope:=TPasClassScope(aClass.CustomData);
+      AncestorScope:=ClassScope.AncestorScope;
+      if AncestorScope=nil then
+        RaiseInconsistency(20170323111306);
+      AncestorClass:=AncestorScope.Element as TPasClassType;
+      FunName:=CreateReferencePath(AncestorClass,AContext,rpkPathAndName,true)
+        +'.'+TransformVariableName(AncestorProc,AContext);
+      end
+    else
+      FunName:=CreateReferencePath(AncestorProc,AContext,rpkPathAndName,true);
+    if Apply and (SelfContext=AContext) then
+      // create "ancestor.funcname.apply(this,arguments)"
+      FunName:=FunName+'.apply'
+    else
+      // create "ancestor.funcname.call(this,param1,param2,...)"
+      FunName:=FunName+'.call';
+    Call:=nil;
+    try
+      Call:=CreateCallExpression(ParentEl);
+      Call.Expr:=CreatePrimitiveDotExpr(FunName);
+      Call.AddArg(CreatePrimitiveDotExpr(SelfName));
+      if Apply then
+        // "inherited;" -> pass the arguments
+        Call.AddArg(CreatePrimitiveDotExpr('arguments'))
+      else
+        // "inherited Name(...)" -> pass the user arguments
+        CreateProcedureCall(Call,ParamsExpr,AncestorProc.ProcType,AContext);
+      Result:=Call;
+    finally
+      if Result=nil then
+        Call.Free;
+    end;
+  end;
 
+var
+  Right: TPasExpr;
+  Ref: TResolvedReference;
+  PrimExpr: TPrimitiveExpr;
+  AncestorProc: TPasProcedure;
+  ParamsExpr: TParamsExpr;
+begin
+  Result:=nil;
+  if (El.Parent is TBinaryExpr) and (TBinaryExpr(El.Parent).OpCode=eopNone)
+      and (TBinaryExpr(El.Parent).left=El) then
+    begin
+    // "inherited <name>"
+    AncestorProc:=nil;
+    ParamsExpr:=nil;
+    Right:=TBinaryExpr(El.Parent).right;
+    if Right.ClassType=TPrimitiveExpr then
+      begin
+      PrimExpr:=TPrimitiveExpr(Right);
+      Ref:=PrimExpr.CustomData as TResolvedReference;
+      if rrfImplicitCallWithoutParams in Ref.Flags then
+        begin
+        // inherited <function>
+        // -> create "AncestorProc.call(this,defaultargs)"
+        AncestorProc:=Ref.Declaration as TPasProcedure;
+        end
+      else
+        begin
+        // inherited <varname>
+        // all variables have unique names -> simply access it
+        Result:=ConvertPrimitiveExpression(PrimExpr,AContext);
+        exit;
+        end;
+      end
+    else if Right.ClassType=TParamsExpr then
+      begin
+      ParamsExpr:=TParamsExpr(Right);
+      if ParamsExpr.Kind=pekFuncParams then
+        begin
+        if ParamsExpr.Value is TPrimitiveExpr then
+          begin
+          // inherited <function>(args)
+          // -> create "AncestorProc.call(this,args,defaultargs)"
+          PrimExpr:=TPrimitiveExpr(ParamsExpr.Value);
+          Ref:=PrimExpr.CustomData as TResolvedReference;
+          AncestorProc:=Ref.Declaration as TPasProcedure;
+          end
+        else
+          DoError(20170418205802,nXExpectedButYFound,sXExpectedButYFound,
+            ['inherited name()',ParamsExpr.Value.ElementTypeName],ParamsExpr.Value);
+        end
+      else
+        begin
+        // inherited <varname>[]
+        // all variables have unique names -> simply access it
+        Result:=ConvertElement(Right,AContext);
+        exit;
+        end;
+      end
+    else
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertInheritedExpression Parent=',GetTreeDbg(El.Parent,2));
+      {$ENDIF}
+      DoError(20170418205955,nXExpectedButYFound,sXExpectedButYFound,
+        ['inherited name()',Right.ElementTypeName],Right);
+      end;
+    if AncestorProc=nil then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertInheritedExpression Right=',GetObjName(Right));
+      {$ENDIF}
+      RaiseNotSupported(El,AContext,20170201190824);
+      end;
+    //writeln('TPasToJSConverter.ConvertInheritedExpression Func=',GetObjName(FuncContext.PasElement));
+    Result:=CreateAncestorCall(Right,false,AncestorProc,ParamsExpr);
+    end
+  else
+    begin
+    // "inherited;"
+    if El.CustomData=nil then
+      exit; // "inherited;" when there is no AncestorProc proc -> silently ignore
+    // create "AncestorProc.apply(this,arguments)"
+    Ref:=TResolvedReference(El.CustomData);
+    AncestorProc:=Ref.Declaration as TPasProcedure;
+    Result:=CreateAncestorCall(El,true,AncestorProc,nil);
+    end;
+end;
+
+function TPasToJSConverter.ConvertSelfExpression(El: TSelfExpr;
+  AContext: TConvertContext): TJSElement;
+begin
+  Result:=ConvertIdentifierExpr(El,'Self',AContext);
+end;
+
+function TPasToJSConverter.ConvertParamsExpression(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
 begin
   Result:=Nil;
-  L:=TJSLiteral(CreateElement(TJSLiteral,El));
-  L.Value.AsBoolean:=EL.Value;
-  Result:=L;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertParamsExpression ',GetObjName(El),' El.Kind=',ExprKindNames[El.Kind]);
+  {$ENDIF}
+  Case El.Kind of
+    pekFuncParams:
+      Result:=ConvertFuncParams(El,AContext);
+    pekArrayParams:
+      Result:=ConvertArrayParams(El,AContext);
+    pekSet:
+      Result:=ConvertSetLiteral(El,AContext);
+  else
+    RaiseNotSupported(El,AContext,20170209103235,ExprKindNames[El.Kind]);
+  end;
 end;
 
-Function TPasToJSConverter.ConvertNilExpr(El: TNilExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertArrayParams(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  ArgContext: TConvertContext;
+
+  function GetValueReference: TResolvedReference;
+  var
+    Value: TPasExpr;
+  begin
+    Result:=nil;
+    Value:=El.Value;
+    if (Value.ClassType=TPrimitiveExpr)
+        and (Value.CustomData is TResolvedReference) then
+      exit(TResolvedReference(Value.CustomData));
+  end;
+
+  procedure ConvertStringBracket;
+  var
+    Call: TJSCallExpression;
+    Param: TPasExpr;
+    Expr: TJSAdditiveExpressionMinus;
+    DotExpr: TJSDotMemberExpression;
+    AssignContext: TAssignContext;
+    Elements: TJSArrayLiteralElements;
+    AssignSt: TJSSimpleAssignStatement;
+    OldAccess: TCtxAccess;
+  begin
+    Param:=El.Params[0];
+    case AContext.Access of
+    caAssign:
+      begin
+      // s[index] := value  ->  s = rtl.setCharAt(s,index,value)
+      AssignContext:=AContext.AccessContext as TAssignContext;
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      try
+        OldAccess:=AContext.Access;
+        AContext.Access:=caRead;
+        AssignSt.LHS:=ConvertElement(El.Value,AContext);
+        // rtl.setCharAt
+        Call:=CreateCallExpression(El);
+        AssignContext.Call:=Call;
+        AssignSt.Expr:=Call;
+        Elements:=Call.Args.Elements;
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSetCharAt]]);
+        // first param  s
+        Elements.AddElement.Expr:=ConvertElement(El.Value,AContext);
+        AContext.Access:=OldAccess;
+        // second param  index
+        Elements.AddElement.Expr:=ConvertElement(Param,ArgContext);
+        // third param  value
+        Elements.AddElement.Expr:=AssignContext.RightSide;
+        AssignContext.RightSide:=nil;
+        Result:=AssignSt
+      finally
+        if Result=nil then
+          AssignSt.Free;
+      end;
+      end;
+    caRead:
+      begin
+      Call:=CreateCallExpression(El);
+      Elements:=Call.Args.Elements;
+      try
+        // s[index]  ->  s.charAt(index-1)
+        // add string accessor
+        DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+        Call.Expr:=DotExpr;
+        DotExpr.MExpr:=ConvertElement(El.Value,AContext);
+        DotExpr.Name:='charAt';
+
+        // add parameter "index-1"
+        Expr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
+        Elements.AddElement.Expr:=Expr;
+        Expr.A:=ConvertElement(Param,ArgContext);
+        Expr.B:=CreateLiteralNumber(Param,1);
+        Result:=Call;
+      finally
+        if Result=nil then
+          Call.Free;
+      end;
+      end;
+    else
+      RaiseNotSupported(El,AContext,20170213213101);
+    end;
+  end;
+
+  procedure ConvertArray(ArrayEl: TPasArrayType);
+  var
+    B, Sub: TJSBracketMemberExpression;
+    i, ArgNo: Integer;
+    Arg: TJSElement;
+    OldAccess: TCtxAccess;
+  begin
+    B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+    try
+      // add read accessor
+      OldAccess:=AContext.Access;
+      AContext.Access:=caRead;
+      B.MExpr:=ConvertElement(El.Value,AContext);
+      AContext.Access:=OldAccess;
+
+      Result:=B;
+      ArgNo:=0;
+      repeat
+        // Note: dynamic array has length(ArrayEl.Ranges)=0
+        for i:=1 to Max(length(ArrayEl.Ranges),1) do
+          begin
+          // add parameter
+          ArgContext.Access:=caRead;
+          Arg:=ConvertElement(El.Params[ArgNo],ArgContext);
+          ArgContext.Access:=OldAccess;
+          if B.Name<>nil then
+            begin
+            Sub:=B;
+            B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+            B.MExpr:=Sub;
+            end;
+          B.Name:=Arg;
+          inc(ArgNo);
+          if ArgNo>length(El.Params) then
+            RaiseInconsistency(20170206180553);
+          end;
+        if ArgNo=length(El.Params) then
+          break;
+        // continue in sub array
+        ArrayEl:=AContext.Resolver.ResolveAliasType(ArrayEl.ElType) as TPasArrayType;
+      until false;
+      Result:=B;
+    finally
+      if Result=nil then
+        B.Free;
+    end;
+  end;
+
+  procedure ConvertJSObject;
+  var
+    B: TJSBracketMemberExpression;
+    OldAccess: TCtxAccess;
+  begin
+    B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+    try
+      // add read accessor
+      OldAccess:=AContext.Access;
+      AContext.Access:=caRead;
+      B.MExpr:=ConvertElement(El.Value,AContext);
+      AContext.Access:=OldAccess;
+
+      // add parameter
+      ArgContext.Access:=caRead;
+      B.Name:=ConvertElement(El.Params[0],ArgContext);
+      ArgContext.Access:=OldAccess;
+
+      Result:=B;
+    finally
+      if Result=nil then
+        B.Free;
+    end;
+  end;
+
+  function IsJSBracketAccessorAndConvert(Prop: TPasProperty;
+    AccessEl: TPasElement;
+    AContext: TConvertContext; ChompPropName: boolean): boolean;
+  // If El.Value contains property name set ChompPropName = true
+  var
+    Bracket: TJSBracketMemberExpression;
+    OldAccess: TCtxAccess;
+    PathEl: TPasExpr;
+    Ref: TResolvedReference;
+    Path: String;
+  begin
+    if not AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
+      exit(false);
+    Result:=true;
+    // bracket accessor of external class
+    if Prop.Args.Count<>1 then
+      RaiseInconsistency(20170403003753);
+    // bracket accessor of external class  -> create  PathEl[param]
+    Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,Prop));
+    try
+      PathEl:=El.Value;
+      if ChompPropName then
+        begin
+        if (PathEl is TPrimitiveExpr)
+            and (TPrimitiveExpr(PathEl).Kind=pekIdent)
+            and (PathEl.CustomData is TResolvedReference) then
+          begin
+          // propname without path, e.g.  propname[param]
+          Ref:=TResolvedReference(PathEl.CustomData);
+          Path:=CreateReferencePath(Prop,AContext,rpkPath,false,Ref);
+          if Path<>'' then
+            Bracket.MExpr:=CreatePrimitiveDotExpr(Path);
+          PathEl:=nil;
+          end
+        else if (PathEl is TBinaryExpr)
+            and (TBinaryExpr(PathEl).OpCode=eopSubIdent)
+            and (TBinaryExpr(PathEl).right is TPrimitiveExpr)
+            and (TPrimitiveExpr(TBinaryExpr(PathEl).right).Kind=pekIdent) then
+          begin
+          // instance.propname[param]  ->  instance[param]
+          PathEl:=TBinaryExpr(PathEl).left;
+          end
+        else
+          RaiseNotSupported(El.Value,AContext,20170402225050);
+        end;
+
+      if (PathEl<>nil) and (Bracket.MExpr=nil) then
+        begin
+        OldAccess:=AContext.Access;
+        AContext.Access:=caRead;
+        Bracket.MExpr:=ConvertElement(PathEl,AContext);
+        AContext.Access:=OldAccess;
+        end;
+
+      OldAccess:=ArgContext.Access;
+      ArgContext.Access:=caRead;
+      Bracket.Name:=ConvertElement(El.Params[0],ArgContext);
+      ArgContext.Access:=OldAccess;
+      ConvertArrayParams:=Bracket;
+      Bracket:=nil;
+    finally
+      Bracket.Free;
+    end;
+  end;
+
+  procedure ConvertIndexedProperty(Prop: TPasProperty; AContext: TConvertContext);
+  var
+    Call: TJSCallExpression;
+    i: Integer;
+    TargetArg: TPasArgument;
+    Elements: TJSArrayLiteralElements;
+    Arg: TJSElement;
+    AccessEl: TPasElement;
+    AssignContext: TAssignContext;
+    OldAccess: TCtxAccess;
+  begin
+    Result:=nil;
+    AssignContext:=nil;
+    Call:=CreateCallExpression(El);
+    try
+      case AContext.Access of
+      caAssign:
+        begin
+        AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
+        if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
+            exit;
+        AssignContext:=AContext.AccessContext as TAssignContext;
+        AssignContext.PropertyEl:=Prop;
+        AssignContext.Setter:=AccessEl;
+        AssignContext.Call:=Call;
+        end;
+      caRead:
+        begin
+        AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
+        if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
+          exit;
+        end
+      else
+        RaiseNotSupported(El,AContext,20170213213317);
+      end;
+      Call.Expr:=CreateReferencePathExpr(AccessEl,AContext,false,GetValueReference);
+
+      Elements:=Call.Args.Elements;
+      OldAccess:=ArgContext.Access;
+      // add params
+      i:=0;
+      while i<Prop.Args.Count do
+        begin
+        TargetArg:=TPasArgument(Prop.Args[i]);
+        Arg:=CreateProcCallArg(El.Params[i],TargetArg,ArgContext);
+        Elements.AddElement.Expr:=Arg;
+        inc(i);
+        end;
+      // fill up default values
+      while i<Prop.Args.Count do
+        begin
+        TargetArg:=TPasArgument(Prop.Args[i]);
+        if TargetArg.ValueExpr=nil then
+          begin
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.ConvertArrayParams.ConvertIndexedProperty missing default value: Prop=',Prop.Name,' i=',i);
+          {$ENDIF}
+          RaiseInconsistency(20170206185126);
+          end;
+        AContext.Access:=caRead;
+        Arg:=ConvertElement(TargetArg.ValueExpr,ArgContext);
+        Elements.AddElement.Expr:=Arg;
+        inc(i);
+        end;
+      // finally add as last parameter the value
+      if AssignContext<>nil then
+        begin
+        Elements.AddElement.Expr:=AssignContext.RightSide;
+        AssignContext.RightSide:=nil;
+        end;
+
+      ArgContext.Access:=OldAccess;
+      Result:=Call;
+    finally
+      if Result=nil then
+        begin
+        if (AssignContext<>nil) and (AssignContext.Call=Call) then
+          AssignContext.Call:=nil;
+        Call.Free;
+        end;
+    end;
+  end;
+
+  procedure ConvertDefaultProperty(const ResolvedEl: TPasResolverResult;
+    Prop: TPasProperty);
+  var
+    DotContext: TDotContext;
+    Left, Right: TJSElement;
+    OldAccess: TCtxAccess;
+    AccessEl, SetAccessEl: TPasElement;
+  begin
+    case AContext.Access of
+    caAssign:
+      begin
+      AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
+      if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
+        exit;
+      end;
+    caRead:
+      begin
+      AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
+      if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
+        exit;
+      end;
+    caByReference:
+      begin
+      //ParamContext:=AContext.AccessContext as TParamContext;
+      AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
+      SetAccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
+      if AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
+        begin
+        if AContext.Resolver.IsExternalBracketAccessor(SetAccessEl) then
+          begin
+          // read and write are brackets -> easy
+          if not IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
+            RaiseNotSupported(El,AContext,20170405090845);
+          exit;
+          end;
+        end;
+      RaiseNotSupported(El,AContext,20170403000550);
+      end;
+    else
+      RaiseNotSupported(El,AContext,20170402233834);
+    end;
+
+    DotContext:=nil;
+    Left:=nil;
+    Right:=nil;
+    try
+      OldAccess:=AContext.Access;
+      AContext.Access:=caRead;
+      Left:=ConvertElement(El.Value,AContext);
+      AContext.Access:=OldAccess;
+
+      DotContext:=TDotContext.Create(El.Value,Left,AContext);
+      DotContext.LeftResolved:=ResolvedEl;
+      ConvertIndexedProperty(Prop,DotContext);
+      Right:=Result;
+      Result:=nil;
+    finally
+      DotContext.Free;
+      if Right=nil then
+        Left.Free;
+    end;
+    Result:=CreateDotExpression(El,Left,Right);
+  end;
 
 Var
-  L : TJSLiteral;
+  ResolvedEl: TPasResolverResult;
+  TypeEl: TPasType;
+  ClassScope: TPas2JSClassScope;
+  B: TJSBracketMemberExpression;
+  OldAccess: TCtxAccess;
+  aClass: TPasClassType;
+begin
+  if El.Kind<>pekArrayParams then
+    RaiseInconsistency(20170209113713);
+  ArgContext:=AContext;
+  while ArgContext is TDotContext do
+    ArgContext:=ArgContext.Parent;
+  if AContext.Resolver=nil then
+    begin
+    // without Resolver
+    if Length(El.Params)>1 then
+      RaiseNotSupported(El,AContext,20170207151325,'Cannot convert 2-dim arrays');
+    B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+    try
+      // add reference
+      OldAccess:=AContext.Access;
+      AContext.Access:=caRead;
+      B.MExpr:=ConvertElement(El.Value,AContext);
+
+      // add parameter
+      OldAccess:=ArgContext.Access;
+      ArgContext.Access:=caRead;
+      B.Name:=ConvertElement(El.Params[0],ArgContext);
+      ArgContext.Access:=OldAccess;
+
+      Result:=B;
+    finally
+      if Result=nil then
+        B.Free;
+    end;
+    exit;
+    end;
+  // has Resolver
+  AContext.Resolver.ComputeElement(El.Value,ResolvedEl,[]);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertArrayParams Value=',GetResolverResultDbg(ResolvedEl));
+  {$ENDIF}
+  if ResolvedEl.BaseType in btAllJSStrings then
+    ConvertStringBracket
+  else if (ResolvedEl.IdentEl is TPasProperty)
+      and (TPasProperty(ResolvedEl.IdentEl).Args.Count>0) then
+    ConvertIndexedProperty(TPasProperty(ResolvedEl.IdentEl),AContext)
+  else if ResolvedEl.BaseType=btContext then
+    begin
+    TypeEl:=ResolvedEl.TypeEl;
+    if TypeEl.ClassType=TPasClassType then
+      begin
+      aClass:=TPasClassType(TypeEl);
+      ClassScope:=aClass.CustomData as TPas2JSClassScope;
+      if ClassScope.DefaultProperty<>nil then
+        ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty)
+      else
+        RaiseInconsistency(20170206180448);
+      end
+    else if TypeEl.ClassType=TPasClassOfType then
+      begin
+      ClassScope:=TPasClassOfType(TypeEl).DestType.CustomData as TPas2JSClassScope;
+      if ClassScope.DefaultProperty=nil then
+        RaiseInconsistency(20170206180503);
+      ConvertDefaultProperty(ResolvedEl,ClassScope.DefaultProperty);
+      end
+    else if TypeEl.ClassType=TPasArrayType then
+      ConvertArray(TPasArrayType(TypeEl))
+    else
+      RaiseNotSupported(El,AContext,20170206181220,GetResolverResultDbg(ResolvedEl));
+    end
+  else
+    RaiseNotSupported(El,AContext,20170206180222);
+end;
 
+function TPasToJSConverter.ConvertFuncParams(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  Ref: TResolvedReference;
+  Decl, Left: TPasElement;
+  BuiltInProc: TResElDataBuiltInProc;
+  TargetProcType: TPasProcedureType;
+  Call: TJSCallExpression;
+  Elements: TJSArrayLiteralElements;
+  E: TJSArrayLiteral;
+  OldAccess: TCtxAccess;
+  DeclResolved, ParamResolved, ValueResolved: TPasResolverResult;
+  Param: TPasExpr;
+  JSBaseType: TPas2jsBaseType;
+  C: TClass;
 begin
-  L:=TJSLiteral(CreateElement(TJSLiteral,El));
-  L.Value.IsNull:=True;
-  Result:=L;
+  Result:=nil;
+  if El.Kind<>pekFuncParams then
+    RaiseInconsistency(20170209113515);
+  //writeln('TPasToJSConverter.ConvertFuncParams START pekFuncParams ',GetObjName(El.CustomData),' ',GetObjName(El.Value.CustomData));
+  Call:=nil;
+  Elements:=nil;
+  TargetProcType:=nil;
+  if El.Value.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(El.Value.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl is TPasType then
+      Decl:=AContext.Resolver.ResolveAliasType(TPasType(Decl));
+    //writeln('TPasToJSConverter.ConvertFuncParams pekFuncParams TResolvedReference ',GetObjName(Ref.Declaration),' ',GetObjName(Ref.Declaration.CustomData));
+    C:=Decl.ClassType;
+
+    if C=TPasUnresolvedSymbolRef then
+      begin
+      if Decl.CustomData is TResElDataBuiltInProc then
+        begin
+        BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.ConvertFuncParams BuiltInProc ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+        {$ENDIF}
+        case BuiltInProc.BuiltIn of
+          bfLength: Result:=ConvertBuiltIn_Length(El,AContext);
+          bfSetLength: Result:=ConvertBuiltIn_SetLength(El,AContext);
+          bfInclude: Result:=ConvertBuiltIn_ExcludeInclude(El,AContext,true);
+          bfExclude: Result:=ConvertBuiltIn_ExcludeInclude(El,AContext,false);
+          bfExit: Result:=ConvertBuiltIn_Exit(El,AContext);
+          bfInc,
+          bfDec: Result:=ConvertBuiltIn_IncDec(El,AContext);
+          bfAssigned: Result:=ConvertBuiltIn_Assigned(El,AContext);
+          bfChr: Result:=ConvertBuiltIn_Chr(El,AContext);
+          bfOrd: Result:=ConvertBuiltIn_Ord(El,AContext);
+          bfLow: Result:=ConvertBuiltIn_Low(El,AContext);
+          bfHigh: Result:=ConvertBuiltIn_High(El,AContext);
+          bfPred: Result:=ConvertBuiltIn_Pred(El,AContext);
+          bfSucc: Result:=ConvertBuiltIn_Succ(El,AContext);
+          bfStrProc: Result:=ConvertBuiltIn_StrProc(El,AContext);
+          bfStrFunc: Result:=ConvertBuiltIn_StrFunc(El,AContext);
+          bfConcatArray: Result:=ConvertBuiltIn_ConcatArray(El,AContext);
+          bfCopyArray: Result:=ConvertBuiltIn_CopyArray(El,AContext);
+          bfInsertArray: Result:=ConvertBuiltIn_InsertArray(El,AContext);
+          bfDeleteArray: Result:=ConvertBuiltIn_DeleteArray(El,AContext);
+          bfTypeInfo: Result:=ConvertBuiltIn_TypeInfo(El,AContext);
+        else
+          RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+        end;
+        if Result=nil then
+          RaiseInconsistency(20170210121932);
+        exit;
+        end
+      else if Decl.CustomData is TResElDataBaseType then
+        begin
+        Result:=ConvertTypeCastToBaseType(El,AContext,TResElDataBaseType(Decl.CustomData));
+        exit;
+        end
+      else
+        RaiseNotSupported(El,AContext,20170325160624);
+      end
+    else if IsExternalClassConstructor(Decl) then
+      begin
+      // create external object/function
+      // -> check if there is complex left side, e.g. TExtA.Create(params)
+      Left:=El;
+      while (Left.Parent.ClassType=TParamsExpr) do
+        Left:=Left.Parent;
+      if (Left.Parent.ClassType=TBinaryExpr) and (TBinaryExpr(Left.Parent).right=Left) then
+        Left:=TBinaryExpr(Left.Parent).Left
+      else
+        Left:=nil;
+      Result:=ConvertExternalConstructor(Left,Ref,El,AContext);
+      exit;
+      end
+    else if C.InheritsFrom(TPasProcedure) then
+      TargetProcType:=TPasProcedure(Decl).ProcType
+    else if (C=TPasClassType)
+        or (C=TPasClassOfType)
+        or (C=TPasRecordType)
+        or (C=TPasEnumType)
+        or (C=TPasArrayType) then
+      begin
+      // typecast
+      // default is to simply replace  "aType(value)" with "value"
+      Param:=El.Params[0];
+      AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
+
+      Result:=ConvertElement(Param,AContext);
+      if (ParamResolved.BaseType=btCustom)
+          and (ParamResolved.TypeEl.CustomData is TResElDataPas2JSBaseType) then
+        begin
+        JSBaseType:=TResElDataPas2JSBaseType(ParamResolved.TypeEl.CustomData).JSBaseType;
+        if JSBaseType=pbtJSValue then
+          begin
+          if (C=TPasClassType)
+              or (C=TPasClassOfType)
+              or (C=TPasRecordType) then
+            begin
+            // TObject(jsvalue)  ->  rtl.getObject(jsvalue)
+            Call:=CreateCallExpression(El);
+            Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetObject]]);
+            Call.AddArg(Result);
+            Result:=Call;
+            end;
+          end;
+        end;
+      exit;
+      end
+    else if C.InheritsFrom(TPasVariable) then
+      begin
+      AContext.Resolver.ComputeElement(Decl,DeclResolved,[rcType]);
+      if DeclResolved.TypeEl is TPasProcedureType then
+        TargetProcType:=TPasProcedureType(DeclResolved.TypeEl)
+      else
+        RaiseNotSupported(El,AContext,20170217115244);
+      end
+    else if (C=TPasArgument) then
+      begin
+      AContext.Resolver.ComputeElement(Decl,DeclResolved,[rcType]);
+      if DeclResolved.TypeEl is TPasProcedureType then
+        TargetProcType:=TPasProcedureType(DeclResolved.TypeEl)
+      else
+        RaiseNotSupported(El,AContext,20170328224020);
+      end
+    else if (C=TPasProcedureType)
+        or (C=TPasFunctionType) then
+      begin
+      AContext.Resolver.ComputeElement(El.Value,ValueResolved,[rcNoImplicitProc]);
+      if ValueResolved.IdentEl is TPasProcedureType then
+        begin
+         // type cast to proc type
+        Param:=El.Params[0];
+        Result:=ConvertElement(Param,AContext);
+        exit;
+        end
+      else
+        begin
+        // calling proc var
+        TargetProcType:=TPasProcedureType(Decl);
+        end;
+      end
+    else
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertFuncParams El=',GetObjName(El),' Decl=',GetObjName(Decl));
+      {$ENDIF}
+      RaiseNotSupported(El,AContext,20170215114337);
+      end;
+    if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
+      // call constructor, destructor
+      Call:=CreateFreeOrNewInstanceExpr(Ref,AContext);
+    end;
+  if Call=nil then
+    begin
+    Call:=CreateCallExpression(El);
+    Elements:=Call.Args.Elements;
+    end;
+  OldAccess:=AContext.Access;
+  try
+    AContext.Access:=caRead;
+    if Call.Expr=nil then
+      Call.Expr:=ConvertElement(El.Value,AContext);
+    if Call.Args=nil then
+      begin
+      // append ()
+      Call.Args:=TJSArguments(CreateElement(TJSArguments,El));
+      Elements:=Call.Args.Elements;
+      end
+    else if Elements=nil then
+      begin
+      // insert array parameter [], e.g. this.TObject.$create("create",[])
+      Elements:=Call.Args.Elements;
+      E:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+      Elements.AddElement.Expr:=E;
+      Elements:=TJSArrayLiteral(E).Elements;
+      end;
+    CreateProcedureCallArgs(Elements,El,TargetProcType,AContext);
+    if Elements.Count=0 then
+      begin
+      Call.Args.Free;
+      Call.Args:=nil;
+      end;
+    Result:=Call;
+  finally
+    AContext.Access:=OldAccess;
+    if Result=nil then
+      Call.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertExternalConstructor(Left: TPasElement;
+  Ref: TResolvedReference; ParamsExpr: TParamsExpr; AContext: TConvertContext
+  ): TJSElement;
 var
-   je: TJSPrimaryExpressionIdent;
+  Proc: TPasConstructor;
+  ExtName: String;
+  NewExpr: TJSNewMemberExpression;
+  Call: TJSCallExpression;
+  LeftResolved: TPasResolverResult;
+  OldAccess: TCtxAccess;
+  ExtNameEl: TJSElement;
+  WithData: TPas2JSWithExprScope;
 begin
- je := TJSPrimaryExpressionIdent.Create(0, 0, '');
-  je.Name := '_super';
-  Result := je;
-//  TInheritedExpr = class(TPasExpr)
+  Result:=nil;
+  NewExpr:=nil;
+  Call:=nil;
+  ExtNameEl:=nil;
+  try
+    Proc:=Ref.Declaration as TPasConstructor;
+    ExtNameEl:=nil;
+
+    if Left<>nil then
+      begin
+      if AContext.Resolver<>nil then
+        begin
+        AContext.Resolver.ComputeElement(Left,LeftResolved,[]);
+        if LeftResolved.BaseType=btModule then
+          begin
+          // e.g. Unit.TExtA
+          // ExtName is global -> omit unit
+          Left:=nil;
+          end
+        else ;
+        end;
+      if Left<>nil then
+        begin
+        // convert left side
+        OldAccess:=AContext.Access;
+        AContext.Access:=caRead;
+        ExtNameEl:=ConvertElement(Left,AContext);
+        AContext.Access:=OldAccess;
+        end;
+      end;
+    if ExtNameEl=nil then
+      begin
+      if Ref.WithExprScope<>nil then
+        begin
+        // using local WITH var
+        WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
+        ExtName:=WithData.WithVarName;
+        end
+      else
+        // use external class name
+        ExtName:=(Proc.Parent as TPasClassType).ExternalName;
+      ExtNameEl:=CreatePrimitiveDotExpr(ExtName);
+      end;
+
+    if CompareText(Proc.Name,'new')=0 then
+      begin
+      // create 'new ExtName(params)'
+      NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,Ref.Element));
+      NewExpr.MExpr:=ExtNameEl;
+      NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,Ref.Element));
+      ExtNameEl:=nil;
+      if ParamsExpr<>nil then
+        CreateProcedureCallArgs(NewExpr.Args.Elements,ParamsExpr,Proc.ProcType,AContext);
+      Result:=NewExpr;
+      NewExpr:=nil;
+      end
+    else
+      RaiseInconsistency(20170323083214);
+  finally
+    ExtNameEl.Free;
+    NewExpr.Free;
+    Call.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertSelfExpression(El: TSelfExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertTObjectFree(Bin: TBinaryExpr;
+  NameExpr: TPasExpr; AContext: TConvertContext): TJSElement;
+
+  function CreateCallRTLFree(Obj, Prop: TJSElement): TJSElement;
+  // create "rtl.free(obj,prop)"
+  var
+    Call: TJSCallExpression;
+  begin
+    Call:=CreateCallExpression(Bin.right);
+    Call.Expr:=CreateMemberExpression([GetBuildInNames(pbivnRTL),GetBuildInNames(pbifnFreeVar)]);
+    Call.Args.AddElement(Obj);
+    Call.Args.AddElement(Prop);
+    Result:=Call;
+  end;
 
+  function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement;
+  // create "Setter=rtl.freeLoc(Getter)"
+  var
+    Call: TJSCallExpression;
+    AssignSt: TJSSimpleAssignStatement;
+  begin
+    Call:=CreateCallExpression(Src);
+    Call.Expr:=CreateMemberExpression([GetBuildInNames(pbivnRTL),GetBuildInNames(pbifnFreeLocalVar)]);
+    Call.Args.AddElement(Getter);
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,Src));
+    AssignSt.LHS:=Setter;
+    AssignSt.Expr:=Call;
+    Result:=AssignSt;
+  end;
+
+var
+  LeftJS, Obj, Prop, Getter, Setter: TJSElement;
+  DotExpr: TJSDotMemberExpression;
+  BracketJS: TJSBracketMemberExpression;
+  aName: TJSString;
+  WithExprScope: TPas2JSWithExprScope;
 begin
-  Result:=TJSPrimaryExpressionThis(CreateElement(TJSPrimaryExpressionThis,El));
+  Result:=nil;
+
+  LeftJS:=nil;
+  try
+    WithExprScope:=TResolvedReference(NameExpr.CustomData).WithExprScope as TPas2JSWithExprScope;
+    if WithExprScope<>nil then
+      begin
+      if AContext.Resolver.GetNewInstanceExpr(WithExprScope.Expr)<>nil then
+        begin
+        // "with TSomeClass.Create do Free"
+        // -> "$with1=rtl.freeLoc($with1);
+        Getter:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,WithExprScope.Expr);
+        Setter:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,WithExprScope.Expr);
+        Result:=CreateCallRTLFreeLoc(Setter,Getter,NameExpr);
+        exit;
+        end;
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertTObjectFree With=',GetObjName(WithExprScope.Expr));
+      {$ENDIF}
+      RaiseInconsistency(20170517092248);
+      end;
+
+    LeftJS:=ConvertElement(Bin.left,AContext);
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.ConvertTObjectFree ',GetObjName(LeftJS));
+    {$ENDIF}
+
+    if LeftJS is TJSPrimaryExpressionIdent then
+      begin
+      aName:=TJSPrimaryExpressionIdent(LeftJS).Name;
+      if Pos('.',aName)>0 then
+        RaiseInconsistency(20170516173832);
+      // v.free
+      // -> v=rtl.freeLoc(v);
+      Getter:=LeftJS;
+      Setter:=ClonePrimaryExpression(TJSPrimaryExpressionIdent(LeftJS),Bin.left);
+      Result:=CreateCallRTLFreeLoc(Setter,Getter,NameExpr);
+      end
+    else if LeftJS is TJSDotMemberExpression then
+      begin
+      // obj.prop.free
+      // ->  rtl.free(obj,"prop");
+      DotExpr:=TJSDotMemberExpression(LeftJS);
+      Obj:=DotExpr.MExpr;
+      DotExpr.MExpr:=nil;
+      Prop:=CreateLiteralJSString(Bin.right,DotExpr.Name);
+      FreeAndNil(LeftJS);
+      Result:=CreateCallRTLFree(Obj,Prop);
+      end
+    else if LeftJS is TJSBracketMemberExpression then
+      begin
+      // obj[prop].free
+      // ->  rtl.free(obj,prop);
+      BracketJS:=TJSBracketMemberExpression(LeftJS);
+      Obj:=BracketJS.MExpr;
+      BracketJS.MExpr:=nil;
+      Prop:=BracketJS.Name;
+      BracketJS.Name:=nil;
+      FreeAndNil(LeftJS);
+      Result:=CreateCallRTLFree(Obj,Prop);
+      end
+    else
+      RaiseNotSupported(Bin.left,AContext,20170516164659,'invalid scope for Free');
+  finally
+    if Result=nil then
+      LeftJS.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertParamsExpression(El: TParamsExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertTypeCastToBaseType(El: TParamsExpr;
+  AContext: TConvertContext; ToBaseTypeData: TResElDataBaseType): TJSElement;
+var
+  to_bt: TResolverBaseType;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  NotEqual: TJSEqualityExpressionNE;
+  CondExpr: TJSConditionalExpression;
+  JSBaseType: TPas2jsBaseType;
+  Call: TJSCallExpression;
+  NotExpr: TJSUnaryNotExpression;
+  AddExpr: TJSAdditiveExpressionPlus;
+  JSBaseTypeData: TResElDataPas2JSBaseType;
+  TypeEl: TPasType;
+  C: TClass;
+
+  function IsParamPas2JSBaseType: boolean;
+  var
+    TypeEl: TPasType;
+  begin
+    if ParamResolved.BaseType<>btCustom then exit(false);
+    TypeEl:=ParamResolved.TypeEl;
+    if TypeEl.ClassType<>TPasUnresolvedSymbolRef then exit(false);
+    if not (TypeEl.CustomData is TResElDataPas2JSBaseType) then exit(false);
+    Result:=true;
+    JSBaseTypeData:=TResElDataPas2JSBaseType(TypeEl.CustomData);
+    JSBaseType:=JSBaseTypeData.JSBaseType;
+  end;
 
-Var
-  b,B2 : TJSBracketMemberExpression;
-  C : TJSCallExpression;
-  I : Integer;
-  E : TJSElement;
+begin
+  Result:=nil;
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
+  JSBaseTypeData:=nil;
+  JSBaseType:=pbtNone;
+
+  to_bt:=ToBaseTypeData.BaseType;
+  if to_bt in btAllJSInteger then
+    begin
+    if ParamResolved.BaseType in btAllJSInteger then
+      begin
+      // integer to integer -> value
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end
+    else if ParamResolved.BaseType in btAllJSBooleans then
+      begin
+      // boolean to integer -> value?1:0
+      Result:=ConvertElement(Param,AContext);
+      // Note: convert value first in case it raises an exception
+      CondExpr:=TJSConditionalExpression(CreateElement(TJSConditionalExpression,El));
+      CondExpr.A:=Result;
+      CondExpr.B:=CreateLiteralNumber(El,1);
+      CondExpr.C:=CreateLiteralNumber(El,0);
+      Result:=CondExpr;
+      exit;
+      end
+    else if IsParamPas2JSBaseType then
+      begin
+      if JSBaseType=pbtJSValue then
+        begin
+        // convert jsvalue to integer -> Math.floor(value)
+        Result:=ConvertElement(Param,AContext);
+        // Note: convert value first in case it raises an exception
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreateMemberExpression(['Math','floor']);
+        Call.AddArg(Result);
+        Result:=Call;
+        exit;
+        end;
+      end;
+    end
+  else if to_bt in btAllJSBooleans then
+    begin
+    if ParamResolved.BaseType in btAllJSBooleans then
+      begin
+      // boolean to boolean -> value
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end
+    else if ParamResolved.BaseType in btAllJSInteger then
+      begin
+      // integer to boolean -> value!=0
+      Result:=ConvertElement(Param,AContext);
+      // Note: convert value first in case it raises an exception
+      NotEqual:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,El));
+      NotEqual.A:=Result;
+      NotEqual.B:=CreateLiteralNumber(El,0);
+      Result:=NotEqual;
+      exit;
+      end
+    else if IsParamPas2JSBaseType then
+      begin
+      if JSBaseType=pbtJSValue then
+        begin
+        // convert jsvalue to boolean -> !(value==false)
+        Result:=ConvertElement(Param,AContext);
+        // Note: convert value first in case it raises an exception
+        NotExpr:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
+        NotExpr.A:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,El));
+        TJSEqualityExpressionEQ(NotExpr.A).A:=Result;
+        TJSEqualityExpressionEQ(NotExpr.A).B:=CreateLiteralBoolean(El,false);
+        Result:=NotExpr;
+        exit;
+        end;
+      end;
+    end
+  else if to_bt in btAllJSFloats then
+    begin
+    if ParamResolved.BaseType in (btAllJSFloats+btAllJSInteger) then
+      begin
+      // double to double -> value
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end
+    else if IsParamPas2JSBaseType then
+      begin
+      if JSBaseType=pbtJSValue then
+        begin
+        // convert jsvalue to double -> rtl.getNumber(value)
+        Result:=ConvertElement(Param,AContext);
+        // Note: convert value first in case it raises an exception
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetNumber]]);
+        Call.AddArg(Result);
+        Result:=Call;
+        exit;
+        end;
+      end;
+    end
+  else if to_bt in btAllJSStrings then
+    begin
+    if ParamResolved.BaseType in btAllJSStringAndChars then
+      begin
+      // string or char to string -> value
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end
+    else if IsParamPas2JSBaseType then
+      begin
+      if JSBaseType=pbtJSValue then
+        begin
+        // convert jsvalue to string -> ""+value
+        Result:=ConvertElement(Param,AContext);
+        // Note: convert value first in case it raises an exception
+        AddExpr:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
+        AddExpr.A:=CreateLiteralString(El,'');
+        AddExpr.B:=Result;
+        Result:=AddExpr;
+        exit;
+        end;
+      end;
+    end
+  else if to_bt=btChar then
+    begin
+    if ParamResolved.BaseType=btChar then
+      begin
+      // char to char
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end
+    else if IsParamPas2JSBaseType then
+      begin
+      if JSBaseType=pbtJSValue then
+        begin
+        // convert jsvalue to char -> rtl.getChar(value)
+        Result:=ConvertElement(Param,AContext);
+        // Note: convert value first in case it raises an exception
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetChar]]);
+        Call.AddArg(Result);
+        Result:=Call;
+        exit;
+        end;
+      end;
+    end
+  else if to_bt=btPointer then
+    begin
+    if IsParamPas2JSBaseType then
+      begin
+      if JSBaseType=pbtJSValue then
+        begin
+        // convert jsvalue to pointer -> pass through
+        Result:=ConvertElement(Param,AContext);
+        exit;
+        end;
+      end
+    else if ParamResolved.BaseType=btContext then
+      begin
+      // convert user type/value to pointer -> pass through
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end;
+    end
+  else if (to_bt=btCustom) and (ToBaseTypeData is TResElDataPas2JSBaseType) then
+    begin
+    JSBaseType:=TResElDataPas2JSBaseType(ToBaseTypeData).JSBaseType;
+    if JSBaseType=pbtJSValue then
+      begin
+      // type cast to jsvalue
+      Result:=ConvertElement(Param,AContext);
+      // Note: convert value first in case it raises an exception
+      if ParamResolved.BaseType=btContext then
+        begin
+        TypeEl:=AContext.Resolver.ResolveAliasType(ParamResolved.TypeEl);
+        C:=TypeEl.ClassType;
+        if C=TPasClassType then
+          begin
+          // TObject(vsvalue) -> rtl.getObject(vsvalue)
+          Call:=CreateCallExpression(El);
+          Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnGetObject]]);
+          Call.AddArg(Result);
+          Result:=Call;
+          end;
+        end;
+      exit;
+      end;
+    end;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertTypeCastToBaseType BaseTypeData=',AContext.Resolver.BaseTypeNames[to_bt],' ParamResolved=',GetResolverResultDbg(ParamResolved));
+  {$ENDIF}
+  RaiseNotSupported(El,AContext,20170325161150);
+end;
 
+function TPasToJSConverter.ConvertSetLiteral(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  Call: TJSCallExpression;
+  ArgContext: TConvertContext;
+
+  procedure AddArg(Expr: TPasExpr);
+  begin
+    Result:=CreateSetLiteralElement(Expr,ArgContext);
+    Call.AddArg(Result);
+  end;
+
+var
+  i: Integer;
+  ArgEl: TPasExpr;
 begin
-  Result:=Nil;
-  Case EL.Kind of
-  pekFuncParams :
+  if El.Kind<>pekSet then
+    RaiseInconsistency(20170209112737);
+  if AContext.Access<>caRead then
+    DoError(20170209112926,nCantWriteSetLiteral,sCantWriteSetLiteral,[],El);
+  if length(El.Params)=0 then
+    Result:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El))
+  else
+    begin
+    Result:=nil;
+    ArgContext:=AContext;
+    while ArgContext is TDotContext do
+      ArgContext:=ArgContext.Parent;
+    Call:=CreateCallExpression(El);
+    try
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Create]]);
+      for i:=0 to length(El.Params)-1 do
+        begin
+        ArgEl:=El.Params[i];
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.ConvertSetLiteral ',i,' El.Params[i]=',GetObjName(ArgEl));
+        {$ENDIF}
+        if (ArgEl.ClassType=TBinaryExpr) and (TBinaryExpr(ArgEl).Kind=pekRange) then
+          begin
+          // range -> add three parameters: null,left,right
+          Call.AddArg(CreateLiteralNull(ArgEl));
+          AddArg(TBinaryExpr(ArgEl).left);
+          AddArg(TBinaryExpr(ArgEl).right);
+          end
+        else
+          AddArg(ArgEl);
+        end;
+      Result:=Call;
+    finally
+      if Result=nil then
+        Call.Free;
+    end;
+    end;
+end;
+
+function TPasToJSConverter.ConvertOpenArrayParam(ElType: TPasType;
+  El: TParamsExpr; AContext: TConvertContext): TJSElement;
+var
+  ArrLit: TJSArrayLiteral;
+  i: Integer;
+  NestedElType: TPasType;
+  Param: TPasExpr;
+  JSParam: TJSElement;
+begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertOpenArrayParam ',GetObjName(ElType));
+  {$ENDIF}
+  Result:=nil;
+  try
+    NestedElType:=nil;
+    if ElType is TPasArrayType then
+      NestedElType:=TPasArrayType(ElType).ElType;
+    ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+    for i:=0 to length(El.Params)-1 do
+      begin
+      Param:=El.Params[i];
+      if (NestedElType<>nil)
+          and (Param is TParamsExpr) and (TParamsExpr(Param).Kind=pekSet) then
+        JSParam:=ConvertOpenArrayParam(NestedElType,TParamsExpr(Param),AContext)
+      else
+        JSParam:=ConvertElement(Param,AContext);
+      ArrLit.Elements.AddElement.Expr:=JSParam;
+      end;
+    Result:=ArrLit;
+  finally
+    if Result=nil then
+      ArrLit.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Length(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  Arg: TJSElement;
+  Param, RangeEl: TPasExpr;
+  ParamResolved, RangeResolved: TPasResolverResult;
+  Ranges: TPasExprArray;
+  Call: TJSCallExpression;
+  aMinValue, aMaxValue: int64;
+begin
+  Result:=nil;
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
+  if ParamResolved.BaseType=btContext then
+    begin
+    if ParamResolved.TypeEl is TPasArrayType then
+      begin
+      Ranges:=TPasArrayType(ParamResolved.TypeEl).Ranges;
+      if length(Ranges)>0 then
+        begin
+        // static array -> number literal
+        if length(Ranges)>1 then
+          RaiseNotSupported(El,AContext,20170223131042);
+        RangeEl:=Ranges[0];
+        AContext.Resolver.ComputeElement(RangeEl,RangeResolved,[rcType]);
+        ComputeRange(RangeResolved,AContext,aMinValue,aMaxValue,RangeEl);
+        Result:=CreateLiteralNumber(El,aMaxValue-aMinValue+1);
+        exit;
+        end
+      else
+        begin
+        // dynamic array -> rtl.length(array)
+        Result:=ConvertElement(El.Params[0],AContext);
+        // Note: convert param first, it may raise an exception
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
+        Call.AddArg(Result);
+        Result:=Call;
+        exit;
+        end;
+      end;
+    end;
+
+  // default: Param.length
+  Arg:=ConvertElement(Param,AContext);
+  Result:=CreateDotExpression(El,Arg,CreatePrimitiveDotExpr('length'));
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_SetLength(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// convert "SetLength(a,Len)" to "a = rtl.arraySetLength(a,Len)"
+var
+  Param0: TPasExpr;
+  ResolvedParam0: TPasResolverResult;
+  ArrayType: TPasArrayType;
+  Call: TJSCallExpression;
+  ValInit: TJSElement;
+  AssignContext: TAssignContext;
+  ElType: TPasType;
+begin
+  Result:=nil;
+  Param0:=El.Params[0];
+  if AContext.Access<>caRead then
+    RaiseInconsistency(20170213213621);
+  AContext.Resolver.ComputeElement(Param0,ResolvedParam0,[rcNoImplicitProc]);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasToJSConverter.ConvertBuiltInSetLength ',GetResolverResultDbg(ResolvedParam0));
+  {$ENDIF}
+  if ResolvedParam0.TypeEl is TPasArrayType then
+    begin
+    // SetLength(AnArray,newlength)
+    ArrayType:=TPasArrayType(ResolvedParam0.TypeEl);
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasToJSConverter.ConvertBuiltInSetLength array');
+    {$ENDIF}
+
+    // ->  AnArray = rtl.setArrayLength(AnArray,newlength,initvalue)
+    AssignContext:=TAssignContext.Create(El,nil,AContext);
+    try
+      AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
+      AssignContext.RightResolved:=ResolvedParam0;
+
+      // create right side
+      // rtl.setArrayLength()
+      Call:=CreateCallExpression(El);
+      AssignContext.RightSide:=Call;
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_SetLength]]);
+      // 1st param: AnArray
+      Call.AddArg(ConvertElement(Param0,AContext));
+      // 2nd param: newlength
+      Call.AddArg(ConvertElement(El.Params[1],AContext));
+      // 3rd param: default value
+      ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
+      if ElType.ClassType=TPasRecordType then
+        ValInit:=CreateReferencePathExpr(ElType,AContext)
+      else
+        ValInit:=CreateValInit(ElType,nil,Param0,AContext);
+      Call.AddArg(ValInit);
+
+      // create left side:  array =
+      Result:=CreateAssignStatement(Param0,AssignContext);
+    finally
+      AssignContext.RightSide.Free;
+      AssignContext.Free;
+    end;
+    end
+  else if ResolvedParam0.BaseType=btString then
     begin
-    C:=TJSCallExpression(CreateElement(TJSCallExpression,El));
+    // convert "SetLength(astring,NewLen);" to "astring = rtl.strSetLength(astring,NewLen);"
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasToJSConverter.ConvertBuiltInSetLength string');
+    {$ENDIF}
+    AssignContext:=TAssignContext.Create(El,nil,AContext);
     try
-      C.Expr:=ConvertElement(El.Value,AContext);
-      if (Length(EL.Params)>0) then
+      AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
+      AssignContext.RightResolved:=AssignContext.LeftResolved;
+
+      // create right side  rtl.strSetLength(aString,NewLen)
+      Call:=CreateCallExpression(El);
+      AssignContext.RightSide:=Call;
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnStringSetLength]]);
+      Call.AddArg(ConvertElement(Param0,AContext));
+      Call.AddArg(ConvertElement(El.Params[1],AContext));
+
+      Result:=CreateAssignStatement(Param0,AssignContext);
+    finally
+      AssignContext.RightSide.Free;
+      AssignContext.Free;
+    end;
+    end
+  else
+    RaiseNotSupported(El.Value,AContext,20170130141026,'setlength '+GetResolverResultDbg(ResolvedParam0));
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_ExcludeInclude(El: TParamsExpr;
+  AContext: TConvertContext; IsInclude: boolean): TJSElement;
+// convert "Include(aSet,Enum)" to "aSet=rtl.includeSet(aSet,Enum)"
+var
+  Call: TJSCallExpression;
+  Param0: TPasExpr;
+  AssignContext: TAssignContext;
+  FunName: String;
+begin
+  Result:=nil;
+  Param0:=El.Params[0];
+  AssignContext:=TAssignContext.Create(El,nil,AContext);
+  try
+    AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
+    AssignContext.RightResolved:=AssignContext.LeftResolved;
+
+    // create right side  rtl.includeSet(aSet,Enum)
+    Call:=CreateCallExpression(El);
+    AssignContext.RightSide:=Call;
+    if IsInclude then
+      FunName:=FBuiltInNames[pbifnSet_Include]
+    else
+      FunName:=FBuiltInNames[pbifnSet_Exclude];
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FunName]);
+    Call.AddArg(ConvertElement(Param0,AContext));
+    Call.AddArg(ConvertElement(El.Params[1],AContext));
+
+    Result:=CreateAssignStatement(Param0,AssignContext);
+  finally
+    AssignContext.RightSide.Free;
+    AssignContext.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltInContinue(El: TPasExpr;
+  AContext: TConvertContext): TJSElement;
+begin
+  if AContext=nil then;
+  Result:=TJSContinueStatement(CreateElement(TJSContinueStatement,El));
+end;
+
+function TPasToJSConverter.ConvertBuiltInBreak(El: TPasExpr;
+  AContext: TConvertContext): TJSElement;
+begin
+  if AContext=nil then;
+  Result:=TJSBreakStatement(CreateElement(TJSBreakStatement,El));
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Exit(El: TPasExpr;
+  AContext: TConvertContext): TJSElement;
+// convert "exit;" -> in a function: "return result;"  in a procedure: "return;"
+// convert "exit(param);" -> "return param;"
+var
+  ProcEl: TPasElement;
+begin
+  Result:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
+  if (El is TParamsExpr) and (length(TParamsExpr(El).Params)>0) then
+    begin
+    // with parameter. convert "exit(param);" -> "return param;"
+    TJSReturnStatement(Result).Expr:=ConvertExpression(TParamsExpr(El).Params[0],AContext);
+    end
+  else
+    begin
+    // without parameter.
+    ProcEl:=El.Parent;
+    while (ProcEl<>nil) and not (ProcEl is TPasProcedure) do
+      ProcEl:=ProcEl.Parent;
+    if ProcEl is TPasFunction then
+      // in a function, "return result;"
+      TJSReturnStatement(Result).Expr:=CreatePrimitiveDotExpr(ResolverResultVar)
+    else
+      ; // in a procedure, "return;" which means "return undefined;"
+    end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_IncDec(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+{ inc(a) or inc(a,b)
+ if a is a variable:
+   convert inc(a,b) to a+=b
+ if a is a var/out arg:
+   convert inc(a,b) to a.set(a.get+b)
+ if a is a property
+   Getter: field, procedure
+ if a is an indexed-property
+   Getter: field, procedure
+ if a is a property with index-specifier
+   Getter: field, procedure
+}
+var
+  AssignSt: TJSAssignStatement;
+  Expr: TPasExpr;
+  ExprResolved: TPasResolverResult;
+  ExprArg: TPasArgument;
+  ValueJS: TJSElement;
+  Call: TJSCallExpression;
+  IsInc: Boolean;
+  AddJS: TJSAdditiveExpression;
+begin
+  Result:=nil;
+  IsInc:=CompareText((El.Value as TPrimitiveExpr).Value,'inc')=0;
+  Expr:=El.Params[0];
+  AContext.Resolver.ComputeElement(Expr,ExprResolved,[]);
+
+  // convert value
+  if length(El.Params)=1 then
+    ValueJS:=CreateLiteralNumber(El,1)
+  else
+    ValueJS:=ConvertExpression(El.Params[1],AContext);
+
+  // check target variable
+  AssignSt:=nil;
+  Call:=nil;
+  try
+    if ExprResolved.IdentEl is TPasArgument then
+      begin
+      ExprArg:=TPasArgument(ExprResolved.IdentEl);
+      if ExprArg.Access in [argVar,argOut] then
         begin
-        C.Args:=TJSArguments(CreateElement(TJSArguments,El));
-        For I:=0 to Length(EL.Params)-1 do
+        // target variable is a reference
+        // -> convert inc(ref,b)  to  ref.set(ref.get()+b)
+        Call:=CreateCallExpression(El);
+        // create "ref.set"
+        Call.Expr:=CreateDotExpression(El,
+          CreateIdentifierExpr(ExprResolved.IdentEl,AContext),
+          CreatePrimitiveDotExpr(TempRefObjSetterName));
+        // create "+"
+        if IsInc then
+          AddJS:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El))
+        else
+          AddJS:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El));
+        Call.AddArg(AddJS);
+        // create "ref.get()"
+        AddJS.A:=TJSCallExpression(CreateElement(TJSCallExpression,El));
+        TJSCallExpression(AddJS.A).Expr:=CreateDotExpression(El,
+          CreateIdentifierExpr(ExprResolved.IdentEl,AContext),
+          CreatePrimitiveDotExpr(TempRefObjGetterName));
+        // add "b"
+        AddJS.B:=ValueJS;
+        ValueJS:=nil;
+
+        Result:=Call;
+        exit;
+        end;
+      end
+    else if ExprResolved.IdentEl is TPasProperty then
+      begin
+      RaiseNotSupported(Expr,AContext,20170501151316);
+      end;
+
+    // convert inc(avar,b)  to  a+=b
+    if IsInc then
+      AssignSt:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,El))
+    else
+      AssignSt:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,El));
+    AssignSt.LHS:=ConvertExpression(El.Params[0],AContext);
+    AssignSt.Expr:=ValueJS;
+    ValueJS:=nil;
+    Result:=AssignSt;
+  finally
+    ValueJS.Free;
+    if Result=nil then
+      begin
+      AssignSt.Free;
+      Call.Free;
+      end;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Assigned(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  NE: TJSEqualityExpressionNE;
+  Param: TPasExpr;
+  ParamResolved: TPasResolverResult;
+  C: TClass;
+  GT: TJSRelationalExpressionGT;
+  Call: TJSCallExpression;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170210105235);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProcType]);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertBuiltInAssigned ParamResolved=',GetResolverResultDbg(ParamResolved));
+  {$ENDIF}
+  if ParamResolved.BaseType=btPointer then
+    begin
+    // convert Assigned(value)  ->  value!=null
+    Result:=ConvertElement(Param,AContext);
+    // Note: convert Param first, it may raise an exception
+    NE:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,El));
+    NE.A:=Result;
+    NE.B:=CreateLiteralNull(El);
+    Result:=NE;
+    end
+  else if ParamResolved.BaseType=btContext then
+    begin
+    C:=ParamResolved.TypeEl.ClassType;
+    if (C=TPasClassType)
+        or (C=TPasClassOfType)
+        or C.InheritsFrom(TPasProcedureType) then
+      begin
+      // convert Assigned(value)  ->  value!=null
+      Result:=ConvertElement(Param,AContext);
+      // Note: convert Param first, it may raise an exception
+      NE:=TJSEqualityExpressionNE(CreateElement(TJSEqualityExpressionNE,El));
+      NE.A:=Result;
+      NE.B:=CreateLiteralNull(El);
+      Result:=NE;
+      end
+    else if C=TPasArrayType then
+      begin
+      // convert Assigned(value)  ->  rtl.length(value)>0
+      Result:=ConvertElement(Param,AContext);
+      // Note: convert Param first, it may raise an exception
+      GT:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El));
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
+      Call.AddArg(Result);
+      GT.A:=Call;
+      GT.B:=CreateLiteralNumber(El,0);
+      Result:=GT;
+      end
+    else
+      RaiseNotSupported(El,AContext,20170328124606);
+    end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Chr(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  ParamResolved: TPasResolverResult;
+  Param: TPasExpr;
+  Call: TJSCallExpression;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170325185847);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
+  if ParamResolved.BaseType in btAllJSInteger then
+    begin
+    // chr(integer) -> String.fromCharCode(integer)
+    Result:=ConvertElement(Param,AContext);
+    // Note: convert Param first, as it might raise an exception
+    Call:=CreateCallExpression(El);
+    Call.Expr:=CreateMemberExpression(['String','fromCharCode']);
+    Call.AddArg(Result);
+    Result:=Call;
+    exit;
+    end;
+  DoError(20170325185906,nExpectedXButFoundY,sExpectedXButFoundY,['integer',
+    AContext.Resolver.GetResolverResultDescription(ParamResolved)],Param);
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Ord(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  ParamResolved, SubParamResolved: TPasResolverResult;
+  Param, SubParam: TPasExpr;
+  Call: TJSCallExpression;
+  SubParams: TParamsExpr;
+  SubParamJS: TJSElement;
+  Minus: TJSAdditiveExpressionMinus;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170210105235);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ParamResolved,[]);
+  if ParamResolved.BaseType=btChar then
+    begin
+    if Param is TParamsExpr then
+      begin
+      SubParams:=TParamsExpr(Param);
+      if SubParams.Kind=pekArrayParams then
+        begin
+        // e.g. ord(something[index])
+        SubParam:=SubParams.Value;
+        AContext.Resolver.ComputeElement(SubParam,SubParamResolved,[]);
+        if SubParamResolved.BaseType in btAllJSStrings then
           begin
-          E:=ConvertElement(EL.Params[i]);
-          C.Args.Elements.AddElement.Expr:=E;
+          // e.g. ord(aString[index]) -> aString.charCodeAt(index-1)
+          SubParamJS:=ConvertElement(SubParam,AContext);
+          // Note: convert SubParam first, as it might raise an exception
+          Call:=nil;
+          try
+            Call:=CreateCallExpression(El);
+            Call.Expr:=CreateDotExpression(El,SubParamJS,CreatePrimitiveDotExpr('charCodeAt'));
+            Minus:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,Param));
+            Call.AddArg(Minus);
+            if length(SubParams.Params)<>1 then
+              RaiseInconsistency(20170405231706);
+            Minus.A:=ConvertElement(SubParams.Params[0],AContext);
+            Minus.B:=CreateLiteralNumber(Param,1);
+            Result:=Call;
+          finally
+            if Result=nil then
+              Call.Free;
+          end;
+          exit;
           end;
         end;
-    except
-      FreeAndNil(C);
-      Raise;
+      end;
+    // ord(aChar) -> aChar.charCodeAt()
+    Result:=ConvertElement(Param,AContext);
+    // Note: convert Param first, as it might raise an exception
+    Call:=CreateCallExpression(El);
+    Call.Expr:=CreateDotExpression(El,Result,CreatePrimitiveDotExpr('charCodeAt'));
+    Result:=Call;
+    exit;
+    end
+  else if ParamResolved.BaseType=btContext then
+    begin
+    if ParamResolved.TypeEl.ClassType=TPasEnumType then
+      begin
+      // ord(enum) -> enum
+      Result:=ConvertElement(Param,AContext);
+      exit;
+      end;
+    end;
+  DoError(20170210105339,nExpectedXButFoundY,sExpectedXButFoundY,['enum',
+    AContext.Resolver.GetResolverResultDescription(ParamResolved)],Param);
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Low(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// low(enumtype) -> first enumvalue
+// low(set var) -> first enumvalue
+// low(settype) -> first enumvalue
+// low(array var) -> first index
+
+  procedure CreateEnumValue(TypeEl: TPasEnumType);
+  var
+    EnumValue: TPasEnumValue;
+  begin
+    EnumValue:=TPasEnumValue(TypeEl.Values[0]);
+    Result:=CreateReferencePathExpr(EnumValue,AContext);
+  end;
+
+var
+  ResolvedEl, RangeResolved: TPasResolverResult;
+  Param: TPasExpr;
+  TypeEl: TPasType;
+  Ranges: TPasExprArray;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170210120659);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
+  case ResolvedEl.BaseType of
+    btContext:
+      begin
+      TypeEl:=ResolvedEl.TypeEl;
+      if TypeEl.ClassType=TPasEnumType then
+        begin
+        CreateEnumValue(TPasEnumType(TypeEl));
+        exit;
+        end
+      else if (TypeEl.ClassType=TPasSetType) then
+        begin
+        if TPasSetType(TypeEl).EnumType<>nil then
+          begin
+          TypeEl:=TPasSetType(TypeEl).EnumType;
+          CreateEnumValue(TPasEnumType(TypeEl));
+          exit;
+          end;
+        end
+      else if TypeEl.ClassType=TPasArrayType then
+        begin
+        Ranges:=TPasArrayType(TypeEl).Ranges;
+        if length(Ranges)=0 then
+          begin
+          Result:=CreateLiteralNumber(El,0);
+          exit;
+          end
+        else if length(Ranges)=1 then
+          begin
+          AContext.Resolver.ComputeElement(Ranges[0],RangeResolved,[rcConstant]);
+          if RangeResolved.BaseType=btContext then
+            begin
+            if RangeResolved.IdentEl is TPasEnumType then
+              begin
+              CreateEnumValue(TPasEnumType(RangeResolved.IdentEl));
+              exit;
+              end;
+            end
+          else if RangeResolved.BaseType=btBoolean then
+            begin
+            Result:=CreateLiteralBoolean(El,LowJSBoolean);
+            exit;
+            end;
+          end;
+        RaiseNotSupported(El,AContext,20170222231008);
+        end;
+      end;
+    btChar,
+    btAnsiChar,
+    btWideChar:
+      begin
+      Result:=CreateLiteralJSString(El,#0);
+      exit;
+      end;
+    btBoolean:
+      begin
+      Result:=CreateLiteralBoolean(El,LowJSBoolean);
+      exit;
+      end;
+    btSet:
+      begin
+      TypeEl:=ResolvedEl.TypeEl;
+      if TypeEl.ClassType=TPasEnumType then
+        begin
+        CreateEnumValue(TPasEnumType(TypeEl));
+        exit;
+        end;
+      end;
+  end;
+  DoError(20170210110717,nExpectedXButFoundY,sExpectedXButFoundY,['enum or array',
+    AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_High(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// high(enumtype) -> last enumvalue
+// high(set var) -> last enumvalue
+// high(settype) -> last enumvalue
+// high(dynamic array) -> array.length-1
+// high(static array) -> last index
+
+  procedure CreateEnumValue(TypeEl: TPasEnumType);
+  var
+    EnumValue: TPasEnumValue;
+  begin
+    EnumValue:=TPasEnumValue(TypeEl.Values[TypeEl.Values.Count-1]);
+    Result:=CreateReferencePathExpr(EnumValue,AContext);
+  end;
+
+var
+  ResolvedEl, RangeResolved: TPasResolverResult;
+  Param, Range: TPasExpr;
+  TypeEl: TPasType;
+  MinusExpr: TJSAdditiveExpressionMinus;
+  Call: TJSCallExpression;
+  aMinValue, aMaxValue: int64;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170210120653);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
+  case ResolvedEl.BaseType of
+    btContext:
+      begin
+      TypeEl:=ResolvedEl.TypeEl;
+      if TypeEl.ClassType=TPasEnumType then
+        begin
+        CreateEnumValue(TPasEnumType(TypeEl));
+        exit;
+        end
+      else if (TypeEl.ClassType=TPasSetType) then
+        begin
+        if TPasSetType(TypeEl).EnumType<>nil then
+          begin
+          TypeEl:=TPasSetType(TypeEl).EnumType;
+          CreateEnumValue(TPasEnumType(TypeEl));
+          exit;
+          end;
+        end
+      else if TypeEl.ClassType=TPasArrayType then
+        begin
+        if length(TPasArrayType(TypeEl).Ranges)=0 then
+          begin
+          // dynamic array -> rtl.length(Param)-1
+          Result:=ConvertElement(Param,AContext);
+          // Note: convert Param first, it may raise an exception
+          Call:=CreateCallExpression(El);
+          Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
+          Call.AddArg(Result);
+          MinusExpr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El));
+          MinusExpr.A:=Call;
+          MinusExpr.B:=CreateLiteralNumber(El,1);
+          Result:=MinusExpr;
+          exit;
+          end
+        else if length(TPasArrayType(TypeEl).Ranges)=1 then
+          begin
+          // static array
+          Range:=TPasArrayType(TypeEl).Ranges[0];
+          AContext.Resolver.ComputeElement(Range,RangeResolved,[rcConstant]);
+          if RangeResolved.BaseType=btContext then
+            begin
+            if RangeResolved.IdentEl is TPasEnumType then
+              begin
+              CreateEnumValue(TPasEnumType(RangeResolved.IdentEl));
+              exit;
+              end;
+            end
+          else if RangeResolved.BaseType=btBoolean then
+            begin
+            Result:=CreateLiteralBoolean(Param,HighJSBoolean);
+            exit;
+            end
+          else if RangeResolved.BaseType in btAllJSInteger then
+            begin
+            ComputeRange(RangeResolved,AContext,aMinValue,aMaxValue,Range);
+            Result:=CreateLiteralNumber(Param,aMaxValue);
+            exit;
+            end;
+          end;
+        RaiseNotSupported(El,AContext,20170222231101);
+        end;
+      end;
+    btBoolean:
+      begin
+      Result:=CreateLiteralBoolean(Param,HighJSBoolean);
+      exit;
+      end;
+    btSet:
+      begin
+      TypeEl:=ResolvedEl.TypeEl;
+      if TypeEl.ClassType=TPasEnumType then
+        begin
+        CreateEnumValue(TPasEnumType(TypeEl));
+        exit;
+        end;
+      end;
+  end;
+  DoError(20170210114139,nExpectedXButFoundY,sExpectedXButFoundY,['enum or array',
+    AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Pred(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// pred(enumvalue) -> enumvalue-1
+var
+  ResolvedEl: TPasResolverResult;
+  Param: TPasExpr;
+  V: TJSElement;
+  Expr: TJSAdditiveExpressionMinus;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170210120648);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
+  if (ResolvedEl.BaseType=btContext)
+      and (ResolvedEl.TypeEl.ClassType=TPasEnumType) then
+    begin
+    V:=ConvertElement(Param,AContext);
+    Expr:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,El));
+    Expr.A:=V;
+    Expr.B:=CreateLiteralNumber(El,1);
+    Result:=Expr;
+    exit;
     end;
-    Result:=C;
+  DoError(20170210120039,nExpectedXButFoundY,sExpectedXButFoundY,['enum',
+    AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_Succ(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// succ(enumvalue) -> enumvalue+1
+var
+  ResolvedEl: TPasResolverResult;
+  Param: TPasExpr;
+  V: TJSElement;
+  Expr: TJSAdditiveExpressionPlus;
+begin
+  Result:=nil;
+  if AContext.Resolver=nil then
+    RaiseInconsistency(20170210120645);
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ResolvedEl,[]);
+  if (ResolvedEl.BaseType=btContext)
+      and (ResolvedEl.TypeEl.ClassType=TPasEnumType) then
+    begin
+    V:=ConvertElement(Param,AContext);
+    Expr:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
+    Expr.A:=V;
+    Expr.B:=CreateLiteralNumber(El,1);
+    Result:=Expr;
+    exit;
     end;
-  pekArrayParams:
+  DoError(20170210120626,nExpectedXButFoundY,sExpectedXButFoundY,['enum',
+    AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_StrProc(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// convert 'str(value,aString)' to 'aString = <string>'
+// for the conversion see ConvertBuiltInStrFunc
+var
+  AssignContext: TAssignContext;
+  StrVar: TPasExpr;
+begin
+  Result:=nil;
+  AssignContext:=TAssignContext.Create(El,nil,AContext);
+  try
+    StrVar:=El.Params[1];
+    AContext.Resolver.ComputeElement(StrVar,AssignContext.LeftResolved,[rcNoImplicitProc]);
+
+    // create right side
+    AssignContext.RightSide:=ConvertBuiltInStrParam(El.Params[0],AContext,false,true);
+    SetResolverValueExpr(AssignContext.RightResolved,btString,
+      AContext.Resolver.BaseTypes[btString],El,[rrfReadable]);
+
+    // create 'StrVar = rightside'
+    Result:=CreateAssignStatement(StrVar,AssignContext);
+  finally
+    AssignContext.RightSide.Free;
+    AssignContext.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_StrFunc(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// convert 'str(boolean)' to '""+boolean'
+// convert 'str(integer)' to '""+integer'
+// convert 'str(float)' to '""+float'
+// convert 'str(float:width)' to rtl.spaceLeft('""+float,width)'
+// convert 'str(float:width:precision)' to 'rtl.spaceLeft(float.toFixed(precision),width)'
+var
+  i: Integer;
+  Param: TPasExpr;
+  Sum, Add: TJSElement;
+  AddEl: TJSAdditiveExpressionPlus;
+begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertBuiltInStrFunc Count=',length(El.Params));
+  {$ENDIF}
+  Result:=nil;
+  Sum:=nil;
+  Add:=nil;
+  try
+    for i:=0 to length(El.Params)-1 do
+      begin
+      Param:=El.Params[i];
+      Add:=ConvertBuiltInStrParam(Param,AContext,true,i=0);
+      if Sum=nil then
+        Sum:=Add
+      else
+        begin
+        AddEl:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,Param));
+        AddEl.A:=Sum;
+        AddEl.B:=Add;
+        Sum:=AddEl;
+        end;
+      Add:=nil;
+      end;
+    Result:=Sum;
+  finally
+    Add.Free;
+    if Result=nil then
+      Sum.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltInStrParam(El: TPasExpr;
+  AContext: TConvertContext; IsStrFunc, IsFirst: boolean): TJSElement;
+var
+  ResolvedEl: TPasResolverResult;
+  NeedStrLit: Boolean;
+  Add: TJSElement;
+  Call: TJSCallExpression;
+  PlusEl: TJSAdditiveExpressionPlus;
+  Bracket: TJSBracketMemberExpression;
+  procedure PrependStrLit;
+  begin
+    PlusEl:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,El));
+    PlusEl.A:=CreateLiteralString(El,'');
+    PlusEl.B:=Add;
+    Add:=PlusEl;
+  end;
+
+begin
+  Result:=nil;
+  AContext.Resolver.ComputeElement(El,ResolvedEl,[]);
+  Add:=nil;
+  Call:=nil;
+  Bracket:=nil;
+  try
+    NeedStrLit:=false;
+    if ResolvedEl.BaseType in (btAllJSBooleans+btAllJSInteger) then
+      begin
+      NeedStrLit:=true;
+      Add:=ConvertElement(El,AContext);
+      end
+    else if ResolvedEl.BaseType in btAllJSFloats then
+      begin
+      NeedStrLit:=true;
+      Add:=ConvertElement(El,AContext);
+      if El.format2<>nil then
+        begin
+        // precision -> rtl El.toFixed(precision);
+        NeedStrLit:=false;
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreateDotExpression(El,Add,CreatePrimitiveDotExpr('toFixed'));
+        Call.AddArg(ConvertElement(El.format2,AContext));
+        Add:=Call;
+        Call:=nil;
+        end;
+      end
+    else if IsStrFunc and (ResolvedEl.BaseType in btAllJSStringAndChars) then
+      Add:=ConvertElement(El,AContext)
+    else if ResolvedEl.BaseType=btContext then
+      begin
+      if ResolvedEl.TypeEl.ClassType=TPasEnumType then
+        begin
+        // create enumtype[enumvalue]
+        Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+        Bracket.MExpr:=CreateReferencePathExpr(TPasEnumType(ResolvedEl.TypeEl),AContext);
+        Bracket.Name:=ConvertElement(El,AContext);
+        Add:=Bracket;
+        Bracket:=nil;
+        end
+      else
+        RaiseNotSupported(El,AContext,20170320123827);
+      end
+    else
+      RaiseNotSupported(El,AContext,20170320093001);
+
+    if El.format1<>nil then
+      begin
+      // width -> leading spaces
+      if NeedStrLit then
+        PrependStrLit;
+      // create 'rtl.spaceLeft(add,width)'
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSpaceLeft]]);
+      Call.AddArg(Add);
+      Add:=nil;
+      Call.AddArg(ConvertElement(El.format1,AContext));
+      Add:=Call;
+      Call:=nil;
+      end
+    else if IsFirst and NeedStrLit then
+      PrependStrLit;
+    Result:=Add;
+  finally
+    Call.Free;
+    Bracket.Free;
+    if Result=nil then
+      Add.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_ConcatArray(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// concat(array1, array2)
+var
+  Param0Resolved, ElTypeResolved: TPasResolverResult;
+  Param0: TPasExpr;
+  ArrayType: TPasArrayType;
+  Call: TJSCallExpression;
+  i: Integer;
+begin
+  if length(El.Params)<1 then
+    RaiseInconsistency(20170331000332);
+  if length(El.Params)=1 then
     begin
-    if Length(EL.Params)<>1 then
-      Raise EPasToJS.Create('Only 1-dimensional expressions allowed at this point');
-    B:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));;
-    B.Mexpr:=ConvertElement(El.Value,AContext);
-    Result:=B;
-    B.Name:=ConvertElement(EL.Params[0],AContext);
+    // concat(array1)  ->  array1
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.ConvertBuiltInConcatArray Count=',length(El.Params));
+    {$ENDIF}
+    Result:=ConvertElement(El.Params[0],AContext);
     end
+  else
+    begin
+    // concat(array1,array2,...)
+    Param0:=El.Params[0];
+    AContext.Resolver.ComputeElement(Param0,Param0Resolved,[]);
+    if Param0Resolved.BaseType<>btContext then
+      RaiseNotSupported(Param0,AContext,20170331000819);
+    if Param0Resolved.TypeEl.ClassType<>TPasArrayType then
+      RaiseNotSupported(Param0,AContext,20170331000846);
+    ArrayType:=TPasArrayType(Param0Resolved.TypeEl);
+    if length(ArrayType.Ranges)>0 then
+      RaiseNotSupported(Param0,AContext,20170331001021);
+    AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
+    Call:=CreateCallExpression(El);
+    try
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertBuiltInConcatArray Count=',length(El.Params),' ElType=',GetResolverResultDbg(ElTypeResolved));
+      {$ENDIF}
+      if ElTypeResolved.BaseType=btContext then
+        begin
+        if ElTypeResolved.TypeEl.ClassType=TPasRecordType then
+          begin
+          // record: rtl.arrayConcat(RecordType,array1,array2,...)
+          Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Concat]]);
+          Call.AddArg(CreateReferencePathExpr(ElTypeResolved.TypeEl,AContext));
+          end;
+        end
+      else if ElTypeResolved.BaseType=btSet then
+        begin
+        // set: rtl.arrayConcat("refSet",array1,array2,...)
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Concat]]);
+        Call.AddArg(CreateLiteralString(El,FBuiltInNames[pbifnSet_Reference]));
+        end;
+      if Call.Expr=nil then
+        // default: array1.concat(array2,...)
+        Call.Expr:=CreateDotExpression(El,ConvertElement(Param0,AContext),
+                                     CreatePrimitiveDotExpr('concat'));
+      for i:=1 to length(El.Params)-1 do
+        Call.AddArg(ConvertElement(El.Params[i],AContext));
+      Result:=Call;
+    finally
+      if Result=nil then
+        Call.Free;
+    end;
+    end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_CopyArray(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  Param: TPasExpr;
+  ParamResolved, ElTypeResolved: TPasResolverResult;
+  C: TClass;
+  TypeParam: TJSElement;
+  Call: TJSCallExpression;
+  ArrayType: TPasArrayType;
+begin
+  Result:=nil;
+  Call:=nil;
+  try
+    Param:=El.Params[0];
+    AContext.Resolver.ComputeElement(El,ParamResolved,[]);
+    if ParamResolved.BaseType<>btContext then
+      RaiseInconsistency(20170401003242);
+    if ParamResolved.TypeEl.ClassType<>TPasArrayType then
+      RaiseInconsistency(20170401003256);
+    ArrayType:=TPasArrayType(ParamResolved.TypeEl);
+    AContext.Resolver.ComputeElement(ArrayType.ElType,ElTypeResolved,[rcType]);
+    // rtl.arrayCopy(type,src,start,count)
+    TypeParam:=nil;
+    if ElTypeResolved.BaseType=btContext then
+      begin
+      C:=ElTypeResolved.TypeEl.ClassType;
+      if C=TPasRecordType then
+        TypeParam:=CreateReferencePathExpr(TPasRecordType(ElTypeResolved.TypeEl),AContext);
+      end
+    else if ElTypeResolved.BaseType=btSet then
+      TypeParam:=CreateLiteralString(El,FBuiltInNames[pbifnSet_Reference]);
+    if TypeParam=nil then
+      TypeParam:=CreateLiteralNumber(El,0);
+    Call:=CreateCallExpression(El);
+    // rtl.arrayCopy
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Copy]]);
+    // param: type
+    Call.AddArg(TypeParam);
+    // param: src
+    Call.AddArg(ConvertElement(Param,AContext));
+    // param: start
+    if length(El.Params)=1 then
+      Call.AddArg(CreateLiteralNumber(El,0))
+    else
+      Call.AddArg(ConvertElement(El.Params[1],AContext));
+    // param: count
+    if length(El.Params)>=3 then
+      Call.AddArg(ConvertElement(El.Params[2],AContext));
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
   end;
+
+  if El=nil then ;
+  if AContext=nil then;
 end;
 
-Function TPasToJSConverter.ConvertRecordValues(El: TRecordValues; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertBuiltIn_InsertArray(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// procedure insert(item,var array,const position)
+// ->  array.splice(position,1,item);
+var
+  ArrEl: TJSElement;
+  Call: TJSCallExpression;
+begin
+  Result:=nil;
+  Call:=nil;
+  try
+    Call:=CreateCallExpression(El);
+    ArrEl:=ConvertElement(El.Params[1],AContext);
+    Call.Expr:=CreateDotExpression(El,ArrEl,CreatePrimitiveDotExpr('splice'));
+    Call.AddArg(ConvertElement(El.Params[2],AContext));
+    Call.AddArg(CreateLiteralNumber(El,1));
+    Call.AddArg(ConvertElement(El.Params[0],AContext));
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_DeleteArray(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+// proc delete(var array,const start,count)
+// ->  array.splice(start,count)
+var
+  ArrEl: TJSElement;
+  Call: TJSCallExpression;
+begin
+  Result:=nil;
+  Call:=nil;
+  try
+    Call:=CreateCallExpression(El);
+    ArrEl:=ConvertElement(El.Params[0],AContext);
+    Call.Expr:=CreateDotExpression(El,ArrEl,CreatePrimitiveDotExpr('splice'));
+    Call.AddArg(ConvertElement(El.Params[1],AContext));
+    Call.AddArg(ConvertElement(El.Params[2],AContext));
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertBuiltIn_TypeInfo(El: TParamsExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  ParamResolved: TPasResolverResult;
+  Param: TPasExpr;
+  ResultEl: TPasResultElement;
+  TypeEl: TPasType;
+begin
+  Result:=nil;
+  Param:=El.Params[0];
+  AContext.Resolver.ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertBuiltIn_TypeInfo ',GetResolverResultDbg(ParamResolved));
+  {$ENDIF}
+  if (ParamResolved.BaseType=btProc) and (ParamResolved.IdentEl is TPasFunction) then
+    begin
+    // typeinfo(function) ->
+    ResultEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl;
+    AContext.Resolver.ComputeElement(ResultEl.ResultType,ParamResolved,[rcNoImplicitProc]);
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.ConvertBuiltIn_TypeInfo FuncResult=',GetResolverResultDbg(ParamResolved));
+    {$ENDIF}
+    Include(ParamResolved.Flags,rrfReadable);
+    ParamResolved.IdentEl:=ResultEl;
+    end;
+  TypeEl:=AContext.Resolver.ResolveAliasType(ParamResolved.TypeEl);
+  if TypeEl=nil then
+    RaiseNotSupported(El,AContext,20170413001544)
+  else if ParamResolved.IdentEl is TPasType then
+    Result:=CreateTypeInfoRef(TPasType(ParamResolved.IdentEl),AContext,Param)
+  else if (rrfReadable in ParamResolved.Flags)
+      and ((TypeEl.ClassType=TPasClassType)
+        or (TypeEl.ClassType=TPasClassOfType))
+      and ((ParamResolved.IdentEl is TPasVariable)
+        or (ParamResolved.IdentEl.ClassType=TPasArgument)
+        or (ParamResolved.IdentEl.ClassType=TPasResultElement)) then
+    begin
+    // typeinfo(classinstance) -> classinstance.$rtti
+    // typeinfo(classof) -> classof.$rtti
+    Result:=ConvertElement(Param,AContext);
+    Result:=CreateDotExpression(El,Result,CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTTI]));
+    end
+  else
+    Result:=CreateTypeInfoRef(TypeEl,AContext,Param);
+end;
+
+function TPasToJSConverter.ConvertRecordValues(El: TRecordValues;
+  AContext: TConvertContext): TJSElement;
 
 Var
   R :  TJSObjectLiteral;
@@ -594,13 +7186,14 @@ begin
     begin
     it:=El.Fields[i];
     Rel:=R.Elements.AddElement;
-    Rel.Name:=it.Name;
+    Rel.Name:=TJSString(it.Name);
     Rel.Expr:=ConvertElement(it.ValueExp,AContext);
     end;
   Result:=R;
 end;
 
-Function TPasToJSConverter.ConvertArrayValues(El: TArrayValues; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertArrayValues(El: TArrayValues;
+  AContext: TConvertContext): TJSElement;
 
 Var
   R :  TJSArrayLiteral;
@@ -618,302 +7211,1293 @@ begin
   Result:=R;
 end;
 
-Function TPasToJSConverter.ConvertExpression(El: TPasExpr; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertExpression(El: TPasExpr;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertExpression El=',GetObjName(El),' Context=',GetObjName(AContext));
+  {$ENDIF}
   Result:=Nil;
-  if (El is TUnaryExpr) then
+  if (El.ClassType=TUnaryExpr) then
     Result:=ConvertUnaryExpression(TUnaryExpr(El),AContext)
-  else if (El is TBinaryExpr) then
+  else if (El.ClassType=TBinaryExpr) then
     Result:=ConvertBinaryExpression(TBinaryExpr(El),AContext)
-  else if (El is TPrimitiveExpr) then
+  else if (El.ClassType=TPrimitiveExpr) then
     Result:=ConvertPrimitiveExpression(TPrimitiveExpr(El),AContext)
-  else if (El is TBoolConstExpr) then
+  else if (El.ClassType=TBoolConstExpr) then
     Result:=ConvertBoolConstExpression(TBoolConstExpr(El),AContext)
-  else if (El is TNilExpr) then
+  else if (El.ClassType=TNilExpr) then
     Result:=ConvertNilExpr(TNilExpr(El),AContext)
-  else if (El is TInheritedExpr) then
+  else if (El.ClassType=TInheritedExpr) then
     Result:=ConvertInheritedExpression(TInheritedExpr(El),AContext)
-  else if (El is TSelfExpr) then
+  else if (El.ClassType=TSelfExpr) then
     Result:=ConvertSelfExpression(TSelfExpr(El),AContext)
-  else if (El is TParamsExpr) then
+  else if (El.ClassType=TParamsExpr) then
     Result:=ConvertParamsExpression(TParamsExpr(El),AContext)
-  else if (El is TRecordValues) then
-    Result:=ConvertRecordValues(TRecordValues(El),AContext)
-  else if (El is TRecordValues) then
+  else if (El.ClassType=TRecordValues) then
     Result:=ConvertRecordValues(TRecordValues(El),AContext)
   else
-    DoError(SErrUNknownExpressionClass,[EL.ClassName])
+    RaiseNotSupported(El,AContext,20161024191314);
 end;
 
-Function TPasToJSConverter.CreateConstDecl(El: TPasElement; AContext : TConvertContext): TJSElement;
-
-Var
-  C : TJSElement;
-  V : TJSVariableStatement;
-
+function TPasToJSConverter.CreatePrimitiveDotExpr(AName: string;
+  Src: TPasElement): TJSElement;
+var
+  p: Integer;
+  DotExpr: TJSDotMemberExpression;
+  Ident: TJSPrimaryExpressionIdent;
 begin
-  C:=ConvertElement(El,AContext);
-  V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
-  V.A:=C;
-  Result:=V;
+  if AName='' then
+    RaiseInconsistency(20170402230134);
+  p:=PosLast('.',AName);
+  if p>0 then
+    begin
+    if Src<>nil then
+      DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,Src))
+    else
+      DotExpr:=TJSDotMemberExpression.Create(0,0);
+    DotExpr.Name:=TJSString(copy(AName,p+1,length(AName))); // do not lowercase
+    DotExpr.MExpr:=CreatePrimitiveDotExpr(LeftStr(AName,p-1));
+    Result:=DotExpr;
+    end
+  else
+    begin
+    if Src<>nil then
+      Ident:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,Src))
+    else
+      Ident:=TJSPrimaryExpressionIdent.Create(0,0);
+    Ident.Name:=TJSString(AName); // do not lowercase
+    Result:=Ident;
+    end;
 end;
 
-Function TPasToJSConverter.CreateTypeDecl(El: TPasElement; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.CreateTypeDecl(El: TPasType;
+  AContext: TConvertContext): TJSElement;
 
+var
+  ElClass: TClass;
 begin
   Result:=Nil;
-  if (El is TPasClassType) then
-    Result := convertclassType(TPasClassType(El), AContext);
-  // Need to do something for classes and records.
+  ElClass:=El.ClassType;
+  if ElClass=TPasClassType then
+    Result := ConvertClassType(TPasClassType(El), AContext)
+  else if (ElClass=TPasClassOfType) then
+    Result := ConvertClassOfType(TPasClassOfType(El), AContext)
+  else if ElClass=TPasRecordType then
+    Result := ConvertRecordType(TPasRecordType(El), AContext)
+  else if ElClass=TPasEnumType then
+    Result := ConvertEnumType(TPasEnumType(El), AContext)
+  else if (ElClass=TPasSetType) then
+    Result := ConvertSetType(TPasSetType(El), AContext)
+  else if (ElClass=TPasAliasType) then
+  else if (ElClass=TPasPointerType) then
+    Result:=ConvertPointerType(TPasPointerType(El),AContext)
+  else if (ElClass=TPasProcedureType)
+       or (ElClass=TPasFunctionType) then
+    Result:=ConvertProcedureType(TPasProcedureType(El),AContext)
+  else if (ElClass=TPasArrayType) then
+    Result:=ConvertArrayType(TPasArrayType(El),AContext)
+  else
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.CreateTypeDecl El=',GetObjName(El));
+    {$ENDIF}
+    RaiseNotSupported(El,AContext,20170208144053);
+    end;
 end;
 
-Function TPasToJSConverter.CreateVarDecl(El: TPasElement; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.CreateVarDecl(El: TPasVariable;
+  AContext: TConvertContext): TJSElement;
 
 Var
   C : TJSElement;
   V : TJSVariableStatement;
+  AssignSt: TJSSimpleAssignStatement;
+  Obj: TJSObjectLiteral;
+  ObjLit: TJSObjectLiteralElement;
+begin
+  Result:=nil;
+  if vmExternal in El.VarModifiers then
+    begin
+    // external: do not add a declaration
+    exit;
+    end;
+  if AContext is TObjectContext then
+    begin
+    // create 'A: initvalue'
+    Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
+    ObjLit:=Obj.Elements.AddElement;
+    ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
+    ObjLit.Expr:=CreateVarInit(El,AContext);
+    end
+  else if AContext.IsGlobal then
+    begin
+    // create 'this.A=initvalue'
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    Result:=AssignSt;
+    AssignSt.LHS:=CreateSubDeclNameExpr(El,El.Name,AContext);
+    AssignSt.Expr:=CreateVarInit(El,AContext);
+    end
+  else
+    begin
+    // create 'var A=initvalue'
+    C:=ConvertVariable(El,AContext);
+    V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
+    V.A:=C;
+    Result:=V;
+    end;
+end;
 
+function TPasToJSConverter.CreateSwitchStatement(El: TPasImplCaseOf;
+  AContext: TConvertContext): TJSElement;
+var
+  SwitchEl: TJSSwitchStatement;
+  JSCaseEl: TJSCaseElement;
+  SubEl: TPasImplElement;
+  St: TPasImplCaseStatement;
+  ok: Boolean;
+  i, j: Integer;
+  BreakSt: TJSBreakStatement;
+  BodySt: TJSElement;
+  StList: TJSStatementList;
+  Expr: TPasExpr;
 begin
-  C:=ConvertElement(El,AContext);
-  V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
-  V.A:=C;
-  Result:=V;
+  Result:=nil;
+  SwitchEl:=TJSSwitchStatement(CreateElement(TJSSwitchStatement,El));
+  ok:=false;
+  try
+    SwitchEl.Cond:=ConvertExpression(El.CaseExpr,AContext);
+    for i:=0 to El.Elements.Count-1 do
+      begin
+      SubEl:=TPasImplElement(El.Elements[i]);
+      if not (SubEl is TPasImplCaseStatement) then
+        continue;
+      St:=TPasImplCaseStatement(SubEl);
+      JSCaseEl:=nil;
+      for j:=0 to St.Expressions.Count-1 do
+        begin
+        Expr:=TPasExpr(St.Expressions[j]);
+        JSCaseEl:=SwitchEl.Cases.AddCase;
+        JSCaseEl.Expr:=ConvertExpression(Expr,AContext);
+        end;
+      BodySt:=nil;
+      if St.Body<>nil then
+        BodySt:=ConvertElement(St.Body,AContext);
+      // add break
+      BreakSt:=TJSBreakStatement(CreateElement(TJSBreakStatement,St));
+      if BodySt=nil then
+        // no Pascal statement -> add only one 'break;'
+        BodySt:=BreakSt
+      else
+        begin
+        if (BodySt is TJSStatementList) then
+          begin
+          // list of statements -> append 'break;' to end
+          StList:=TJSStatementList(BodySt);
+          AddToStatementList(TJSStatementList(BodySt),StList,BreakSt,St);
+          end
+        else
+          begin
+          // single statement -> create list of old and 'break;'
+          StList:=TJSStatementList(CreateElement(TJSStatementList,St));
+          StList.A:=BodySt;
+          StList.B:=BreakSt;
+          BodySt:=StList;
+          end;
+        end;
+      JSCaseEl.Body:=BodySt;
+      end;
+    if El.ElseBranch<>nil then
+      begin
+      JSCaseEl:=SwitchEl.Cases.AddCase;
+      JSCaseEl.Body:=ConvertImplBlockElements(El.ElseBranch,AContext,false);
+      SwitchEl.TheDefault:=JSCaseEl;
+      end;
+    ok:=true;
+  finally
+    if not ok then
+      SwitchEl.Free;
+  end;
+  Result:=SwitchEl;
 end;
 
-Function TPasToJSConverter.ConvertDeclarations(El: TPasDeclarations; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertDeclarations(El: TPasDeclarations;
+  AContext: TConvertContext): TJSElement;
 
 Var
-  P : TPasElement;
-  SL,SL2 : TJSStatementList;
   E : TJSElement;
+  SLFirst, SLLast: TJSStatementList;
+  P: TPasElement;
+  IsProcBody, IsFunction, IsAssembler: boolean;
   I : Integer;
+  PasProc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+  ProcBody: TPasImplBlock;
 
-  Procedure AddToSL;
-
+  Procedure Add(NewEl: TJSElement);
   begin
-    if Assigned(E) then
+    if AContext is TObjectContext then
       begin
-      if Assigned(SL.A) then
-        begin
-        SL2:=TJSStatementList(CreateElement(TJSStatementList,El));
-        SL.B:=SL2;
-        SL:=SL2;
-        end;
-      SL.A:=E;
+      // NewEl is already added
+      end
+    else
+      begin
+      AddToStatementList(SLFirst,SLLast,NewEl,El);
+      ConvertDeclarations:=SLFirst;
       end;
   end;
 
+  Procedure AddFunctionResultInit;
+  var
+    VarSt: TJSVariableStatement;
+    PasFun: TPasFunction;
+    FunType: TPasFunctionType;
+    ResultEl: TPasResultElement;
+  begin
+    PasFun:=El.Parent as TPasFunction;
+    FunType:=PasFun.FuncType;
+    ResultEl:=FunType.ResultEl;
+
+    // add 'var result=initvalue'
+    VarSt:=CreateVarStatement(ResolverResultVar,CreateValInit(ResultEl.ResultType,nil,El,aContext),El);
+    Add(VarSt);
+    Result:=SLFirst;
+  end;
+
+  Procedure AddFunctionResultReturn;
+  var
+    RetSt: TJSReturnStatement;
+  begin
+    RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
+    RetSt.Expr:=CreatePrimitiveDotExpr(ResolverResultVar);
+    Add(RetSt);
+  end;
+
 begin
-  SL:=TJSStatementList(CreateElement(TJSStatementList,El));
-  Result:=SL;
+  Result:=nil;
+  {
+    TPasDeclarations = class(TPasElement)
+    TPasSection = class(TPasDeclarations)
+    TInterfaceSection = class(TPasSection)
+    TImplementationSection = class(TPasSection)
+    TProgramSection = class(TImplementationSection)
+    TLibrarySection = class(TImplementationSection)
+    TProcedureBody = class(TPasDeclarations)
+  }
+
+  SLFirst:=nil;
+  SLLast:=nil;
+  IsProcBody:=(El is TProcedureBody) and (TProcedureBody(El).Body<>nil);
+  IsFunction:=IsProcBody and (El.Parent is TPasFunction);
+  IsAssembler:=IsProcBody and (TProcedureBody(El).Body is TPasImplAsmStatement);
+
+  if IsFunction and not IsAssembler then
+    AddFunctionResultInit;
+
   For I:=0 to El.Declarations.Count-1 do
     begin
-    E:=Nil;
     P:=TPasElement(El.Declarations[i]);
-    if P is TPasConst then
-      E:=CreateConstDecl(P,AContext)
-    else if P is TPasVariable then
-      E:=CreateVarDecl(P,AContext)
+    {$IFDEF VerbosePas2JS}
+    //writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
+    {$ENDIF}
+    if not IsElementUsed(P) then continue;
+
+    E:=Nil;
+    if P.ClassType=TPasConst then
+      E:=ConvertConst(TPasConst(P),aContext) // can be nil
+    else if P.ClassType=TPasVariable then
+      E:=CreateVarDecl(TPasVariable(P),aContext) // can be nil
     else if P is TPasType then
-      E:=CreateTypeDecl(P,AContext)
+      E:=CreateTypeDecl(TPasType(P),aContext) // can be nil
     else if P is TPasProcedure then
-      E:=ConvertElement(P as TPasProcedure,AContext)
-    else
-      DoError('Unknown class: "%s" ',[P.ClassName]);
-    if (Pos('.', P.Name) > 0) then
-      Addproceduretoclass(TJSStatementList(Result), E, P as TPasProcedure)
+      begin
+      PasProc:=TPasProcedure(P);
+      if PasProc.IsForward then continue; // JavaScript does not need the forward
+      ProcScope:=TPasProcedureScope(PasProc.CustomData);
+      if (ProcScope.DeclarationProc<>nil)
+          and (not ProcScope.DeclarationProc.IsForward) then
+        continue; // this proc was already converted in interface or class
+      if ProcScope.DeclarationProc<>nil then
+        PasProc:=ProcScope.DeclarationProc;
+      E:=ConvertProcedure(PasProc,aContext);
+      end
     else
-    AddToSL;
+      RaiseNotSupported(P as TPasElement,AContext,20161024191434);
+    Add(E);
     end;
-  if (El is TProcedureBody) then
+
+  if IsProcBody then
     begin
-    E:=ConvertElement(TProcedureBody(El).Body,AContext);
-    AddToSl;
+    ProcBody:=TProcedureBody(El).Body;
+    if (ProcBody.Elements.Count>0) or IsAssembler then
+      begin
+      E:=ConvertElement(TProcedureBody(El).Body,aContext);
+      Add(E);
+      end;
     end;
-{
-  TPasDeclarations = class(TPasElement)
-  TPasSection = class(TPasDeclarations)
-  TInterfaceSection = class(TPasSection)
-  TImplementationSection = class(TPasSection)
-  TProgramSection = class(TImplementationSection)
-  TLibrarySection = class(TImplementationSection)
-  TProcedureBody = class(TPasDeclarations)
-}
+
+  if IsFunction and not IsAssembler then
+    AddFunctionResultReturn;
 end;
 
-Function TPasToJSConverter.ConvertType(El: TPasElement; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertClassType(El: TPasClassType;
+  AContext: TConvertContext): TJSElement;
+(*
+  type
+    TMyClass = class(Ancestor)
+      i: longint;
+    end;
+
+    rtl.createClass(this,"TMyClass",Ancestor,function(){
+      this.i = 0;
+    });
+*)
+type
+  TMemberFunc = (mfInit, mfFinalize);
+const
+  MemberFuncName: array[TMemberFunc] of string = (
+    '$init',
+    '$final'
+    );
+var
+  IsTObject, AncestorIsExternal: boolean;
+
+  function IsMemberNeeded(aMember: TPasElement): boolean;
+  begin
+    if IsElementUsed(aMember) then exit(true);
+    if IsTObject then
+      begin
+      if aMember is TPasProcedure then
+        begin
+        if (CompareText(aMember.Name,'AfterConstruction')=0)
+            or (CompareText(aMember.Name,'BeforeDestruction')=0) then
+          exit(true);
+        end;
+      end;
+    Result:=false;
+  end;
+
+  procedure AddCallAncestorMemberFunction(ClassContext: TConvertContext;
+    Ancestor: TPasType; Src: TJSSourceElements; Kind: TMemberFunc);
+  var
+    Call: TJSCallExpression;
+    AncestorPath: String;
+  begin
+    if (Ancestor=nil) or AncestorIsExternal then
+      exit;
+    Call:=CreateCallExpression(El);
+    AncestorPath:=CreateReferencePath(Ancestor,ClassContext,rpkPathAndName);
+    Call.Expr:=CreatePrimitiveDotExpr(AncestorPath+'.'+MemberFuncName[Kind]+'.call');
+    Call.AddArg(CreatePrimitiveDotExpr('this'));
+    AddToSourceElements(Src,Call);
+  end;
+
+  procedure AddInstanceMemberFunction(Src: TJSSourceElements;
+    ClassContext: TConvertContext; Ancestor: TPasType; Kind: TMemberFunc);
+  // add instance initialization function:
+  //   this.$init = function(){
+  //     ancestor.$init();
+  //     ... init variables ...
+  //   }
+  // or add instance finalization function:
+  //   this.$final = function(){
+  //     ... clear references ...
+  //     ancestor.$final();
+  //   }
+  var
+    FuncVD: TJSVarDeclaration;
+    New_Src: TJSSourceElements;
+    New_FuncContext: TFunctionContext;
+    I: Integer;
+    P: TPasElement;
+    NewEl: TJSElement;
+    Func: TJSFunctionDeclarationStatement;
+    VarType: TPasType;
+    AssignSt: TJSSimpleAssignStatement;
+  begin
+    // add instance members
+    New_Src:=TJSSourceElements(CreateElement(TJSSourceElements, El));
+    New_FuncContext:=TFunctionContext.Create(El,New_Src,ClassContext);
+    try
+      New_FuncContext.ThisPas:=El;
+      New_FuncContext.IsGlobal:=true;
 
+      // add class members
+      For I:=0 to El.Members.Count-1 do
+        begin
+        P:=TPasElement(El.Members[i]);
+        if not IsMemberNeeded(P) then continue;
+        NewEl:=nil;
+        if (P.ClassType=TPasVariable)
+            and (ClassVarModifiersType*TPasVariable(P).VarModifiers=[]) then
+          begin
+          if Kind=mfInit then
+            // mfInit: init var
+            NewEl:=CreateVarDecl(TPasVariable(P),New_FuncContext) // can be nil
+          else
+            begin
+            // mfFinalize: clear reference
+            if vmExternal in TPasVariable(P).VarModifiers then continue;
+            VarType:=ClassContext.Resolver.ResolveAliasType(TPasVariable(P).VarType);
+            if (VarType.ClassType=TPasRecordType)
+                or (VarType.ClassType=TPasClassType)
+                or (VarType.ClassType=TPasClassOfType)
+                or (VarType.ClassType=TPasSetType)
+                or (VarType.ClassType=TPasProcedureType)
+                or (VarType.ClassType=TPasFunctionType)
+                or (VarType.ClassType=TPasArrayType) then
+              begin
+              AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+              NewEl:=AssignSt;
+              AssignSt.LHS:=CreateSubDeclNameExpr(P,P.Name,New_FuncContext);
+              AssignSt.Expr:=CreateLiteralUndefined(El);
+              end;
+            end;
+          end;
+        if NewEl=nil then continue;
+        if (Kind=mfInit) and (New_Src.Statements.Count=0) then
+          // add call ancestor.$init.call(this)
+          AddCallAncestorMemberFunction(ClassContext,Ancestor,New_Src,Kind);
+        AddToSourceElements(New_Src,NewEl);
+        end;
+      if (Kind=mfFinalize) and (New_Src.Statements.Count>0) then
+        // call ancestor.$final.call(this)
+        AddCallAncestorMemberFunction(ClassContext,Ancestor,New_Src,Kind);
+      if (Ancestor<>nil) and (not AncestorIsExternal)
+          and (New_Src.Statements.Count=0) then
+        exit; // descendent does not need $init/$final
+
+      FuncVD:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
+      AddToSourceElements(Src,FuncVD);
+      FuncVD.Name:='this.'+MemberFuncName[Kind];
+      Func:=CreateFunction(El);
+      FuncVD.Init:=Func;
+      Func.AFunction.Body.A:=New_Src;
+      New_Src:=nil;
+    finally
+      New_Src.Free;
+      New_FuncContext.Free;
+    end;
+  end;
+
+  procedure AddRTTI(Src: TJSSourceElements; FuncContext: TFunctionContext);
+  var
+    HasRTTIMembers: Boolean;
+    i: Integer;
+    P: TPasElement;
+    NewEl: TJSElement;
+    VarSt: TJSVariableStatement;
+  begin
+    // add $r to local vars, to avoid name clashes and nicer debugging
+    FuncContext.AddLocalVar(FBuiltInNames[pbivnRTTILocal],nil);
+
+    HasRTTIMembers:=false;
+    For i:=0 to El.Members.Count-1 do
+      begin
+      P:=TPasElement(El.Members[i]);
+      //writeln('TPasToJSConverter.ConvertClassType RTTI El[',i,']=',GetObjName(P));
+      if P.Visibility<>visPublished then continue;
+      if not IsMemberNeeded(P) then continue;
+      NewEl:=nil;
+      if P.ClassType=TPasVariable then
+        NewEl:=CreateRTTIClassField(TPasVariable(P),FuncContext)
+      else if P.InheritsFrom(TPasProcedure) then
+        NewEl:=CreateRTTIClassMethod(TPasProcedure(P),FuncContext)
+      else if P.ClassType=TPasProperty then
+        NewEl:=CreateRTTIClassProperty(TPasProperty(P),FuncContext)
+      else if P.InheritsFrom(TPasType) then
+        continue
+      else
+        DoError(20170409202315,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
+      if NewEl=nil then
+        continue; // e.g. abstract or external proc
+      // add RTTI element
+      if not HasRTTIMembers then
+        begin
+        // add "var $r = this.$rtti"
+        VarSt:=CreateVarStatement(FBuiltInNames[pbivnRTTILocal],
+          CreateMemberExpression(['this',FBuiltInNames[pbivnRTTI]]),El);
+        AddToSourceElements(Src,VarSt);
+
+        HasRTTIMembers:=true;
+        end;
+      AddToSourceElements(Src,NewEl);
+      end;
+  end;
+
+var
+  Call: TJSCallExpression;
+  FunDecl: TJSFunctionDeclarationStatement;
+  Src: TJSSourceElements;
+  ArgEx: TJSLiteral;
+  FuncContext: TFunctionContext;
+  i: Integer;
+  NewEl: TJSElement;
+  P: TPasElement;
+  Scope: TPas2JSClassScope;
+  Ancestor: TPasType;
+  AncestorPath, OwnerName, DestructorName: String;
+  C: TClass;
+  AssignSt: TJSSimpleAssignStatement;
 begin
-  Result:=Nil;
-{
+  Result:=nil;
+  if El.IsForward then
+    begin
+    Result:=ConvertClassForwardType(El,AContext);
+    exit;
+    end;
 
-TPasType = class(TPasElement)
-TPasPointerType = class(TPasType)
-TPasAliasType = class(TPasType)
-TPasTypeAliasType = class(TPasAliasType)
-TPasClassOfType = class(TPasAliasType)
-TPasRangeType = class(TPasType)
-TPasArrayType = class(TPasType)
-TPasFileType = class(TPasType)
-TPasEnumValue = class(TPasElement)
-TPasEnumType = class(TPasType)
-TPasSetType = class(TPasType)
-TPasVariant = class(TPasElement)
-TPasRecordType = class(TPasType)
-TPasClassType = class(TPasType)
-TPasProcedureType = class(TPasType)
-TPasFunctionType = class(TPasProcedureType)
-TPasUnresolvedSymbolRef = class(TPasType)
-TPasUnresolvedTypeRef = class(TPasUnresolvedSymbolRef)
-TPasUnresolvedUnitRef = Class(TPasUnresolvedSymbolRef)
-TPasStringType = class(TPasUnresolvedTypeRef)
-TPasTypeRef = class(TPasUnresolvedTypeRef)
-}
+  if El.IsExternal then exit;
+
+  if El.CustomData is TPas2JSClassScope then
+    Scope:=TPas2JSClassScope(El.CustomData)
+  else
+    Scope:=nil;
+
+  IsTObject:=CompareText(El.Name,'TObject')=0;
+
+  if (Scope<>nil) and (Scope.AncestorScope<>nil) then
+    Ancestor:=Scope.AncestorScope.Element as TPasType
+  else
+    Ancestor:=El.AncestorType;
+
+  // create call 'rtl.createClass('
+  FuncContext:=nil;
+  Call:=CreateCallExpression(El);
+  try
+    AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal;
+    if AncestorIsExternal then
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCreateClassExt]])
+    else
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnCreateClass]]);
+
+    // add parameter: owner. For top level class, the module is the owner.
+    if (El.Parent<>nil) and (El.Parent.ClassType=TImplementationSection) then
+      OwnerName:=AContext.GetLocalName(El.Parent)
+    else
+      OwnerName:=AContext.GetLocalName(El.GetModule);
+    if OwnerName='' then
+      OwnerName:='this';
+    Call.AddArg(CreatePrimitiveDotExpr(OwnerName));
+
+    // add parameter: string constant '"classname"'
+    ArgEx := CreateLiteralString(El,TransformVariableName(El,AContext));
+    Call.AddArg(ArgEx);
+
+    // add parameter: ancestor
+    if Ancestor=nil then
+      AncestorPath:='null'
+    else if AncestorIsExternal then
+      AncestorPath:=TPasClassType(Ancestor).ExternalName
+    else
+      AncestorPath:=CreateReferencePath(Ancestor,AContext,rpkPathAndName);
+    Call.AddArg(CreatePrimitiveDotExpr(AncestorPath));
+
+    if AncestorIsExternal then
+     begin
+     // add the name of the NewInstance function
+     if Scope.NewInstanceFunction<>nil then
+       Call.AddArg(CreateLiteralString(
+         Scope.NewInstanceFunction,Scope.NewInstanceFunction.Name))
+     else
+       Call.AddArg(CreateLiteralString(El,''));
+     end;
+
+    // add parameter: class initialize function 'function(){...}'
+    FunDecl:=CreateFunction(El,true,true);
+    Call.AddArg(FunDecl);
+    Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
+
+    // add members
+    FuncContext:=TFunctionContext.Create(El,Src,AContext);
+    FuncContext.IsGlobal:=true;
+    FuncContext.ThisPas:=El;
+    // add class members: types and class vars
+    For i:=0 to El.Members.Count-1 do
+      begin
+      P:=TPasElement(El.Members[i]);
+      //writeln('TPasToJSConverter.ConvertClassType class vars El[',i,']=',GetObjName(P));
+      if not IsMemberNeeded(P) then continue;
+      C:=P.ClassType;
+      NewEl:=nil;
+      if C=TPasVariable then
+        begin
+        if ClassVarModifiersType*TPasVariable(P).VarModifiers<>[] then
+          begin
+          NewEl:=CreateVarDecl(TPasVariable(P),FuncContext); // can be nil
+          if NewEl=nil then continue;
+          end
+        else
+          continue;
+        end
+      else if C=TPasConst then
+        NewEl:=ConvertConst(TPasConst(P),aContext)
+      else if C=TPasProperty then
+        begin
+        NewEl:=ConvertProperty(TPasProperty(P),AContext);
+        if NewEl=nil then continue;
+        end
+      else if C.InheritsFrom(TPasType) then
+        NewEl:=CreateTypeDecl(TPasType(P),aContext)
+      else if C.InheritsFrom(TPasProcedure) then
+        continue
+      else
+        RaiseNotSupported(P,FuncContext,20161221233338);
+      if NewEl=nil then
+        RaiseNotSupported(P,FuncContext,20170204223922);
+      AddToSourceElements(Src,NewEl);
+      end;
+
+    // instance initialization function
+    AddInstanceMemberFunction(Src,FuncContext,Ancestor,mfInit);
+    // instance finalization function
+    AddInstanceMemberFunction(Src,FuncContext,Ancestor,mfFinalize);
+
+    // add methods
+    For i:=0 to El.Members.Count-1 do
+      begin
+      P:=TPasElement(El.Members[i]);
+      //writeln('TPasToJSConverter.ConvertClassType methods El[',i,']=',GetObjName(P));
+      if not IsMemberNeeded(P) then continue;
+      if P is TPasProcedure then
+        begin
+        if IsTObject and (P.ClassType=TPasDestructor) then
+          begin
+          DestructorName:=TransformVariableName(P,AContext);
+          if DestructorName<>'Destroy' then
+            begin
+            // add 'rtl.tObjectDestroy="destroy";'
+            AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,P));
+            AssignSt.LHS:=CreateMemberExpression([GetBuildInNames(pbivnRTL),GetBuildInNames(pbivnTObjectDestroy)]);
+            AssignSt.Expr:=CreateLiteralString(P,DestructorName);
+            AddToSourceElements(Src,AssignSt);
+            end;
+          end;
+        NewEl:=ConvertProcedure(TPasProcedure(P),FuncContext);
+        end
+      else
+        continue;
+      if NewEl=nil then
+        continue; // e.g. abstract or external proc
+      AddToSourceElements(Src,NewEl);
+      end;
+
+    // add RTTI init function
+    if AContext.Resolver<>nil then
+      AddRTTI(Src,FuncContext);
+
+    Result:=Call;
+  finally
+    FuncContext.Free;
+    if Result<>Call then
+      Call.Free;
+  end;
 end;
 
-function TPasToJSConverter.ConvertClassType(const El: TPasClassType;
-  const AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertClassForwardType(El: TPasClassType;
+  AContext: TConvertContext): TJSElement;
+// module.$rtti.$Class("classname");
 var
-  call: TJSCallExpression;
-  pex: TJSPrimaryExpressionIdent;
-  asi: TJSSimpleAssignStatement;
-  unary2: TJSUnary;
-  unary: TJSUnary;
-  je: TJSElement;
-  FD: TJSFuncDef;
-  cons: TJSFunctionDeclarationStatement;
-  FS: TJSFunctionDeclarationStatement;
-  memname: string;
-  ctname: string;
-  tmember: TPasElement;
-  j: integer;
-  ret: TJSReturnStatement;
-begin
-  ctname := El.FullName;
-  unary := TJSUnary(CreateElement(TJSUnary,El));
-  asi := TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-  unary.A := asi;
-  pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,El));
-  pex.Name := El.Name;
-  asi.LHS := pex;
-  FS := TJSFunctionDeclarationStatement(
-    CreateElement(TJSFunctionDeclarationStatement, EL));
-  call := CreateCallStatement(FS, []);
-  asi.Expr := call;
-  Result := unary;
-  FD := TJSFuncDef.Create;
-  FS.AFunction := FD;
-  FD.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, El));
-  FD.Body.A := TJSSourceElements(CreateElement(TJSSourceElements, El));
-  if Assigned(El.AncestorType) then
-  begin
-    pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent, El));
-    call.Args := TJSArguments(CreateElement(TJSArguments, El));
-    pex.Name := El.AncestorType.Name;
-    call.Args.Elements.AddElement.Expr := pex;
-    FD.Params.Add('_super');
-    unary2 := TJSUnary(CreateElement(TJSUnary, El));
-    call := CreateCallStatement('__extends', [El.Name, '_super']);
-    unary2.A := call;
-    TJSSourceElements(FD.Body.A).Statements.AddNode.Node := unary2;
-  end;
-  //create default onstructor
-  cons := CreateProcedureDeclaration(El);
-  TJSSourceElements(FD.Body.A).Statements.AddNode.Node := cons;
-  cons.AFunction.Name := El.Name;
-
-  //convert class member
-  for j := 0 to El.Members.Count - 1 do
+  Ref: TResolvedReference;
+  aClass: TPasClassType;
+  ObjLit: TJSObjectLiteral;
+begin
+  Result:=nil;
+  if (AContext.Resolver=nil) or not (El.CustomData is TResolvedReference) then exit;
+  Ref:=TResolvedReference(El.CustomData);
+  aClass:=Ref.Declaration as TPasClassType;
+  if not HasTypeInfo(aClass,AContext) then exit;
+  if IsClassRTTICreatedBefore(aClass,El) then exit;
+  // module.$rtti.$Class("classname");
+  Result:=CreateRTTINewType(aClass,FBuiltInNames[pbifnRTTINewClass],true,AContext,ObjLit);
+  if ObjLit<>nil then
+    RaiseInconsistency(20170412093427);
+end;
+
+function TPasToJSConverter.ConvertClassExternalType(El: TPasClassType;
+  AContext: TConvertContext): TJSElement;
+
+  function IsMemberNeeded(aMember: TPasElement): boolean;
   begin
-    tmember := TPasElement(El.Members[j]);
-    memname := tmember.FullName;
-    je := ConvertClassMember(tmember, AContext);
-    if Assigned(je) then
-      TJSSourceElements(FD.Body.A).Statements.AddNode.Node := je;
-  end;
-
-  //add return statment
-  ret := TJSReturnStatement(CreateElement(TJSReturnStatement, El));
-  TJSSourceElements(FD.Body.A).Statements.AddNode.Node := ret;
-  pex := TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent, El));
-  ret.Expr := pex;
-  pex.Name := el.Name;
-  Result := unary;
+    Result:=IsElementUsed(aMember);
+  end;
+
+var
+  i: Integer;
+  P: TPasElement;
+  C: TClass;
+  Proc: TPasProcedure;
+begin
+  Result:=nil;
+  if El.IsForward then exit;
+
+  // add class members: types and class vars
+  For i:=0 to El.Members.Count-1 do
+    begin
+    P:=TPasElement(El.Members[i]);
+    //writeln('TPasToJSConverter.ConvertClassExternalType class El[',i,']=',GetObjName(P));
+    if not IsMemberNeeded(P) then continue;
+    C:=P.ClassType;
+    if (C=TPasVariable) or (C=TPasConst) then
+      begin
+      if not (vmExternal in TPasVariable(P).VarModifiers) then
+        DoError(20170321150737,nMissingExternalName,sMissingExternalName,[],P);
+      end
+    else if C=TPasProperty then
+      // is replaced with Getter/Setter -> nothing to do here
+    else if C.InheritsFrom(TPasProcedure) then
+      begin
+      Proc:=TPasProcedure(P);
+      if Proc.IsExternal then
+        // external, nothing to do here
+      else
+        DoError(20170321152209,nMissingExternalName,sMissingExternalName,[],P);
+      end
+    else
+      RaiseNotSupported(P,AContext,20170321151727);
+    end;
 end;
 
-function TPasToJSConverter.ConvertClassMember(El: TPasElement;
+function TPasToJSConverter.ConvertClassOfType(El: TPasClassOfType;
   AContext: TConvertContext): TJSElement;
+// create
+// module.$rtti.$ClassRef("typename",{
+//    instancetype: module.$rtti["classname"])
+//  }
+// if class is defined later add a forward define for the class
 var
-  FS: TJSFunctionDeclarationStatement;
-  par: string;
+  ObjLit: TJSObjectLiteral;
+  Prop: TJSObjectLiteralElement;
+  Call: TJSCallExpression;
+  ok: Boolean;
+  List: TJSStatementList;
 begin
-  Result := nil;
-  if (El is TPasProcedure) and (not (El is TPasConstructor)) then
-  begin
-    FS := CreateProcedureDeclaration(El);
-    Result := CreateUnary([TPasProcedure(El).Name, 'prototype',
-      El.Parent.FullName], FS);
+  Result:=nil;
+  if not HasTypeInfo(El,AContext) then exit;
+
+  ok:=false;
+  Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewClassRef],false,AContext,ObjLit);
+  Result:=Call;
+  try
+    Prop:=ObjLit.Elements.AddElement;
+    Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIClassRef_InstanceType]);
+    Prop.Expr:=CreateTypeInfoRef(El.DestType,AContext,El);
+
+    if not IsClassRTTICreatedBefore(El.DestType as TPasClassType,El) then
+      begin
+      // class rtti must be forward registered
+      if not (AContext is TFunctionContext) then
+        RaiseNotSupported(El,AContext,20170412102916);
+      // prepend   module.$rtti.$Class("classname");
+      Call:=CreateRTTINewType(El.DestType,FBuiltInNames[pbifnRTTINewClass],true,AContext,ObjLit);
+      if ObjLit<>nil then
+        RaiseInconsistency(20170412102654);
+      List:=TJSStatementList(CreateElement(TJSStatementList,El));
+      List.A:=Call;
+      List.B:=Result;
+      Result:=List;
+      end;
+    ok:=true;
+  finally
+    if not ok then
+      FreeAndNil(Result);
   end;
-  if (El is TPasConstructor)then
-  begin
-    Result:=ConvertClassconstructor(TPasClassConstructor(El),AContext);
+end;
+
+function TPasToJSConverter.ConvertEnumType(El: TPasEnumType;
+  AContext: TConvertContext): TJSElement;
+// TMyEnum = (red, green)
+// convert to
+//   this.TMyEnum = {
+//     "0":"red",
+//     "red":0,
+//     "0":"green",
+//     "green":0,
+//   };
+//   module.$rtti.$TIEnum("TMyEnum",{
+//     enumtype: this.TMyEnum,
+//     minvalue: 0,
+//     maxvalue: 1
+//   });
+var
+  ObjectContect: TObjectContext;
+  i: Integer;
+  EnumValue: TPasEnumValue;
+  ParentObj, Obj, TIObj: TJSObjectLiteral;
+  ObjLit, TIProp: TJSObjectLiteralElement;
+  AssignSt: TJSSimpleAssignStatement;
+  JSName: TJSString;
+  Call: TJSCallExpression;
+  List: TJSStatementList;
+  ok: Boolean;
+begin
+  Result:=nil;
+  for i:=0 to El.Values.Count-1 do
+    begin
+    EnumValue:=TPasEnumValue(El.Values[i]);
+    if EnumValue.Value<>nil then
+      RaiseNotSupported(EnumValue.Value,AContext,20170208145221,'enum constant');
+    end;
+
+  ok:=false;
+  ObjectContect:=nil;
+  try
+    Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
+    if AContext is TObjectContext then
+      begin
+      // add 'TypeName: function(){}'
+      ParentObj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
+      ObjLit:=ParentObj.Elements.AddElement;
+      ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
+      ObjLit.Expr:=Obj;
+      Result:=Obj;
+      end
+    else
+      begin
+      // add 'this.TypeName = function(){}'
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=CreateSubDeclNameExpr(El,El.Name,AContext);
+      AssignSt.Expr:=Obj;
+      Result:=AssignSt;
+      end;
+
+    ObjectContect:=TObjectContext.Create(El,Obj,AContext);
+    for i:=0 to El.Values.Count-1 do
+      begin
+      EnumValue:=TPasEnumValue(El.Values[i]);
+      JSName:=TJSString(TransformVariableName(EnumValue,AContext));
+      // add "0":"value"
+      ObjLit:=Obj.Elements.AddElement;
+      ObjLit.Name:=TJSString(IntToStr(i));
+      ObjLit.Expr:=CreateLiteralJSString(El,JSName);
+      // add value:0
+      ObjLit:=Obj.Elements.AddElement;
+      ObjLit.Name:=JSName;
+      ObjLit.Expr:=CreateLiteralNumber(El,i);
+      end;
+
+    if HasTypeInfo(El,AContext) then
+      begin
+      // create typeinfo
+      if not (AContext is TFunctionContext) then
+        RaiseNotSupported(El,AContext,20170411210045,'typeinfo');
+      // create statement list
+      List:=TJSStatementList(CreateElement(TJSStatementList,El));
+      List.A:=Result;
+      Result:=List;
+      // module.$rtti.$TIEnum("TMyEnum",{...});
+      Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewEnum],false,AContext,TIObj);
+      List.B:=Call;
+      // add  minvalue: number
+      TIProp:=TIObj.Elements.AddElement;
+      TIProp.Name:=TJSString(FBuiltInNames[pbivnRTTIInt_MinValue]);
+      TIProp.Expr:=CreateLiteralNumber(El,0);
+      // add  maxvalue: number
+      TIProp:=TIObj.Elements.AddElement;
+      TIProp.Name:=TJSString(FBuiltInNames[pbivnRTTIInt_MaxValue]);
+      TIProp.Expr:=CreateLiteralNumber(El,El.Values.Count-1);
+      // add  enumtype: this.TypeName
+      TIProp:=TIObj.Elements.AddElement;
+      TIProp.Name:=TJSString(FBuiltInNames[pbivnRTTIEnum_EnumType]);
+      TIProp.Expr:=CreateSubDeclNameExpr(El,El.Name,AContext);
+      end;
+
+    ok:=true;
+  finally
+    ObjectContect.Free;
+    if not ok then
+      FreeAndNil(Result);
   end;
-  if (el is TPasProperty) then
-    ConvertProperty(TPasProperty(El), AContext);
+end;
 
+function TPasToJSConverter.ConvertSetType(El: TPasSetType;
+  AContext: TConvertContext): TJSElement;
+// create
+//   module.$rtti.$Set("name",{
+//       comptype: module.$rtti["enumtype"]
+//     })
+var
+  Obj: TJSObjectLiteral;
+  Call: TJSCallExpression;
+  Prop: TJSObjectLiteralElement;
+begin
+  Result:=nil;
+  if El.IsPacked then
+    DoError(20170222231613,nPasElementNotSupported,sPasElementNotSupported,
+      ['packed'],El);
+  if not HasTypeInfo(El,AContext) then exit;
+
+  // module.$rtti.$Set("name",{...})
+  Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewSet],false,AContext,Obj);
+  try
+    // "comptype: ref"
+    Prop:=Obj.Elements.AddElement;
+    Prop.Name:=TJSString(FBuiltInNames[pbivnRTTISet_CompType]);
+    Prop.Expr:=CreateTypeInfoRef(El.EnumType,AContext,El);
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertClassconstructor(El: TPasConstructor;
-   AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertPointerType(El: TPasPointerType;
+  AContext: TConvertContext): TJSElement;
+// create
+//   module.$rtti.$Set("name",{
+//       reftype: module.$rtti["reftype"]
+//     })
 var
-  FS: TJSFunctionDeclarationStatement;
-  n: integer;
-  fun1sourceele: TJSSourceElements;
-  ret: TJSReturnStatement;
-  nmem: TJSNewMemberExpression;
-  pex: TJSPrimaryExpressionIdent;
+  Obj: TJSObjectLiteral;
+  Call: TJSCallExpression;
+  Prop: TJSObjectLiteralElement;
 begin
-  FS := CreateProcedureDeclaration(El);
-  FS.AFunction.Name := El.Name;
-  Fs.AFunction.Body := TJSFunctionBody(CreateElement(TJSFunctionBody, EL.Body));
-  fun1sourceele := TJSSourceElements.Create(0, 0, '');
-  fs.AFunction.Body.A := fun1sourceele;
-  ret := TJSReturnStatement.Create(0, 0, '');
-  fun1sourceele.Statements.AddNode.Node := ret;
-  nmem := TJSNewMemberExpression.Create(0, 0, '');
-  ret.Expr := nmem;
-  pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
-  nmem.Mexpr := pex;
-  pex.Name := El.Parent.FullName;
-  for n := 0 to El.ProcType.Args.Count - 1 do
-  begin
-    if n = 0 then
-      nmem.Args := TJSArguments.Create(0, 0, '');
-    fs.AFunction.Params.Add(TPasArgument(El.ProcType.Args[n]).Name);
-    pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
-    pex.Name := TPasArgument(El.ProcType.Args[n]).Name;
-    nmem.Args.Elements.AddElement.Expr := pex;
+  Result:=nil;
+  if not HasTypeInfo(El,AContext) then exit;
+
+  // module.$rtti.$Pointer("name",{...})
+  Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewPointer],false,AContext,Obj);
+  try
+    // "reftype: ref"
+    Prop:=Obj.Elements.AddElement;
+    Prop.Name:=TJSString(FBuiltInNames[pbivnRTTISet_CompType]);
+    Prop.Expr:=CreateTypeInfoRef(El.DestType,AContext,El);
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
   end;
-  Result := CreateUnary([TPasProcedure(El).Name, El.Parent.FullName], FS);
 end;
 
-Function TPasToJSConverter.ConvertProcedure(El: TPasProcedure; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertProcedureType(El: TPasProcedureType;
+  AContext: TConvertContext): TJSElement;
+// create
+//   module.$rtti.$ProcVar("name",{
+//       procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags)
+//     })
+//   module.$rtti.$MethodVar("name",{
+//       procsig: rtl.newTIProcSignature([[arg1name,arg1type,arg1flags],[arg2name...],...],resulttype,flags),
+//       methodkind: 1
+//     })
+var
+  Call, InnerCall: TJSCallExpression;
+  FunName: String;
+  ResultEl: TPasResultElement;
+  ResultTypeInfo: TJSElement;
+  Flags: Integer;
+  MethodKind: TMethodKind;
+  Obj: TJSObjectLiteral;
+  Prop: TJSObjectLiteralElement;
+begin
+  Result:=nil;
+  if El.IsNested then
+    DoError(20170222231636,nPasElementNotSupported,sPasElementNotSupported,
+      ['is nested'],El);
+  if El.CallingConvention<>ccDefault then
+    DoError(20170222231532,nPasElementNotSupported,sPasElementNotSupported,
+        ['calling convention '+cCallingConventions[El.CallingConvention]],El);
+  if not HasTypeInfo(El,AContext) then exit;
+
+  // module.$rtti.$ProcVar("name",function(){})
+  if El.IsReferenceTo then
+    FunName:=FBuiltInNames[pbifnRTTINewRefToProcVar]
+  else if El.IsOfObject then
+    FunName:=FBuiltInNames[pbifnRTTINewMethodVar]
+  else
+    FunName:=FBuiltInNames[pbifnRTTINewProcVar];
+  Call:=CreateRTTINewType(El,FunName,false,AContext,Obj);
+  try
+    // add "procsig: rtl.newTIProcSignature()"
+    Prop:=Obj.Elements.AddElement;
+    Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIProcVar_ProcSig]);
+    InnerCall:=CreateCallExpression(El);
+    Prop.Expr:=InnerCall;
+    InnerCall.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnRTTINewProcSig]]);
+    // add array of arguments
+    InnerCall.AddArg(CreateRTTIArgList(El,El.Args,AContext));
+    // add resulttype as typeinfo reference
+    if El is TPasFunctionType then
+      begin
+      ResultEl:=TPasFunctionType(El).ResultEl;
+      ResultTypeInfo:=CreateTypeInfoRef(ResultEl.ResultType,AContext,ResultEl);
+      if ResultTypeInfo<>nil then
+        InnerCall.AddArg(ResultTypeInfo);
+      end;
+    // add param flags
+    Flags:=0;
+    if ptmVarargs in El.Modifiers then
+      inc(Flags,pfVarargs);
+    if Flags>0 then
+      InnerCall.AddArg(CreateLiteralNumber(El,Flags));
+
+    if El.IsOfObject then
+      begin
+      // add "methodkind: number;"
+      Prop:=Obj.Elements.AddElement;
+      Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIMethodKind]);
+      if El.ClassType=TPasProcedureType then
+        MethodKind:=mkProcedure
+      else if El.ClassType=TPasFunctionType then
+        MethodKind:=mkFunction
+      else
+        RaiseNotSupported(El,AContext,20170411180848);
+      Prop.Expr:=CreateLiteralNumber(El,ord(MethodKind));
+      end;
+
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertArrayType(El: TPasArrayType;
+  AContext: TConvertContext): TJSElement;
+// Create
+//  module.$rtti.$StaticArray("name",{
+//    dims: [dimsize1,dimsize2,...],
+//    eltype: module.$rtti["ElTypeName"]
+//  };
+//  module.$rtti.$DynArray("name",{
+//    eltype: module.$rtti["ElTypeName"]
+//  };
+var
+  CallName: String;
+  Obj: TJSObjectLiteral;
+  Prop: TJSObjectLiteralElement;
+  ArrLit: TJSArrayLiteral;
+  Arr: TPasArrayType;
+  Index: Integer;
+  RangeResolved: TPasResolverResult;
+  ElType: TPasType;
+  RangeEl: TPasExpr;
+  aMinValue, aMaxValue: int64;
+  Call: TJSCallExpression;
+begin
+  Result:=nil;
+  if El.PackMode<>pmNone then
+    DoError(20170222231648,nPasElementNotSupported,sPasElementNotSupported,
+       ['packed'],El);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
+  {$ENDIF}
+  if not HasTypeInfo(El,AContext) then exit;
+
+  // module.$rtti.$DynArray("name",{...})
+  if length(El.Ranges)>0 then
+    CallName:=FBuiltInNames[pbifnRTTINewStaticArray]
+  else
+    CallName:=FBuiltInNames[pbifnRTTINewDynArray];
+  Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
+  try
+    ElType:=El.ElType;
+    if length(El.Ranges)>0 then
+      begin
+      // dims: [dimsize1,dimsize2,...]
+      Prop:=Obj.Elements.AddElement;
+      Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIArray_Dims]);
+      ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+      Prop.Expr:=ArrLit;
+      Arr:=El;
+      Index:=0;
+      repeat
+        RangeEl:=Arr.Ranges[Index];
+        AContext.Resolver.ComputeElement(RangeEl,RangeResolved,[rcType]);
+        ComputeRange(RangeResolved,AContext,aMinValue,aMaxValue,RangeEl);
+        ArrLit.AddElement(CreateLiteralNumber(RangeEl,aMaxValue-aMinValue+1));
+        inc(Index);
+        if Index=length(Arr.Ranges) then
+          begin
+          if ElType.ClassType<>TPasArrayType then
+            break;
+          Arr:=TPasArrayType(ElType);
+          if length(Arr.Ranges)=0 then
+            RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
+          ElType:=Arr.ElType;
+          Index:=0;
+          end;
+      until false;
+      end;
+    // eltype: ref
+    Prop:=Obj.Elements.AddElement;
+    Prop.Name:=TJSString(FBuiltInNames[pbivnRTTIArray_ElType]);
+    Prop.Expr:=CreateTypeInfoRef(ElType,AContext,El);
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
+end;
+
+procedure TPasToJSConverter.ForLoop_OnProcBodyElement(El: TPasElement;
+  arg: pointer);
+// Called by ConvertForStatement on each element of the current proc body
+// Check each element that lies behind the loop if it is reads the LoopVar
+var
+  Data: PForLoopFindData absolute arg;
+begin
+  if El.HasParent(Data^.ForLoop) then
+    Data^.FoundLoop:=true
+  else if Data^.FoundLoop and (not Data^.LoopVarWrite) and (not Data^.LoopVarRead) then
+    begin
+    // El comes after loop and LoopVar was not yet accessed
+    if (El.CustomData is TResolvedReference)
+        and (TResolvedReference(El.CustomData).Declaration=Data^.LoopVar) then
+      begin
+        // El refers the LoopVar
+        // ToDo: check write only access
+        Data^.LoopVarRead:=true;
+      end;
+    end;
+end;
+
+procedure TPasToJSConverter.SetUseEnumNumbers(const AValue: boolean);
+begin
+  if AValue then
+    Include(FOptions,coEnumNumbers)
+  else
+    Exclude(FOptions,coEnumNumbers);
+end;
+
+procedure TPasToJSConverter.SetUseLowerCase(const AValue: boolean);
+begin
+  if AValue then
+    Include(FOptions,coLowerCase)
+  else
+    Exclude(FOptions,coLowerCase);
+end;
+
+procedure TPasToJSConverter.SetUseSwitchStatement(const AValue: boolean);
+begin
+  if AValue then
+    Include(FOptions,coSwitchStatement)
+  else
+    Exclude(FOptions,coSwitchStatement);
+end;
+
+constructor TPasToJSConverter.Create;
+var
+  n: TPas2JSBuiltInName;
+begin
+  FOptions:=[coLowerCase];
+  for n in TPas2JSBuiltInName do
+    FBuiltInNames[n]:=Pas2JSBuiltInNames[n];
+end;
+
+destructor TPasToJSConverter.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TPasToJSConverter.ConvertProcedure(El: TPasProcedure;
+  AContext: TConvertContext): TJSElement;
+var
+  BodyJS: TJSFunctionBody;
+  FirstSt, LastSt: TJSStatementList;
+
+  procedure AddBodyStatement(Add: TJSElement; Src: TPasElement);
+  begin
+    AddToStatementList(FirstSt,LastSt,Add,Src);
+    BodyJS.A:=FirstSt;
+  end;
 
 Var
   FS : TJSFunctionDeclarationStatement;
   FD : TJSFuncDef;
   n:Integer;
+  AssignSt: TJSSimpleAssignStatement;
+  FuncContext: TFunctionContext;
+  ProcScope, ImplProcScope: TPasProcedureScope;
+  Arg: TPasArgument;
+  SelfSt: TJSVariableStatement;
+  ImplProc: TPasProcedure;
+  BodyPas: TProcedureBody;
 begin
-  FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,EL));
-  Result:=FS;
-  FD:=TJSFuncDef.Create;
-  FD.Name:=TransFormFunctionName(El,AContext);
-  FS.AFunction:=FD;
+  Result:=nil;
+
+  if El.IsAbstract then exit;
+  if El.IsExternal then exit;
+
+  ProcScope:=TPasProcedureScope(El.CustomData);
+  if ProcScope.DeclarationProc<>nil then
+    exit;
+
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertProcedure "',El.Name,'" ',El.Parent.ClassName);
+  {$ENDIF}
+
+  ImplProc:=El;
+  if ProcScope.ImplProc<>nil then
+    ImplProc:=ProcScope.ImplProc;
+  ImplProcScope:=TPasProcedureScope(ImplProc.CustomData);
+
+  AssignSt:=nil;
+  if AContext.IsGlobal then
+    begin
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    Result:=AssignSt;
+    AssignSt.LHS:=CreateSubDeclNameExpr(El,El.Name,AContext);
+    end;
+
+  FS:=CreateFunction(El,ImplProc.Body<>nil);
+  FD:=FS.AFunction;
+  if AssignSt<>nil then
+    AssignSt.Expr:=FS
+  else
+    begin
+    // local/nested function
+    Result:=FS;
+    FD.Name:=TJSString(TransformVariableName(El,AContext));
+    end;
   for n := 0 to El.ProcType.Args.Count - 1 do
-    FD.Params.Add(TPasArgument(El.ProcType.Args[0]).Name);
-  FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,EL.Body));
-  FD.Body.A:=ConvertElement(El.Body,AContext);
+    begin
+    Arg:=TPasArgument(El.ProcType.Args[n]);
+    FD.Params.Add(TransformVariableName(Arg,AContext));
+    end;
+
+  if ImplProc.Body<>nil then
+    begin
+    BodyPas:=ImplProc.Body;
+    BodyJS:=FD.Body;
+    FuncContext:=TFunctionContext.Create(ImplProc,FD.Body,AContext);
+    try
+      FirstSt:=nil;
+      LastSt:=nil;
+      if ProcScope.ClassScope<>nil then
+        begin
+        // method or class method
+        FuncContext.ThisPas:=ProcScope.ClassScope.Element;
+        if ImplProc.Body.Functions.Count>0 then
+          begin
+          // has nested procs -> add "var self = this;"
+          FuncContext.AddLocalVar(FBuiltInNames[pbivnSelf],FuncContext.ThisPas);
+          SelfSt:=CreateVarStatement(FBuiltInNames[pbivnSelf],
+                                        CreatePrimitiveDotExpr('this'),El);
+          AddBodyStatement(SelfSt,BodyPas);
+          if ImplProcScope.SelfArg<>nil then
+            begin
+            // redirect Pascal-Self to JS-Self
+            FuncContext.AddLocalVar(FBuiltInNames[pbivnSelf],ImplProcScope.SelfArg);
+            end;
+          end
+        else
+          begin
+          if ImplProcScope.SelfArg<>nil then
+            begin
+            // no nested procs ->  redirect Pascal-Self to JS-this
+            FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
+            end;
+          end;
+        end;
+      {$IFDEF VerbosePas2JS}
+      //FuncContext.WriteStack;
+      {$ENDIF}
+      AddBodyStatement(ConvertDeclarations(BodyPas,FuncContext),BodyPas);
+    finally
+      FuncContext.Free;
+    end;
+    end;
   {
   TPasProcedureBase = class(TPasElement)
   TPasOverloadedProc = class(TPasProcedureBase)
@@ -925,150 +8509,1129 @@ begin
   TPasClassProcedure = class(TPasProcedure)
   TPasClassFunction = class(TPasProcedure)
   }
+end;
+
+function TPasToJSConverter.ConvertBeginEndStatement(El: TPasImplBeginBlock;
+  AContext: TConvertContext; NilIfEmpty: boolean): TJSElement;
 
+begin
+  Result:=ConvertImplBlockElements(El,AContext,NilIfEmpty);
 end;
 
-Function TPasToJSConverter.ConvertProcedureImpl(El: TPasProcedureImpl; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertImplBlockElements(El: TPasImplBlock;
+  AContext: TConvertContext; NilIfEmpty: boolean): TJSElement;
 
-Var
-  FS : TJSFunctionDeclarationStatement;
-  FD : TJSFuncDef;
+var
+  First, Last: TJSStatementList;
+  I : Integer;
+  PasImpl: TPasImplElement;
+  JSImpl : TJSElement;
 
 begin
-  FS:=TJSFunctionDeclarationStatement(CreateElement(TJSFunctionDeclarationStatement,EL));
-  Result:=FS;
-  FD:=TJSFuncDef.Create;
-  FD.Name:=TransFormFunctionName(El,AContext);
-  FS.AFunction:=FD;
-  FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,EL.Body));
-  FD.Body.A:=ConvertElement(El.Body,AContext);
-{
-  TPasProcedureImpl = class(TPasElement)
-  TPasConstructorImpl = class(TPasProcedureImpl)
-  TPasDestructorImpl = class(TPasProcedureImpl)
-}
+  if Not (Assigned(El.Elements) and (El.Elements.Count>0)) then
+    begin
+    if NilIfEmpty then
+      Result:=nil
+    else
+      Result:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
+    end
+  else
+    begin
+    First:=nil;
+    Result:=First;
+    Last:=First;
+    //writeln('TPasToJSConverter.ConvertImplBlockElements START El.Elements.Count=',El.Elements.Count);
+    For I:=0 to El.Elements.Count-1 do
+      begin
+      PasImpl:=TPasImplElement(El.Elements[i]);
+      JSImpl:=ConvertElement(PasImpl,AContext);
+      if JSImpl=nil then
+        continue; // e.g. "inherited;" when there is no ancestor proc
+      //writeln('TPasToJSConverter.ConvertImplBlockElements ',i,' ',JSImpl.ClassName);
+      AddToStatementList(First,Last,JSImpl,PasImpl);
+      Result:=First;
+      end;
+    end;
 end;
 
-Function TPasToJSConverter.ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertInitializationSection(
+  El: TInitializationSection; AContext: TConvertContext): TJSElement;
+var
+  FDS: TJSFunctionDeclarationStatement;
+  FunName: String;
+  IsMain, ok: Boolean;
+  AssignSt: TJSSimpleAssignStatement;
+  FuncContext: TFunctionContext;
+  Body: TJSFunctionBody;
+begin
+  // create: '$mod.$init=function(){}'
+
+  IsMain:=(El.Parent<>nil) and (El.Parent is TPasProgram);
+  if IsMain then
+    FunName:=FBuiltInNames[pbifnProgramMain]
+  else
+    FunName:=FBuiltInNames[pbifnUnitInit];
 
+  AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+  Result:=AssignSt;
+  FuncContext:=nil;
+  ok:=false;
+  try
+    AssignSt.LHS:=CreateMemberExpression([FBuiltInNames[pbivnModule],FunName]);
+    FDS:=CreateFunction(El,El.Elements.Count>0);
+    AssignSt.Expr:=FDS;
+    if El.Elements.Count>0 then
+      begin
+      Body:=FDS.AFunction.Body;
+      FuncContext:=TFunctionContext.Create(El,Body,AContext);
+      // Note: although the rtl sets 'this' as the module, the function can
+      //   simply refer to $mod, so no need to set ThisPas here
+      Body.A:=ConvertImplBlockElements(El,FuncContext,false);
+      end;
+    ok:=true;
+  finally
+    FuncContext.Free;
+    if not ok then FreeAndNil(Result);
+  end;
+end;
+
+function TPasToJSConverter.ConvertFinalizationSection(El: TFinalizationSection;
+  AContext: TConvertContext): TJSElement;
 begin
-  Result:=ConvertImplBlockElements(El,AContext);
+  Result:=nil;
+  RaiseNotSupported(El,AContext,20161024192519);
 end;
 
-Function TPasToJSConverter.ConvertImplBlockElements(El: TPasImplBlock; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertTryStatement(El: TPasImplTry;
+  AContext: TConvertContext): TJSElement;
+Var
+  T : TJSTryStatement;
+  ExceptBlock: TPasImplTryHandler;
+  i: Integer;
+  ExceptOn: TPasImplExceptOn;
+  IfSt, Last: TJSIfStatement;
 
-var
-  B : TJSElement;
-  S,S2 : TJSStatementList;
-  I : Integer;
+begin
+  Result:=nil;
+  T:=nil;
+  try
+    if El.FinallyExcept is TPasImplTryFinally then
+      begin
+      T:=TJSTryFinallyStatement(CreateElement(TJSTryFinallyStatement,El));
+      T.Block:=ConvertImplBlockElements(El,AContext,true);
+      T.BFinally:=ConvertImplBlockElements(El.FinallyExcept,AContext,true);
+      end
+    else
+      begin
+      T:=TJSTryCatchStatement(CreateElement(TJSTryCatchStatement,El));
+      T.Block:=ConvertImplBlockElements(El,AContext,true);
+      // always set the catch except object, needed by nodejs
+      T.Ident:=TJSString(FBuiltInNames[pbivnExceptObject]);
+      ExceptBlock:=El.FinallyExcept;
+      if (ExceptBlock.Elements.Count>0)
+          and (TPasImplElement(ExceptBlock.Elements[0]) is TPasImplExceptOn) then
+        begin
+        Last:=nil;
+        for i:=0 to ExceptBlock.Elements.Count-1 do
+          begin
+          ExceptOn:=TObject(ExceptBlock.Elements[i]) as TPasImplExceptOn;
+          IfSt:=ConvertExceptOn(ExceptOn,AContext) as TJSIfStatement;
+          if Last=nil then
+            T.BCatch:=IfSt
+          else
+            Last.BFalse:=IfSt;
+          Last:=IfSt;
+          end;
+        if El.ElseBranch<>nil then
+          Last.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext,true)
+        else
+          begin
+          // default else: throw exceptobject
+          Last.BFalse:=TJSThrowStatement(CreateElement(TJSThrowStatement,El));
+          TJSThrowStatement(Last.BFalse).A:=
+            CreatePrimitiveDotExpr(FBuiltInNames[pbivnExceptObject]);
+          end;
+        end
+      else
+        begin
+        if El.ElseBranch<>nil then
+          RaiseNotSupported(El.ElseBranch,AContext,20170205003014);
+        T.BCatch:=ConvertImplBlockElements(ExceptBlock,AContext,true);
+        end;
+      end;
+    Result:=T;
+  finally
+    if Result=nil then
+      T.Free;
+  end;
+end;
 
+function TPasToJSConverter.ConvertCaseOfStatement(El: TPasImplCaseOf;
+  AContext: TConvertContext): TJSElement;
+var
+  SubEl: TPasImplElement;
+  St: TPasImplCaseStatement;
+  ok: Boolean;
+  i, j: Integer;
+  JSExpr: TJSElement;
+  StList: TJSStatementList;
+  Expr: TPasExpr;
+  IfSt, LastIfSt: TJSIfStatement;
+  TmpVarName: String;
+  VarDecl: TJSVarDeclaration;
+  VarSt: TJSVariableStatement;
+  JSOrExpr: TJSLogicalOrExpression;
+  JSAndExpr: TJSLogicalAndExpression;
+  JSLEExpr: TJSRelationalExpressionLE;
+  JSGEExpr: TJSRelationalExpressionGE;
+  JSEQExpr: TJSEqualityExpressionEQ;
 begin
-  if Not (Assigned(EL.Elements) and (EL.Elements.Count>0)) then
-    Result:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El))
-  else
+  Result:=nil;
+  if UseSwitchStatement then
     begin
-    S:=TJSStatementList(CreateElement(TJSStatementList,TPasImplElement(EL)));
-    Result:=S;
-    For I:=0 to EL.Elements.Count-1 do
+    // convert to switch statement
+    // switch does not support ranges -> check
+    ok:=true;
+    for i:=0 to El.Elements.Count-1 do
       begin
-      B:=ConvertElement(TPasImplElement(EL.Elements[i]),AContext);
-      if not Assigned(S.A) then
-        S.A:=B
-      else
+      SubEl:=TPasImplElement(El.Elements[i]);
+      if not (SubEl is TPasImplCaseStatement) then
+        continue;
+      St:=TPasImplCaseStatement(SubEl);
+      for j:=0 to St.Expressions.Count-1 do
         begin
-        if Assigned(S.B) then
+        Expr:=TPasExpr(St.Expressions[j]);
+        if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).Kind=pekRange) then
           begin
-          S2:=TJSStatementList(CreateElement(TJSStatementList,TPasImplElement(EL.Elements[i])));
-          S2.A:=S.B;
-          S.B:=S2;
-          S:=S2;
+          ok:=false;
+          break;
           end;
-        S.B:=B;
         end;
+      if not ok then break;
+      end;
+    if ok then
+      begin
+      Result:=CreateSwitchStatement(El,AContext);
+      exit;
       end;
     end;
+
+  // convert to if statements
+  StList:=TJSStatementList(CreateElement(TJSStatementList,El));
+  ok:=false;
+  try
+    // create var $tmp=CaseExpr;
+    TmpVarName:=AContext.CreateLocalIdentifier('$tmp');
+    VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,El.CaseExpr));
+    StList.A:=VarSt;
+    VarDecl:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El.CaseExpr));
+    VarSt.A:=VarDecl;
+    VarDecl.Name:=TmpVarName;
+    VarDecl.Init:=ConvertExpression(El.CaseExpr,AContext);
+
+    LastIfSt:=nil;
+    for i:=0 to El.Elements.Count-1 do
+      begin
+      SubEl:=TPasImplElement(El.Elements[i]);
+      if SubEl is TPasImplCaseStatement then
+        begin
+        St:=TPasImplCaseStatement(SubEl);
+        // create for example "if (tmp==expr) || ((tmp>=expr) && (tmp<=expr)){}"
+        IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,SubEl));
+        if LastIfSt=nil then
+          StList.B:=IfSt
+        else
+          LastIfSt.BFalse:=IfSt;
+        LastIfSt:=IfSt;
+
+        for j:=0 to St.Expressions.Count-1 do
+          begin
+          Expr:=TPasExpr(St.Expressions[j]);
+          if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).Kind=pekRange) then
+            begin
+            // range -> create "(tmp>=left) && (tmp<=right)"
+            // create "() && ()"
+            JSAndExpr:=TJSLogicalAndExpression(CreateElement(TJSLogicalAndExpression,Expr));
+            JSExpr:=JSAndExpr;
+            // create "tmp>=left"
+            JSGEExpr:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,Expr));
+            JSAndExpr.A:=JSGEExpr;
+            JSGEExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr,AContext);
+            JSGEExpr.B:=ConvertExpression(TBinaryExpr(Expr).left,AContext);
+            // create "tmp<=right"
+            JSLEExpr:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,Expr));
+            JSAndExpr.B:=JSLEExpr;
+            JSLEExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr,AContext);
+            JSLEExpr.B:=ConvertExpression(TBinaryExpr(Expr).right,AContext);
+            end
+          else
+            begin
+            // value -> create (tmp==Expr)
+            JSEQExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,Expr));
+            JSExpr:=JSEQExpr;
+            JSEQExpr.A:=CreateIdentifierExpr(TmpVarName,El.CaseExpr,AContext);
+            JSEQExpr.B:=ConvertExpression(Expr,AContext);
+            end;
+          if IfSt.Cond=nil then
+            // first expression
+            IfSt.Cond:=JSExpr
+          else
+            begin
+            // multi expression -> append with OR
+            JSOrExpr:=TJSLogicalOrExpression(CreateElement(TJSLogicalOrExpression,St));
+            JSOrExpr.A:=IfSt.Cond;
+            JSOrExpr.B:=JSExpr;
+            IfSt.Cond:=JSOrExpr;
+            end;
+          end;
+        // convert statement
+        if St.Body<>nil then
+          IfSt.BTrue:=ConvertElement(St.Body,AContext)
+        else
+          IfSt.BTrue:=TJSEmptyStatement(CreateElement(TJSEmptyStatement,St));
+        end
+      else if SubEl is TPasImplCaseElse then
+        begin
+        // Pascal 'else' or 'otherwise' -> create JS "else{}"
+        if LastIfSt=nil then
+          RaiseNotSupported(SubEl,AContext,20161128120802,'case-of needs at least one case');
+        LastIfSt.BFalse:=ConvertImplBlockElements(El.ElseBranch,AContext,true);
+        end
+      else
+        RaiseNotSupported(SubEl,AContext,20161128113055);
+      end;
+
+    ok:=true;
+  finally
+    if not ok then
+      StList.Free;
+  end;
+  Result:=StList;
 end;
 
-Function TPasToJSConverter.ConvertInitializationSection(El: TInitializationSection; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertAsmStatement(El: TPasImplAsmStatement;
+  AContext: TConvertContext): TJSElement;
+var
+  s: String;
+  L: TJSLiteral;
 begin
-  Result:=ConvertImplBlockElements(El,AContext);
+  if AContext=nil then ;
+  s:=Trim(El.Tokens.Text);
+  if (s<>'') and (s[length(s)]=';') then
+    Delete(s,length(s),1);
+  if s='' then
+    Result:=TJSEmptyStatement(CreateElement(TJSEmptyStatement,El))
+  else begin
+    L:=TJSLiteral(CreateElement(TJSLiteral,El));
+    L.Value.CustomValue:=TJSString(s);
+    Result:=L;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertFinalizationSection(El: TFinalizationSection; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.CreateImplementationSection(El: TPasModule;
+  AContext: TConvertContext
+  ): TJSFunctionDeclarationStatement;
+var
+  Src: TJSSourceElements;
+  ImplContext: TSectionContext;
+  ImplDecl: TJSElement;
+  ImplVarSt: TJSVariableStatement;
+  FunDecl: TJSFunctionDeclarationStatement;
+  ModVarName, ImplVarName: String;
 begin
-  Result:=ConvertImplBlockElements(El,AContext);
+  Result:=nil;
+  // create function(){}
+  FunDecl:=CreateFunction(El,true,true);
+  Src:=TJSSourceElements(FunDecl.AFunction.Body.A);
+
+  // create section context (a function)
+  ImplContext:=TSectionContext.Create(El,Src,AContext);
+  try
+    if coUseStrict in Options then
+      AddToSourceElements(Src,CreateLiteralString(El,'use strict'));
+
+    // add "var $mod = this;"
+    ImplContext.ThisPas:=El;
+    ModVarName:=FBuiltInNames[pbivnModule];
+    AddToSourceElements(Src,CreateVarStatement(ModVarName,
+      CreatePrimitiveDotExpr('this'),El));
+    ImplContext.AddLocalVar(ModVarName,El);
+
+    // add var $impl = $mod.$impl
+    ImplVarName:=FBuiltInNames[pbivnImplementation];
+    ImplVarSt:=CreateVarStatement(ImplVarName,
+      CreateMemberExpression([ModVarName,ImplVarName]),El.ImplementationSection);
+    AddToSourceElements(Src,ImplVarSt);
+    ImplContext.AddLocalVar(ImplVarName,El.ImplementationSection);
+
+    // create implementation declarations
+    ImplDecl:=ConvertDeclarations(El.ImplementationSection,ImplContext);
+    if ImplDecl=nil then
+      exit;
+    // add impl declarations
+    AddToSourceElements(Src,ImplDecl);
+    Result:=FunDecl;
+  finally
+    ImplContext.Free;
+    if Result=nil then
+      FunDecl.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertTryStatement(El: TPasImplTry; AContext : TConvertContext): TJSElement;
+procedure TPasToJSConverter.CreateInitSection(El: TPasModule;
+  Src: TJSSourceElements; AContext: TConvertContext);
+begin
+  // add initialization section
+  if Assigned(El.InitializationSection) then
+    AddToSourceElements(Src,ConvertInitializationSection(El.InitializationSection,AContext));
+  // finalization: not supported
+  if Assigned(El.FinalizationSection) then
+    raise Exception.Create('TPasToJSConverter.ConvertInitializationSection: finalization section is not supported');
+end;
 
-Var
-  B,F : TJSElement;
-  T : TJSTryStatement;
-  IsFin : Boolean;
+function TPasToJSConverter.CreateDotExpression(aParent: TPasElement; Left,
+  Right: TJSElement): TJSElement;
+var
+  Dot: TJSDotMemberExpression;
+  RightParent: TJSElement;
+  ok: Boolean;
+begin
+  Result:=nil;
+  if Left=nil then
+    RaiseInconsistency(20170201140827);
+  if Right=nil then
+    RaiseInconsistency(20170211192018);
+  ok:=false;
+  try
+    // create a TJSDotMemberExpression of Left and the left-most identifier of Right
+    // Left becomes the new left-most element of Right.
+    Result:=Right;
+    RightParent:=nil;
+    repeat
+      if (Right.ClassType=TJSCallExpression) then
+        begin
+        RightParent:=Right;
+        Right:=TJSCallExpression(Right).Expr;
+        if Right=nil then
+          begin
+          // left-most is nil -> insert Left
+          TJSCallExpression(RightParent).Expr:=Left;
+          ok:=true;
+          exit;
+          end;
+        end
+      else if (Right.ClassType=TJSBracketMemberExpression) then
+        begin
+        RightParent:=Right;
+        Right:=TJSBracketMemberExpression(Right).MExpr;
+        if Right=nil then
+          begin
+          // left-most is nil -> insert Left
+          TJSBracketMemberExpression(RightParent).MExpr:=Left;
+          ok:=true;
+          exit;
+          end;
+        end
+      else if (Right.ClassType=TJSDotMemberExpression) then
+        begin
+        RightParent:=Right;
+        Right:=TJSDotMemberExpression(Right).MExpr;
+        if Right=nil then
+          begin
+          // left-most is nil -> insert Left
+          TJSDotMemberExpression(RightParent).MExpr:=Left;
+          ok:=true;
+          exit;
+          end;
+        end
+      else if (Right.ClassType=TJSPrimaryExpressionIdent) then
+        begin
+        // left-most identifier found
+        // -> replace it
+        Dot := TJSDotMemberExpression(CreateElement(TJSDotMemberExpression, aParent));
+        if Result=Right then
+          Result:=Dot
+        else if RightParent is TJSBracketMemberExpression then
+          TJSBracketMemberExpression(RightParent).MExpr:=Dot
+        else if RightParent is TJSCallExpression then
+          TJSCallExpression(RightParent).Expr:=Dot
+        else if RightParent is TJSDotMemberExpression then
+          TJSDotMemberExpression(RightParent).MExpr:=Dot
+        else
+          begin
+          Dot.Free;
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.CreateDotExpression Right=',GetObjName(Right),' RightParent=',GetObjName(RightParent),' Result=',GetObjName(Result));
+          {$ENDIF}
+          RaiseInconsistency(20170129141307);
+          end;
+        Dot.MExpr := Left;
+        Dot.Name := TJSPrimaryExpressionIdent(Right).Name;
+        FreeAndNil(Right);
+        break;
+        end
+      else
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('CreateDotExpression Right=',Right.ClassName);
+        {$ENDIF}
+        DoError(20161024191240,nMemberExprMustBeIdentifier,sMemberExprMustBeIdentifier,[],aParent);
+        end;
+    until false;
+
+    ok:=true;
+  finally
+    if not ok then
+      begin
+      Left.Free;
+      FreeAndNil(Result);
+      end;
+  end;
+end;
 
+function TPasToJSConverter.CreateReferencedSet(El: TPasElement; SetExpr: TJSElement
+  ): TJSElement;
+var
+  Call: TJSCallExpression;
+begin
+  Call:=CreateCallExpression(El);
+  Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Reference]]);
+  Call.AddArg(SetExpr);
+  Result:=Call;
+end;
+
+function TPasToJSConverter.CreateCloneRecord(El: TPasElement;
+  ResolvedEl: TPasResolverResult; RecordExpr: TJSElement;
+  AContext: TConvertContext): TJSElement;
+// create  "new RecordType(RecordExpr)
+var
+  NewExpr: TJSNewMemberExpression;
 begin
-  F:=Nil;
-  B:=ConvertImplBlockElements(El,AContext);
+  if not (ResolvedEl.TypeEl is TPasRecordType) then
+    RaiseInconsistency(20170212155956);
+  NewExpr:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,El));
+  NewExpr.MExpr:=CreateReferencePathExpr(ResolvedEl.TypeEl,AContext);
+  NewExpr.Args:=TJSArguments(CreateElement(TJSArguments,El));
+  NewExpr.AddArg(RecordExpr);
+  Result:=NewExpr;
+end;
+
+function TPasToJSConverter.CreateCallback(El: TPasElement;
+  ResolvedEl: TPasResolverResult; AContext: TConvertContext): TJSElement;
+// El is a reference to a proc
+// for a proc or nested proc simply use the function
+// for a method create  "rtl.createCallback(Target,func)"
+var
+  Call: TJSCallExpression;
+  Target: TJSElement;
+  DotExpr: TJSDotMemberExpression;
+  Prim: TJSPrimaryExpressionIdent;
+  aName: String;
+  DotPos: SizeInt;
+  FunName: String;
+  ProcScope: TPasProcedureScope;
+begin
+  Result:=nil;
+  if not (ResolvedEl.IdentEl is TPasProcedure) then
+    RaiseInconsistency(20170215140756);
+
+  Target:=ConvertElement(El,AContext);
+
+  ProcScope:=TPasProcedureScope(ResolvedEl.IdentEl.CustomData);
+  if ProcScope.ClassScope=nil then
+    begin
+    // not a method -> simply use the function
+    Result:=Target;
+    exit;
+    end;
+
+  // a method -> create "rtl.createCallback(Target,func)"
+  Call:=nil;
   try
-    F:=ConvertElement(El.FinallyExcept);
-    IsFin:=El.FinallyExcept is TPasImplTryFinally;
-    if IsFin then
-      T:=TJSTryFinallyStatement(CreateElement(TJSTryFinallyStatement,El))
+    Call:=CreateCallExpression(El);
+    // "rtl.createCallback"
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnProcType_Create]]);
+    // add parameters
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.CreateCallback ',GetObjName(Target));
+    {$ENDIF}
+    FunName:='';
+    // the last element of Target is the proc, chomp that off
+    if Target.ClassType=TJSDotMemberExpression then
+      begin
+      // chomp dot member  ->  rtl.createCallback(scope,"FunName")
+      DotExpr:=TJSDotMemberExpression(Target);
+      FunName:=String(DotExpr.Name);
+      DotPos:=PosLast('.',FunName);
+      if DotPos>0 then
+        begin
+        // e.g.  path dot $class.funname
+        // keep DotExpr, chomp funname
+        DotExpr.Name:=TJSString(LeftStr(FunName,DotPos-1));
+        FunName:=copy(FunName,DotPos+1);
+        if not IsValidJSIdentifier(DotExpr.Name) then
+          begin
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.CreateCallback ',GetObjName(Target),' DotExpr.Name="',DotExpr.Name,'"');
+          {$ENDIF}
+          DoError(20170215161802,nInvalidFunctionReference,sInvalidFunctionReference,[],El);
+          end;
+        end
+      else
+        begin
+        // e.g.  path dot funname
+        // delete DotExpr
+        Target:=DotExpr.MExpr;
+        DotExpr.MExpr:=nil;
+        FreeAndNil(DotExpr);
+        end;
+      if not IsValidJSIdentifier(TJSString(FunName)) then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateCallback ',GetObjName(Target),' FunName="',FunName,'"');
+        {$ENDIF}
+        DoError(20170215161802,nInvalidFunctionReference,sInvalidFunctionReference,[],El);
+        end;
+      Call.AddArg(Target);
+      // add function name as parameter
+      Call.AddArg(CreateLiteralString(El,FunName));
+      end
+    else if Target.ClassType=TJSPrimaryExpressionIdent then
+      begin
+      Prim:=TJSPrimaryExpressionIdent(Target);
+      aName:=String(Prim.Name);
+      DotPos:=PosLast('.',aName);
+      if DotPos<1 then
+        DoError(20170418135806,nInvalidFunctionReference,sInvalidFunctionReference,[],El);
+      // chomp dotted identifier   ->  rtl.createCallback(scope,"FunName")
+      FunName:=copy(aName,DotPos+1);
+      Prim.Name:=TJSString(LeftStr(aName,DotPos-1));
+      Call.AddArg(Prim);
+      // add function name as parameter
+      Call.AddArg(CreateLiteralString(El,FunName));
+      end
     else
       begin
-      T:=TJSTryCatchStatement(CreateElement(TJSTryCatchStatement,El));
-      T.Ident:=GetExceptionObjectname(AContext);
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateCallback invalid Scope=',GetObjName(Target));
+      {$ENDIF}
+      DoError(20170418135820,nInvalidFunctionReference,sInvalidFunctionReference,[],El);
+      end;
+
+    Result:=Call;
+  finally
+    if Result=nil then
+      begin
+      Target.Free;
+      Call.Free;
+      end;
+  end;
+end;
+
+function TPasToJSConverter.CreateAssignStatement(LeftEl: TPasElement;
+  AssignContext: TAssignContext): TJSElement;
+var
+  LHS: TJSElement;
+  AssignSt: TJSSimpleAssignStatement;
+begin
+  Result:=nil;
+  LHS:=ConvertElement(LeftEl,AssignContext);
+  if AssignContext.Call<>nil then
+    begin
+    // has a setter -> right side was already added as parameter
+    if AssignContext.RightSide<>nil then
+      begin
+      LHS.Free;
+      RaiseInconsistency(20170207215447);
       end;
-  except
-    FreeAndNil(B);
-    FreeAndNil(F);
-    Raise;
+    Result:=LHS;
+    end
+  else
+    begin
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,AssignContext.PasElement));
+    AssignSt.LHS:=LHS;
+    AssignSt.Expr:=AssignContext.RightSide;
+    AssignContext.RightSide:=nil;
+    Result:=AssignSt;
+    end;
+end;
+
+function TPasToJSConverter.CreateTypeInfoRef(El: TPasType;
+  AContext: TConvertContext; ErrorEl: TPasElement): TJSElement;
+var
+  C: TClass;
+  aName, aModName: String;
+  bt: TResolverBaseType;
+  jbt: TPas2jsBaseType;
+  Parent: TPasElement;
+  aModule: TPasModule;
+  Bracket: TJSBracketMemberExpression;
+begin
+  El:=AContext.Resolver.ResolveAliasType(El);
+  if El=nil then
+    RaiseInconsistency(20170409172756);
+  if El=AContext.PasElement then
+    begin
+    // refering itself
+    if El is TPasClassType then
+      begin
+      // use this
+      Result:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnRTTILocal]);
+      exit;
+      end
+    else
+      RaiseNotSupported(ErrorEl,AContext,20170409195518,'cannot typeinfo itself');
+    end;
+  if El.Name='' then
+    DoError(20170421145257,nTypeXCannotBePublished,sTypeXCannotBePublished,
+      ['typeinfo of anonymous '+El.ElementTypeName],ErrorEl);
+
+  C:=El.ClassType;
+  if C=TPasUnresolvedSymbolRef then
+    begin
+    if El.CustomData is TResElDataBaseType then
+      begin
+      bt:=TResElDataBaseType(El.CustomData).BaseType;
+      case bt of
+      btShortInt,btByte,
+      btSmallInt,btWord,
+      btLongint,btLongWord,
+      btIntDouble,btUIntDouble,
+      btString,btChar,
+      btDouble,
+      btBoolean,
+      btPointer:
+        begin
+        // create rtl.basename
+        Result:=CreateMemberExpression([FBuiltInNames[pbivnRTL],lowercase(
+         AContext.Resolver.BaseTypeNames[bt])]);
+        exit;
+        end;
+      btCustom:
+        if El.CustomData is TResElDataPas2JSBaseType then
+          begin
+          jbt:=TResElDataPas2JSBaseType(El.CustomData).JSBaseType;
+          case jbt of
+          pbtJSValue:
+            begin
+            // create rtl.basename
+            Result:=CreateMemberExpression([FBuiltInNames[pbivnRTL],lowercase(Pas2jsBaseTypeNames[jbt])]);
+            exit;
+            end;
+          else
+            {$IFDEF VerbosePas2JS}
+            writeln('TPasToJSConverter.CreateTypeInfoRef [20170409174539] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData),' jbt=',Pas2jsBaseTypeNames[jbt]);
+            {$ENDIF}
+          end;
+          end
+        else
+          begin
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.CreateTypeInfoRef [20170409174645] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData),' bt=',AContext.Resolver.BaseTypeNames[bt]);
+          {$ENDIF}
+          end
+      else
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateTypeInfoRef [20170409173746] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData),' bt=',AContext.Resolver.BaseTypeNames[bt]);
+        {$ENDIF}
+      end;
+      end
+    else
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateTypeInfoRef [20170409173729] El=',GetObjName(El),' El.CustomData=',GetObjName(El.CustomData));
+      {$ENDIF}
+      end;
+    end
+  else if (C=TPasEnumType)
+      or (C=TPasSetType)
+      or (C=TPasClassType)
+      or (C=TPasClassOfType)
+      or (C=TPasArrayType)
+      or (C=TPasProcedureType)
+      or (C=TPasFunctionType)
+      or (C=TPasPointerType)
+      // ToDo or (C=TPasTypeAliasType)
+      or (C=TPasRecordType)
+      // ToDo or (C=TPasRangeType)
+      then
+    begin
+    // user type  ->  module.$rtti[typename]
+    aName:=TransformVariableName(El,AContext);
+    if aName='' then
+      DoError(20170411230435,nPasElementNotSupported,sPasElementNotSupported,
+        ['typeinfo of anonymous '+El.ElementTypeName+' not supported'],ErrorEl);
+    Parent:=El.Parent;
+    while Parent.ClassType=TPasClassType do
+      begin
+      aName:=TransformVariableName(Parent,AContext)+'.'+aName;
+      Parent:=Parent.Parent;
+      end;
+    if Parent is TPasSection then
+      begin
+      aModule:=Parent.Parent as TPasModule;
+      aModName:=AContext.GetLocalName(aModule);
+      if aModName='' then
+        aModName:=TransformModuleName(aModule,true,AContext);
+      Bracket:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+      Bracket.MExpr:=CreateMemberExpression([aModName,FBuiltInNames[pbivnRTTI]]);
+      Bracket.Name:=CreateLiteralString(El,aName);
+      Result:=Bracket;
+      exit;
+      end;
+    end;
+  aName:=El.Name;
+  if aName='' then aName:=El.ClassName;
+  DoError(20170409173329,nTypeXCannotBePublished,sTypeXCannotBePublished,
+    [aName],ErrorEl);
+end;
+
+function TPasToJSConverter.CreateRTTIArgList(Parent: TPasElement;
+  Args: TFPList; AContext: TConvertContext): TJSElement;
+var
+  Params: TJSArrayLiteral;
+  i: Integer;
+begin
+  Result:=nil;
+  if Args.Count=0 then
+    Result:=CreateLiteralNull(Parent)
+  else
+    begin
+    try
+      Params:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Parent));
+      for i:=0 to Args.Count-1 do
+        AddRTTIArgument(TPasArgument(Args[i]),Params,AContext);
+      Result:=Params;
+    finally
+      if Result=nil then
+        Params.Free;
+    end;
   end;
-  if IsFin then
-    T.BFinally:=F
+end;
+
+procedure TPasToJSConverter.AddRTTIArgument(Arg: TPasArgument;
+  TargetParams: TJSArrayLiteral; AContext: TConvertContext);
+var
+  Param: TJSArrayLiteral;
+  ArgName: String;
+  Flags: Integer;
+  ArrType: TPasArrayType;
+begin
+  // for each param add  "["argname",argtype,flags]"  Note: flags only if >0
+  Param:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,Arg));
+  TargetParams.Elements.AddElement.Expr:=Param;
+  // add "argname"
+  ArgName:=TransformVariableName(Arg,Arg.Name,AContext);
+  Param.Elements.AddElement.Expr:=CreateLiteralString(Arg,ArgName);
+  Flags:=0;
+  // add "argtype"
+  if Arg.ArgType=nil then
+    // untyped
+    Param.Elements.AddElement.Expr:=CreateLiteralNull(Arg)
+  else if (Arg.ArgType.Name='') and (Arg.ArgType.ClassType=TPasArrayType) then
+    begin
+    // open array param
+    inc(Flags,pfArray);
+    ArrType:=TPasArrayType(Arg.ArgType);
+    Param.Elements.AddElement.Expr:=CreateTypeInfoRef(ArrType.ElType,AContext,Arg);
+    end
   else
-    T.BCatch:=F;
-  T.Block:=B;
-  Result:=T;
+    Param.Elements.AddElement.Expr:=CreateTypeInfoRef(Arg.ArgType,AContext,Arg);
+  // add flags
+  case Arg.Access of
+    argDefault: ;
+    argConst: inc(Flags,pfConst);
+    argVar: inc(Flags,pfVar);
+    argOut: inc(Flags,pfOut);
+  else
+    RaiseNotSupported(Arg,AContext,20170409192127,AccessNames[Arg.Access]);
+  end;
+  if Flags>0 then
+    Param.Elements.AddElement.Expr:=CreateLiteralNumber(Arg,Flags);
+end;
+
+function TPasToJSConverter.CreateRTTINewType(El: TPasType;
+  const CallFuncName: string; IsForward: boolean; AContext: TConvertContext;
+  out ObjLit: TJSObjectLiteral): TJSCallExpression;
+// module.$rtti.$TiSomething("name",{})
+var
+  RttiPath, TypeName: String;
+  Call: TJSCallExpression;
+  aModule: TPasModule;
+begin
+  Result:=nil;
+  ObjLit:=nil;
+  // get module path
+  aModule:=El.GetModule;
+  if aModule=nil then
+    RaiseInconsistency(20170418115552);
+  RttiPath:=AContext.GetLocalName(aModule);
+  if RttiPath='' then
+    RttiPath:=TransformModuleName(aContext.GetRootModule,true,AContext);
+
+  Call:=CreateCallExpression(El);
+  try
+    // module.$rtti.$ProcVar
+    Call.Expr:=CreateMemberExpression([RttiPath,FBuiltInNames[pbivnRTTI],CallFuncName]);
+    // add param "typename"
+    TypeName:=TransformVariableName(El,AContext);
+    Call.AddArg(CreateLiteralString(El,TypeName));
+    if not IsForward then
+      begin
+      // add {}
+      ObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
+      Call.AddArg(ObjLit);
+      end;
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertTryFinallyStatement(El: TPasImplTryFinally; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIClassField(V: TPasVariable;
+  AContext: TConvertContext): TJSElement;
+// create $r.addField("varname",typeinfo);
+var
+  Call: TJSCallExpression;
+var
+  JSTypeInfo: TJSElement;
+  aName: String;
+begin
+  Result:=nil;
+  JSTypeInfo:=CreateTypeInfoRef(V.VarType,AContext,V);
+  // Note: create JSTypeInfo first, it may raise an exception
+  Call:=CreateCallExpression(V);
+  // $r.addField
+  Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTTILocal],FBuiltInNames[pbifnRTTIAddField]]);
+  // param "varname"
+  aName:=TransformVariableName(V,AContext);
+  Call.AddArg(CreateLiteralString(V,aName));
+  // param typeinfo
+  Call.AddArg(JSTypeInfo);
+  Result:=Call;
+end;
+
+function TPasToJSConverter.CreateRTTIClassMethod(Proc: TPasProcedure;
+  AContext: TConvertContext): TJSElement;
+// create $r.addMethod("funcname",methodkind,params,resulttype,options)
+var
+  OptionsEl: TJSObjectLiteral;
+  ResultTypeInfo: TJSElement;
+  Call: TJSCallExpression;
 
+  procedure AddOption(const aName: String; JS: TJSElement);
+  var
+    ObjLit: TJSObjectLiteralElement;
+  begin
+    if OptionsEl=nil then
+      begin
+      OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
+      if ResultTypeInfo=nil then
+        Call.AddArg(CreateLiteralNull(Proc));
+      Call.AddArg(OptionsEl);
+      end;
+    ObjLit:=OptionsEl.Elements.AddElement;
+    ObjLit.Name:=TJSString(aName);
+    ObjLit.Expr:=JS;
+  end;
 
+var
+  FunName: String;
+  C: TClass;
+  MethodKind, Flags: Integer;
+  ResultEl: TPasResultElement;
+  ProcScope, OverriddenProcScope: TPasProcedureScope;
+  OverriddenClass: TPasClassType;
 begin
-  Result:=ConvertImplBlockElements(El,AContext);
+  Result:=nil;
+  if Proc.IsOverride then
+    begin
+    ProcScope:=Proc.CustomData as TPasProcedureScope;
+    if ProcScope.OverriddenProc.Visibility=visPublished then
+      begin
+      // overridden proc is published as well
+      OverriddenProcScope:=ProcScope.OverriddenProc.CustomData as TPasProcedureScope;
+      OverriddenClass:=OverriddenProcScope.ClassScope.Element as TPasClassType;
+      if HasTypeInfo(OverriddenClass,AContext) then
+        exit; // overridden proc was already published in ancestor
+      end;
+    end;
+  OptionsEl:=nil;
+  ResultTypeInfo:=nil;
+  try
+    // $r.addMethod
+    Call:=CreateCallExpression(Proc);
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTTILocal],FBuiltInNames[pbifnRTTIAddMethod]]);
+
+    // param "funname"
+    FunName:=TransformVariableName(Proc,AContext);
+    Call.AddArg(CreateLiteralString(Proc,FunName));
+
+    // param methodkind as number
+    C:=Proc.ClassType;
+    if C=TPasProcedure then
+      MethodKind:=ord(mkProcedure)
+    else if C=TPasFunction then
+      MethodKind:=ord(mkFunction)
+    else if C=TPasConstructor then
+      MethodKind:=ord(mkConstructor)
+    else if C=TPasDestructor then
+      MethodKind:=ord(mkDestructor)
+    else if C=TPasClassProcedure then
+      MethodKind:=ord(mkClassProcedure)
+    else if C=TPasClassFunction then
+      MethodKind:=ord(mkClassFunction)
+    else
+      RaiseNotSupported(Proc,AContext,20170409190242);
+    Call.AddArg(CreateLiteralNumber(Proc,MethodKind));
+
+    // param params as []
+    Call.AddArg(CreateRTTIArgList(Proc,Proc.ProcType.Args,AContext));
+
+    // param resulttype as typeinfo reference
+    if C.InheritsFrom(TPasFunction) then
+      begin
+      ResultEl:=TPasFunction(Proc).FuncType.ResultEl;
+      ResultTypeInfo:=CreateTypeInfoRef(ResultEl.ResultType,AContext,ResultEl);
+      if ResultTypeInfo<>nil then
+        Call.AddArg(ResultTypeInfo);
+      end;
+
+    // param options if needed as {}
+    Flags:=0;
+    if Proc.IsStatic then
+      inc(Flags,pfStatic);
+    if ptmVarargs in Proc.ProcType.Modifiers then
+      inc(Flags,pfVarargs);
+    if Proc.IsExternal then
+      inc(Flags,pfExternal);
+    if Flags>0 then
+      AddOption(FBuiltInNames[pbivnRTTIProcFlags],CreateLiteralNumber(Proc,Flags));
+
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertTryExceptStatement(El: TPasImplTryExcept; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIClassProperty(Prop: TPasProperty;
+  AContext: TConvertContext): TJSElement;
+// create  $r.addProperty("propname",flags,result,"getter","setter",{options})
+var
+  Call: TJSCallExpression;
+  OptionsEl: TJSObjectLiteral;
 
+  function GetAccessorName(Decl: TPasElement): String;
+  begin
+    Result:=TransformVariableName(Decl,AContext);
+  end;
 
+  procedure AddOption(const aName: String; JS: TJSElement);
+  var
+    ObjLit: TJSObjectLiteralElement;
+  begin
+    if OptionsEl=nil then
+      begin
+      OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Prop));
+      Call.AddArg(OptionsEl);
+      end;
+    ObjLit:=OptionsEl.Elements.AddElement;
+    ObjLit.Name:=TJSString(aName);
+    ObjLit.Expr:=JS;
+  end;
+
+var
+  PropName: String;
+  Flags: Integer;
+  GetterPas, StoredPas, SetterPas: TPasElement;
+  ResultTypeInfo: TJSElement;
 begin
+  Result:=nil;
+  OptionsEl:=nil;
+  try
+    // $r.addProperty
+    Call:=CreateCallExpression(Prop);
+    Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTTILocal],FBuiltInNames[pbifnRTTIAddProperty]]);
+
+    // param "propname"
+    PropName:=TransformVariableName(Prop,Prop.Name,AContext);
+    Call.AddArg(CreateLiteralString(Prop,PropName));
+
+    // add flags
+    Flags:=0;
+    GetterPas:=AContext.Resolver.GetPasPropertyGetter(Prop);
+    if GetterPas is TPasProcedure then
+      inc(Flags,pfGetFunction);
+    SetterPas:=AContext.Resolver.GetPasPropertySetter(Prop);
+    if SetterPas is TPasProcedure then
+      inc(Flags,pfSetProcedure);
+    StoredPas:=AContext.Resolver.GetPasPropertyStored(Prop);
+    if StoredPas is TPasProcedure then
+      inc(Flags,pfStoredFunction);
+    Call.AddArg(CreateLiteralNumber(Prop,Flags));
+
+    // add resulttype
+    ResultTypeInfo:=CreateTypeInfoRef(Prop.VarType,AContext,Prop);
+    if ResultTypeInfo<>nil then
+      Call.AddArg(ResultTypeInfo)
+    else
+      Call.AddArg(CreateLiteralNull(Prop));
+
+    // add "getter"
+    if GetterPas=nil then
+      Call.AddArg(CreateLiteralString(Prop,''))
+    else
+      Call.AddArg(CreateLiteralString(GetterPas,GetAccessorName(GetterPas)));
+
+    // add "setter"
+    if SetterPas=nil then
+      Call.AddArg(CreateLiteralString(Prop,''))
+    else
+      Call.AddArg(CreateLiteralString(SetterPas,GetAccessorName(SetterPas)));
+
+    // add option "stored"
+    if StoredPas<>nil then
+      AddOption(FBuiltInNames[pbivnRTTIPropStored],
+        CreateLiteralString(StoredPas,GetAccessorName(StoredPas)));
 
-  Result:=ConvertImplBlockElements(El,AContext);
+    // add option defaultvalue
+    // ToDo
+
+    // add option Index
+    // ToDo
+
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock;
+  AContext: TConvertContext): TJSElement;
 
 begin
   Result:=Nil;
-  if (EL is TPasImplStatement) then
+  if (El is TPasImplStatement) then
     Result:=ConvertStatement(TPasImplStatement(El),AContext)
-  else if (EL is TPasImplIfElse) then
+  else if (El.ClassType=TPasImplIfElse) then
     Result:=ConvertIfStatement(TPasImplIfElse(El),AContext)
-  else if (El is TPasImplRepeatUntil) then
+  else if (El.ClassType=TPasImplRepeatUntil) then
     Result:=ConvertRepeatStatement(TPasImplRepeatUntil(El),AContext)
-  else if (El is TPasImplBeginBlock) then
-    Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext)
-  else if (El is TInitializationSection) then
+  else if (El.ClassType=TPasImplBeginBlock) then
+    Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,true)
+  else if (El.ClassType=TInitializationSection) then
     Result:=ConvertInitializationSection(TInitializationSection(El),AContext)
-  else if (El is TFinalizationSection) then
+  else if (El.ClassType=TFinalizationSection) then
     Result:=ConvertFinalizationSection(TFinalizationSection(El),AContext)
-  else if (El is TPasImplTry) then
+  else if (El.ClassType=TPasImplTry) then
     Result:=ConvertTryStatement(TPasImplTry(El),AContext)
-  else if (El is TPasImplTryFinally) then
-    Result:=ConvertTryFinallyStatement(TPasImplTryFinally(El),AContext)
-  else if (El is TPasImplTryExcept) then
-    Result:=ConvertTryExceptStatement(TPasImplTryExcept(El),AContext);
+  else if (El.ClassType=TPasImplCaseOf) then
+    Result:=ConvertCaseOfStatement(TPasImplCaseOf(El),AContext)
+  else
+    RaiseNotSupported(El,AContext,20161024192156);
 (*
   TPasImplBlock = class(TPasImplElement)
   TPasImplCaseOf = class(TPasImplBlock)
@@ -1083,87 +9646,81 @@ begin
 *)
 end;
 
-Function TPasToJSConverter.ConvertPackage(El: TPasPackage; AContext : TConvertContext): TJSElement;
-
-begin
-  Result:=Nil;
-  //  TPasPackage = class(TPasElement)
-end;
-
-Function TPasToJSConverter.ConvertResString(El: TPasResString; AContext : TConvertContext): TJSElement;
-
-begin
-  Result:=Nil;
-  //  TPasPackage = class(TPasElement)
-end;
-
-Function TPasToJSConverter.ConvertArgument(El: TPasArgument; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertPackage(El: TPasPackage;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192555);
   Result:=Nil;
-  //  TPasPackage = class(TPasElement)
+  // ToDo TPasPackage = class(TPasElement)
 end;
 
-Function TPasToJSConverter.ConvertResultElement(El: TPasResultElement; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertResString(El: TPasResString;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192604);
   Result:=Nil;
-  //  TPasPackage = class(TPasElement)
+  // ToDo: TPasResString
 end;
 
-Function TPasToJSConverter.ConvertVariable(El: TPasVariable; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertVariable(El: TPasVariable;
+  AContext: TConvertContext): TJSElement;
 
 Var
   V : TJSVarDeclaration;
-  T : TPasType;
-  L : TJSLiteral;
-
+  vm: TVariableModifier;
 begin
+  for vm in TVariableModifier do
+    if (vm in El.VarModifiers) and (not (vm in [vmClass,vmExternal])) then
+      RaiseNotSupported(El,AContext,20170208141622,'modifier '+VariableModifierNames[vm]);
+  if El.LibraryName<>nil then
+    RaiseNotSupported(El,AContext,20170208141844,'library name');
+  if El.AbsoluteLocation<>'' then
+    RaiseNotSupported(El,AContext,20170208141926,'absolute');
+
   V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
-  V.Name:=TransFormVariableName(EL,AContext);
-  T:=ResolveType(EL.VarType,AContext);
-  if (T is TPasArrayType) then
-    begin
-    V.Init:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,EL.VarType));
-    If Assigned(EL.Expr) then
-      Raise EPasToJS.Create(SerrInitalizedArray);
-    end
-  else If Assigned(EL.Expr) then
-    V.Init:=ConvertElement(El.Expr,AContext);
+  V.Name:=TransformVariableName(El,AContext);
+  V.Init:=CreateVarInit(El,AContext);
   Result:=V;
-  //  TPasPackage = class(TPasElement)
-end;
-
-Function TPasToJSConverter.ConvertConst(El: TPasConst; AContext : TConvertContext): TJSElement;
-
-begin
-  Result:=Nil;
-  //  TPasPackage = class(TPasElement)
 end;
 
-Function TPasToJSConverter.ConvertProperty(El: TPasProperty; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertProperty(El: TPasProperty;
+  AContext: TConvertContext): TJSElement;
 
 begin
   Result:=Nil;
-//  TPasProperty = class(TPasVariable)
-
+  if El.IndexExpr<>nil then
+    RaiseNotSupported(El.IndexExpr,AContext,20170215103010,'property index expression');
+  if El.ImplementsFunc<>nil then
+    RaiseNotSupported(El.ImplementsFunc,AContext,20170215102923,'property implements function');
+  if El.DispIDExpr<>nil then
+    RaiseNotSupported(El.DispIDExpr,AContext,20170215103029,'property dispid expression');
+  if El.DefaultExpr<>nil then
+    RaiseNotSupported(El.DefaultExpr,AContext,20170215103129,'property default modifier');
+  // does not need any declaration. Access is redirected to getter/setter.
 end;
 
-Function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192650);
   Result:=Nil;
-  //  TPasPackage = class(TPasElement)
+  // ToDo: TPasExportSymbol
 end;
 
-Function TPasToJSConverter.ConvertLabels(El: TPasLabels; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertLabels(El: TPasLabels;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192701);
   Result:=Nil;
-//  TPasLabels = class(TPasImplElement)
+  // ToDo: TPasLabels = class(TPasImplElement)
 end;
 
-Function TPasToJSConverter.ConvertRaiseStatement(El: TPasImplRaise; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertRaiseStatement(El: TPasImplRaise;
+  AContext: TConvertContext): TJSElement;
 
 Var
   E : TJSElement;
@@ -1171,450 +9728,1804 @@ Var
 
 begin
   if El.ExceptObject<>Nil then
-    E:=ConvertElement(El.ExceptObject)
+    E:=ConvertElement(El.ExceptObject,AContext)
   else
-    E:=CreateIdentifierExpr(GetExceptionObjectName(AContext),El,AContext);
+    E:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnExceptObject]);
   T:=TJSThrowStatement(CreateElement(TJSThrowStatement,El));
   T.A:=E;
   Result:=T;
 end;
 
-Function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
+  AContext: TConvertContext): TJSElement;
 
 Var
-  LHS,RHS : TJSElement;
-  T : TJSAssignStatement;
+  LHS: TJSElement;
+  T: TJSAssignStatement;
+  AssignContext: TAssignContext;
+  Flags: TPasResolverComputeFlags;
+  LeftIsProcType: Boolean;
 
 begin
-  LHS:=ConvertElement(El.left);
+  Result:=nil;
+  LHS:=nil;
+  AssignContext:=TAssignContext.Create(El,nil,AContext);
   try
-    RHS:=ConvertElement(El.Right);
-  except
-    FreeAndNil(LHS);
-    Raise;
-  end;
-  T:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-  T.Expr:=RHS;
-  T.LHS:=LHS;
-  Result:=T;
+    if AContext.Resolver<>nil then
+      begin
+      AContext.Resolver.ComputeElement(El.left,AssignContext.LeftResolved,[rcNoImplicitProc]);
+      Flags:=[];
+      LeftIsProcType:=AContext.Resolver.IsProcedureType(AssignContext.LeftResolved,true);
+      if LeftIsProcType then
+        begin
+        if msDelphi in AContext.CurrentModeSwitches then
+          Include(Flags,rcNoImplicitProc)
+        else
+          Include(Flags,rcNoImplicitProcType);
+        end;
+      AContext.Resolver.ComputeElement(El.right,AssignContext.RightResolved,Flags);
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.ConvertAssignStatement Left={',GetResolverResultDbg(AssignContext.LeftResolved),'} Right={',GetResolverResultDbg(AssignContext.RightResolved),'}');
+      {$ENDIF}
+      if LeftIsProcType and (msDelphi in AContext.CurrentModeSwitches)
+          and (AssignContext.RightResolved.BaseType=btProc) then
+        begin
+          // Delphi allows assigning a proc without @: proctype:=proc
+          AssignContext.RightSide:=CreateCallback(El.right,AssignContext.RightResolved,AContext);
+        end
+      else if AssignContext.RightResolved.BaseType=btNil then
+        begin
+        if AContext.Resolver.IsArrayType(AssignContext.LeftResolved) then
+          begin
+          // array:=nil -> array:=[]
+          AssignContext.RightSide:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El.right));
+          end;
+        end;
+      end;
+    if AssignContext.RightSide=nil then
+      AssignContext.RightSide:=ConvertElement(El.right,AContext);
+    if (AssignContext.RightResolved.BaseType=btSet)
+        and (AssignContext.RightResolved.IdentEl<>nil) then
+      begin
+      // right side is a set variable -> create reference
+      {$IFDEF VerbosePas2JS}
+      //writeln('TPasToJSConverter.ConvertAssignStatement SET variable Right={',GetResolverResultDbg(AssignContext.RightResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(AssignContext.RightResolved.IdentEl));
+      {$ENDIF}
+      // create  rtl.refSet(right)
+      AssignContext.RightSide:=CreateReferencedSet(El.right,AssignContext.RightSide);
+      end
+    else if AssignContext.RightResolved.BaseType=btContext then
+      begin
+      if AssignContext.RightResolved.TypeEl.ClassType=TPasRecordType then
+        begin
+        // right side is a record -> clone
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.ConvertAssignStatement RECORD variable Right={',GetResolverResultDbg(AssignContext.RightResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(AssignContext.RightResolved.IdentEl));
+        {$ENDIF}
+        // create  "new RightRecordType(RightRecord)"
+        AssignContext.RightSide:=CreateCloneRecord(El.right,
+                  AssignContext.RightResolved,AssignContext.RightSide,AContext);
+        end;
+      end;
+    LHS:=ConvertElement(El.left,AssignContext);
+    if AssignContext.Call<>nil then
+      begin
+      // left side is a Setter -> RightSide was already inserted as parameter
+      if AssignContext.RightSide<>nil then
+        RaiseInconsistency(20170207215544);
+      Result:=LHS;
+      end
+    else
+      begin
+      // left side is a variable -> create normal assign statement
+      case El.Kind of
+        akDefault: T:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+        akAdd: T:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,El));
+        akMinus: T:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,El));
+        akMul: T:=TJSMulEqAssignStatement(CreateElement(TJSMulEqAssignStatement,El));
+        akDivision: T:=TJSDivEqAssignStatement(CreateElement(TJSDivEqAssignStatement,El));
+        else RaiseNotSupported(El,AContext,20161107221807);
+      end;
+      T.Expr:=AssignContext.RightSide;
+      AssignContext.RightSide:=nil;
+      T.LHS:=LHS;
+      Result:=T;
+      end;
+  finally
+    if Result=nil then
+      LHS.Free;
+    AssignContext.RightSide.Free;
+    AssignContext.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertCommand(El: TPasImplCommand; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertCommand(El: TPasImplCommand;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192705);
   Result:=Nil;
-//  TPasImplCommand = class(TPasImplElement)
+  // ToDo: TPasImplCommand = class(TPasImplElement)
 end;
 
-Function TPasToJSConverter.ConvertIfStatement(El: TPasImplIfElse; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertIfStatement(El: TPasImplIfElse;
+  AContext: TConvertContext): TJSElement;
 
 Var
   C,BThen,BElse : TJSElement;
   T : TJSIfStatement;
+  ok: Boolean;
 
 begin
+  if AContext=nil then ;
   C:=Nil;
   BThen:=Nil;
   BElse:=Nil;
+  ok:=false;
   try
-    C:=ConvertElement(El.ConditionExpr);
+    C:=ConvertElement(El.ConditionExpr,AContext);
     if Assigned(El.IfBranch) then
-      BThen:=ConvertElement(El.IfBranch)
-    else
-      BThen:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
+      BThen:=ConvertElement(El.IfBranch,AContext);
     if Assigned(El.ElseBranch) then
-      BElse:=ConvertElement(El.ElseBranch);
-  except
-    FreeAndNil(C);
-    FreeAndNil(BThen);
-    FreeAndNil(BElse);
-    Raise;
+      BElse:=ConvertElement(El.ElseBranch,AContext);
+    ok:=true;
+  finally
+    if not ok then
+      begin
+      FreeAndNil(C);
+      FreeAndNil(BThen);
+      FreeAndNil(BElse);
+      end;
   end;
   T:=TJSIfStatement(CreateElement(TJSIfStatement,El));
   T.Cond:=C;
-  T.Btrue:=BThen;
+  T.BTrue:=BThen;
   T.BFalse:=BElse;
   Result:=T;
 end;
 
-Function TPasToJSConverter.ConvertWhileStatement(El: TPasImplWhileDo; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertWhileStatement(El: TPasImplWhileDo;
+  AContext: TConvertContext): TJSElement;
 
 Var
   C : TJSElement;
   B : TJSElement;
   W : TJSWhileStatement;
+  ok: Boolean;
 begin
   Result:=Nil;
   C:=Nil;
   B:=Nil;
+  ok:=false;
   try
     C:=ConvertElement(EL.ConditionExpr,AContext);
     if Assigned(EL.Body) then
       B:=ConvertElement(EL.Body,AContext)
     else
       B:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
-  except
-    FreeAndNil(B);
-    FreeAndNil(C);
-    Raise;
+    ok:=true;
+  finally
+    if not ok then
+      begin
+      FreeAndNil(B);
+      FreeAndNil(C);
+      end;
   end;
   W:=TJSWhileStatement(CreateElement(TJSWhileStatement,El));
   W.Cond:=C;
-  W.body:=B;
+  W.Body:=B;
   Result:=W;
 end;
 
-Function TPasToJSConverter.ConvertRepeatStatement(El: TPasImplRepeatUntil; AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertRepeatStatement(El: TPasImplRepeatUntil;
+  AContext: TConvertContext): TJSElement;
 Var
   C : TJSElement;
   N : TJSUnaryNotExpression;
   W : TJSDoWhileStatement;
   B : TJSElement;
+  ok: Boolean;
 
 begin
   Result:=Nil;
   C:=Nil;
   B:=Nil;
+  ok:=false;
   try
     C:=ConvertElement(EL.ConditionExpr,AContext);
     N:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,EL.ConditionExpr));
     N.A:=C;
-    B:=ConvertImplBlockElements(El,AContext);
-  except
-    FreeAndNil(B);
-    FreeAndNil(C);
-    Raise;
+    B:=ConvertImplBlockElements(El,AContext,false);
+    ok:=true;
+  finally
+    if not ok then
+      begin
+      FreeAndNil(B);
+      FreeAndNil(C);
+      end;
   end;
   W:=TJSDoWhileStatement(CreateElement(TJSDoWhileStatement,El));
   W.Cond:=N;
-  W.body:=B;
+  W.Body:=B;
   Result:=W;
 end;
 
-Function TPasToJSConverter.ConvertForStatement(El: TPasImplForLoop;
+function TPasToJSConverter.ConvertForStatement(El: TPasImplForLoop;
   AContext: TConvertContext): TJSElement;
+// Creates the following code:
+//   var $loopend=<EndExpr>;
+//   for(LoopVar=<StartExpr>; LoopVar<=$loopend; LoopVar++){}
+//   if(LoopVar>$loopend)LoopVar--; // this line is only added if LoopVar is read later
+//
+// The StartExpr must be executed exactly once at beginning.
+// The EndExpr must be executed exactly once at beginning.
+// LoopVar can be a varname or programname.varname
 
 Var
-  F : TJSForStatement;
-  L : TJSStatementList;
-  I : TJSSimpleAssignStatement;
-  V : TJSVarDeclaration;
-  VD : TJSVariableStatement;
-  u : TJSUNaryExpression;
-  B : TJSBinaryExpression;
-  MV : String;
+  ForSt : TJSForStatement;
+  List, ListEnd: TJSStatementList;
+  SimpleAss : TJSSimpleAssignStatement;
+  Incr, Decr : TJSUNaryExpression;
+  BinExp : TJSBinaryExpression;
+  VarStat: TJSVariableStatement;
+  IfSt: TJSIfStatement;
+  GTExpr: TJSRelationalExpression;
+  CurLoopEndVarName: String;
+  FuncContext: TConvertContext;
+  ResolvedVar: TPasResolverResult;
+
+  function NeedDecrAfterLoop: boolean;
+  var
+    ResolvedVar: TPasResolverResult;
+    aParent: TPasElement;
+    ProcBody: TProcedureBody;
+    FindData: TForLoopFindData;
+  begin
+    Result:=true;
+    if AContext.Resolver=nil then exit(false);
+    AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
+    if ResolvedVar.IdentEl=nil then
+      exit;
+    if ResolvedVar.IdentEl.Parent is TProcedureBody then
+      begin
+      // loopvar is a local var
+      ProcBody:=TProcedureBody(ResolvedVar.IdentEl.Parent);
+      aParent:=El;
+      while true do
+        begin
+        aParent:=aParent.Parent;
+        if aParent=nil then exit;
+        if aParent is TProcedureBody then
+          begin
+          if aParent<>ProcBody then exit;
+          break;
+          end;
+        end;
+      // loopvar is a local var of the same function as where the loop is
+      // -> check if it is read after the loop
+      FindData:=Default(TForLoopFindData);
+      FindData.ForLoop:=El;
+      FindData.LoopVar:=ResolvedVar.IdentEl;
+      ProcBody.Body.ForEachCall(@ForLoop_OnProcBodyElement,@FindData);
+      if not FindData.LoopVarRead then
+        exit(false);
+      end;
+  end;
 
 begin
   Result:=Nil;
-  B:=Nil;
-  L:=TJSStatementList(CreateElement(TJSStatementList,El));
-  Result:=L;
+  BinExp:=Nil;
+  if AContext.Access<>caRead then
+    RaiseInconsistency(20170213213740);
+  // get function context
+  FuncContext:=AContext;
+  while (FuncContext.Parent<>nil) and (not (FuncContext is TFunctionContext)) do
+    FuncContext:=FuncContext.Parent;
+  // create unique loopend var name
+  CurLoopEndVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoopEnd]);
+
+  // loopvar:=
+  // for (statementlist...
+  List:=TJSStatementList(CreateElement(TJSStatementList,El));
+  ListEnd:=List;
   try
-    VD:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
-    L.A:=VD;
-    V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
-    VD.A:=V;
-    MV:=TransFormVariableName(El.VariableName,AContext)+'$endloopvalue';
-    V.Name:=MV;
-    V.Init:=ConvertElement(EL.EndExpr,AContext);
-    F:=TJSForStatement(CreateElement(TJSForStatement,El));
-    L.B:=F;
-    I:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.StartExpr));
-    F.Init:=I;
-    I.LHS:=CreateIdentifierExpr(EL.VariableName,el,AContext);
-    I.Expr:=ConvertElement(El.StartExpr,AContext);
-    If El.Down then
+    // add "var $loopend=<EndExpr>"
+    VarStat:=CreateVarStatement(CurLoopEndVarName,
+      ConvertElement(El.EndExpr,AContext),El);
+    List.A:=VarStat;
+    // add "for()"
+    ForSt:=TJSForStatement(CreateElement(TJSForStatement,El));
+    List.B:=ForSt;
+    // add "LoopVar=<StartExpr>;"
+    SimpleAss:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El.StartExpr));
+    ForSt.Init:=SimpleAss;
+    if AContext.Resolver<>nil then
       begin
-      U:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El));
-      B:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.EndExpr));
-      end
+      AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
+      if not (ResolvedVar.IdentEl is TPasVariable) then
+        DoError(20170213214404,nExpectedXButFoundY,sExpectedXButFoundY,['var',
+          AContext.Resolver.GetResolverResultDescription(ResolvedVar)],El);
+      end;
+    SimpleAss.LHS:=ConvertElement(El.VariableName,AContext);
+    SimpleAss.Expr:=ConvertElement(El.StartExpr,AContext);
+    // add "LoopVar<=$loopend"
+    if El.Down then
+      BinExp:=TJSRelationalExpressionGE(CreateElement(TJSRelationalExpressionGE,El.EndExpr))
+    else
+      BinExp:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
+    ForSt.Cond:=BinExp;
+    BinExp.A:=ConvertElement(El.VariableName,AContext);
+    BinExp.B:=CreateIdentifierExpr(CurLoopEndVarName,El.EndExpr,AContext);
+    // add "LoopVar++"
+    if El.Down then
+      Incr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El))
     else
+      Incr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El));
+    ForSt.Incr:=Incr;
+    Incr.A:=ConvertElement(El.VariableName,AContext);
+    // add body
+    if El.Body<>nil then
+      ForSt.Body:=ConvertElement(El.Body,AContext);
+
+    if NeedDecrAfterLoop then
       begin
-      U:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El));
-      B:=TJSRelationalExpressionLE(CreateElement(TJSRelationalExpressionLE,El.EndExpr));
+      // add "if(LoopVar>$loopend)LoopVar--;"
+      // add "if()"
+      IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
+      AddToStatementList(List,ListEnd,IfSt,El);
+      // add "LoopVar>$loopend"
+      if El.Down then
+        GTExpr:=TJSRelationalExpressionLT(CreateElement(TJSRelationalExpressionLT,El))
+      else
+        GTExpr:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El));
+      IfSt.Cond:=GTExpr;
+      GTExpr.A:=ConvertElement(El.VariableName,AContext);
+      GTExpr.B:=CreateIdentifierExpr(CurLoopEndVarName,El.EndExpr,AContext);
+      // add "LoopVar--"
+      if El.Down then
+        Decr:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El))
+      else
+        Decr:=TJSUnaryPostMinusMinusExpression(CreateElement(TJSUnaryPostMinusMinusExpression,El));
+      IfSt.BTrue:=Decr;
+      Decr.A:=ConvertElement(El.VariableName,AContext);
       end;
-    F.Incr:=U;
-    F.Cond:=B;
-    U.A:=CreateIdentifierExpr(EL.VariableName,El,AContext);
-    B.A:=CreateIdentifierExpr(EL.VariableName,El,AContext);
-    B.B:=CreateIdentifierExpr(MV,El.EndExpr,AContext);
-    F.body:=ConvertElement(EL.Body);
-  except
-    FreeAndNil(Result);
-    Raise;
+    Result:=List;
+  finally
+    if Result=nil then
+      List.Free;
   end;
 end;
 
-Function TPasToJSConverter.ConvertSimpleStatement(El: TPasImplSimple; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertSimpleStatement(El: TPasImplSimple;
+  AContext: TConvertContext): TJSElement;
 
 Var
   E : TJSElement;
+  C: TClass;
 
 begin
   E:=ConvertElement(EL.Expr,AContext);
-  Result:=TJSExpressionStatement(CreateElement(TJSExpressionStatement,El));
-  TJSExpressionStatement(Result).A:=E;
+  if E=nil then
+    exit(nil); // e.g. "inherited;" without ancestor proc
+  C:=E.ClassType;
+  if (C=TJSExpressionStatement)
+      or (C=TJSStatementList) then
+    Result:=E
+  else
+    begin
+    Result:=TJSExpressionStatement(CreateElement(TJSExpressionStatement,El));
+    TJSExpressionStatement(Result).A:=E;
+    end;
 end;
 
-Function TPasToJSConverter.ConvertWithStatement(El: TPasImplWithDo; AContext : TConvertContext): TJSElement;
-
+function TPasToJSConverter.ConvertWithStatement(El: TPasImplWithDo;
+  AContext: TConvertContext): TJSElement;
 Var
-  B,E : TJSElement;
+  B,E , Expr: TJSElement;
   W,W2 : TJSWithStatement;
   I : Integer;
+  ok: Boolean;
+  PasExpr: TPasElement;
+  V: TJSVariableStatement;
+  FuncContext: TFunctionContext;
+  FirstSt, LastSt: TJSStatementList;
+  WithScope: TPasWithScope;
+  WithExprScope: TPas2JSWithExprScope;
 
 begin
-  W:=Nil;
-  Result:=Nil;
-  if Assigned(El.Body) then
-    B:=ConvertElement(El.Body,AContext)
+  Result:=nil;
+  if AContext.Resolver<>nil then
+    begin
+    // with Resolver:
+    // Insert for each expression a local var. Example:
+    //   with aPoint do X:=3;
+    // convert to
+    //   var $with1 = aPoint;
+    //   $with1.X = 3;
+    FuncContext:=TFunctionContext(AContext.GetContextOfType(TFunctionContext));
+    if FuncContext=nil then
+      RaiseInconsistency(20170212003759);
+    FirstSt:=nil;
+    LastSt:=nil;
+    try
+      WithScope:=El.CustomData as TPasWithScope;
+      for i:=0 to El.Expressions.Count-1 do
+        begin
+        PasExpr:=TPasElement(El.Expressions[i]);
+        Expr:=ConvertElement(PasExpr,AContext);
+
+        WithExprScope:=WithScope.ExpressionScopes[i] as TPas2JSWithExprScope;
+        if (Expr is TJSPrimaryExpressionIdent)
+            and IsValidJSIdentifier(TJSPrimaryExpressionIdent(Expr).Name) then
+          begin
+          // expression is already a local variable
+          WithExprScope.WithVarName:=String(TJSPrimaryExpressionIdent(Expr).Name);
+          Expr.Free;
+          end
+        else if Expr is TJSPrimaryExpressionThis then
+          begin
+          // expression is 'this'
+          WithExprScope.WithVarName:='this';
+          Expr.Free;
+          end
+        else
+          begin
+          // create unique local var name
+          WithExprScope.WithVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnWith]);
+          // create local "var $with1 = expr;"
+          V:=CreateVarStatement(WithExprScope.WithVarName,Expr,PasExpr);
+          AddToStatementList(FirstSt,LastSt,V,PasExpr);
+          end;
+        end;
+      if Assigned(El.Body) then
+        begin
+        B:=ConvertElement(El.Body,AContext);
+        AddToStatementList(FirstSt,LastSt,B,El.Body);
+        end;
+      Result:=FirstSt;
+    finally
+      if Result=nil then
+        FreeAndNil(FirstSt);
+    end;
+    end
   else
-    B:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
-  try
-    For I:=0 to El.Expressions.Count-1 do
-      begin
-      E:=ConvertElement(TPasElement(El.Expressions[i]),AContext);
-      W2:=TJSWithStatement(CreateElement(TJSWithStatement,TPasElement(El.Expressions[i])));
-      if Not Assigned(Result) then // result is the first
-        Result:=W2;
-      if Assigned(W) then // Chain
-        W.B:=W2;
-      W:=W2; // W is the last
-      W.A:=E;
-      end;
-  except
-    FreeAndNil(E);
-    FreeAndNil(Result);
-    Raise;
-  end;
-  W.B:=B;
+    begin
+    // without Resolver use as fallback the JavaScript with(){}
+    W:=Nil;
+    if Assigned(El.Body) then
+      B:=ConvertElement(El.Body,AContext)
+    else
+      B:=TJSEmptyBlockStatement(CreateElement(TJSEmptyBlockStatement,El));
+    ok:=false;
+    try
+      For I:=0 to El.Expressions.Count-1 do
+        begin
+        E:=ConvertElement(TPasElement(El.Expressions[i]),AContext);
+        W2:=TJSWithStatement(CreateElement(TJSWithStatement,TPasElement(El.Expressions[i])));
+        if Not Assigned(Result) then // result is the first
+          Result:=W2;
+        if Assigned(W) then // Chain
+          W.B:=W2;
+        W:=W2; // W is the last
+        W.A:=E;
+        end;
+      ok:=true;
+    finally
+      if not ok then
+        begin
+        FreeAndNil(E);
+        FreeAndNil(Result);
+        end;
+    end;
+    W.B:=B;
+    end;
 end;
 
-Function TPasToJSConverter.GetExceptionObjectname(AContext: TConvertContext): String;
+function TPasToJSConverter.IsElementUsed(El: TPasElement): boolean;
+begin
+  if Assigned(OnIsElementUsed) then
+    Result:=OnIsElementUsed(Self,El)
+  else
+    Result:=true;
+end;
 
+function TPasToJSConverter.IsSystemUnit(aModule: TPasModule): boolean;
 begin
-  Result:='jsexception';
+  Result:=CompareText(aModule.Name,'system')=0;
 end;
 
-Function TPasToJSConverter.ResolveType(El: TPasElement;
-  AContext: TConvertContext): TPasType;
+function TPasToJSConverter.HasTypeInfo(El: TPasType; AContext: TConvertContext
+  ): boolean;
 begin
-  if EL is TPasType then
-    Result:=TPasType(El) // TPasUnresolvedTypeRef needs handling here
-  else
-    Result:=Nil;
+  Result:=false;
+  if coNoTypeInfo in Options then exit;
+  if AContext.Resolver=nil then exit;
+  if not AContext.Resolver.HasTypeInfo(El) then exit;
+  if Assigned(OnIsTypeInfoUsed) and not OnIsTypeInfoUsed(Self,El) then exit;
+  Result:=true;
 end;
-function TPasToJSConverter.CreateCallStatement(const caltname: string;
-  para: array of string): TJSCallExpression;
+
+function TPasToJSConverter.IsClassRTTICreatedBefore(aClass: TPasClassType;
+  Before: TPasElement): boolean;
 var
-  call: TJSCallExpression;
-  pex2: TJSPrimaryExpressionIdent;
+  Decls: TPasDeclarations;
+  i: Integer;
+  Types: TFPList;
+  T: TPasType;
+  C: TClass;
 begin
-  pex2 := TJSPrimaryExpressionIdent.Create(0, 0, '');
-  pex2.Name := caltname;
-  call := CreateCallStatement(pex2, para);
-  Result := call;
+  Result:=false;
+  if aClass.Parent=nil then exit;
+  if not aClass.Parent.InheritsFrom(TPasDeclarations) then
+    RaiseInconsistency(20170412101457);
+  Decls:=TPasDeclarations(aClass.Parent);
+  Types:=Decls.Types;
+  for i:=0 to Types.Count-1 do
+    begin
+    T:=TPasType(Types[i]);
+    if T=Before then exit;
+    if T=aClass then exit(true);
+    C:=T.ClassType;
+    if C=TPasClassType then
+      begin
+      if TPasClassType(T).IsForward and (T.CustomData is TResolvedReference)
+          and (TResolvedReference(T.CustomData).Declaration=aClass) then
+        exit(true);
+      end
+    else if C=TPasClassOfType then
+      begin
+      if TPasClassOfType(T).DestType=aClass then exit(true);
+      end;
+    end;
 end;
 
-function TPasToJSConverter.CreateCallStatement(const pex2: TJSElement;
-  para: array of string): TJSCallExpression;
-var
-  p: string;
-  pex3: TJSPrimaryExpressionIdent;
-  call: TJSCallExpression;
-  argarray: TJSArguments;
+procedure TPasToJSConverter.RaiseInconsistency(Id: int64);
 begin
-  call := TJSCallExpression.Create(0, 0, '');
-  call.Expr := pex2;
-  argarray := TJSArguments.Create(0, 0, '');
-  call.Args := argarray;
-  for p in para do
-  begin
-    pex3 := TJSPrimaryExpressionIdent.Create(0, 0, '');
-    pex3.Name := p;
-    argarray.Elements.AddElement.Expr := pex3;
-  end;
-  Result := call;
+  raise Exception.Create('TPasToJSConverter.RaiseInconsistency['+IntToStr(Id)+']: you found a bug');
 end;
 
-function TPasToJSConverter.CreateUnary(ms: array of string; E: TJSElement): TJSUnary;
+function TPasToJSConverter.CreateUnary(Members: array of string; E: TJSElement): TJSUnary;
 var
   unary: TJSUnary;
   asi: TJSSimpleAssignStatement;
-  mem1: TJSDotMemberExpression;
 begin
   unary := TJSUnary.Create(0, 0, '');
-  //mainbody.A:=unary;
   asi := TJSSimpleAssignStatement.Create(0, 0, '');
   unary.A := asi;
   asi.Expr := E;
-  asi.LHS := CreateMemberExpression(ms);
+  asi.LHS := CreateMemberExpression(Members);
   Result := unary;
 end;
 
-function TPasToJSConverter.CreateMemberExpression(ms: array of string): TJSDotMemberExpression;
+function TPasToJSConverter.CreateMemberExpression(Members: array of string): TJSDotMemberExpression;
 var
   pex: TJSPrimaryExpressionIdent;
-  mem2: TJSDotMemberExpression;
-  mem1: TJSDotMemberExpression;
+  MExpr: TJSDotMemberExpression;
+  LastMExpr: TJSDotMemberExpression;
   k: integer;
-  m: string;
 begin
-  if Length(ms) < 2 then
-    DoError('member exprision with les than two member');
-  k := 0;
-  for m in ms do
+  if Length(Members) < 2 then
+    DoError(20161024192715,'internal error: member expression with less than two members');
+  LastMExpr := nil;
+  for k:=High(Members) downto Low(Members)+1 do
   begin
-    mem1 := mem2;
-    mem2 := TJSDotMemberExpression.Create(0, 0, '');
-    mem2.Name := ms[k];
-    if k = 0 then
-      Result := mem2
+    MExpr := TJSDotMemberExpression.Create(0, 0, '');
+    MExpr.Name := TJSString(Members[k]);
+    if LastMExpr=nil then
+      Result := MExpr
     else
-      mem1.Mexpr := mem2;
-    Inc(k);
+      LastMExpr.MExpr := MExpr;
+    LastMExpr := MExpr;
   end;
-  mem2.Free;
   pex := TJSPrimaryExpressionIdent.Create(0, 0, '');
-  pex.Name := ms[k - 1];
-  mem1.Mexpr := pex;
+  pex.Name := TJSString(Members[Low(Members)]);
+  LastMExpr.MExpr := pex;
+end;
+
+function TPasToJSConverter.CreateCallExpression(El: TPasElement
+  ): TJSCallExpression;
+begin
+  Result:=TJSCallExpression(CreateElement(TJSCallExpression,El));
+  Result.Args:=TJSArguments(CreateElement(TJSArguments,El));
+end;
+
+function TPasToJSConverter.CreateUsesList(UsesSection: TPasSection;
+  AContext: TConvertContext): TJSArrayLiteral;
+var
+  ArgArray: TJSArrayLiteral;
+  i: Integer;
+  anUnitName: String;
+  ArgEx: TJSLiteral;
+  UsesClause: TPasUsesClause;
+  aModule: TPasModule;
+begin
+  UsesClause:=UsesSection.UsesClause;
+  ArgArray:=TJSArrayLiteral.Create(0,0);
+  for i:=0 to length(UsesClause)-1 do
+    begin
+    aModule:=UsesClause[i].Module as TPasModule;
+    if (not IsElementUsed(aModule)) and not IsSystemUnit(aModule) then
+      continue;
+    anUnitName := TransformModuleName(aModule,false,AContext);
+    ArgEx := CreateLiteralString(UsesSection,anUnitName);
+    ArgArray.Elements.AddElement.Expr := ArgEx;
+    end;
+  Result:=ArgArray;
 end;
-Procedure TPasToJSConverter.Addproceduretoclass(sl: TJSStatementList;
-  E: TJSElement; const P: TPasProcedure);
+
+procedure TPasToJSConverter.AddToStatementList(var First,
+  Last: TJSStatementList; Add: TJSElement; Src: TPasElement);
 var
-  clname, funname, varname: string;
-  classfound: boolean;
-  fundec, fd, main_const: TJSFunctionDeclarationStatement;
   SL2: TJSStatementList;
-  un1: TJSUnary;
-  asi: TJSAssignStatement;
-begin
-  SL2 := TJSStatementList(sl);
-  clname := Copy(p.Name, 1, Pos('.', P.Name) - 1);
-  funname := Copy(p.Name, Pos('.', P.Name) + 1, Length(p.Name) - Pos('.', P.Name));
-  classfound := False;
-  while Assigned(SL2) and (not classfound) do
-  begin
-    if SL2.A is TJSUnary then
+begin
+  if Add=nil then exit;
+  if Add is TJSStatementList then
+    begin
+    // add list
+    if TJSStatementList(Add).A=nil then
+      begin
+      // empty list -> skip
+      if TJSStatementList(Add).B<>nil then
+        raise Exception.Create('internal error: AddToStatementList add list A=nil, B<>nil, B='+TJSStatementList(Add).B.ClassName);
+      FreeAndNil(Add);
+      end
+    else if Last=nil then
+      begin
+      // our list is not yet started -> simply take the extra list
+      Last:=TJSStatementList(Add);
+      First:=Last;
+      end
+    else
+      begin
+      // merge lists (append)
+      if Last.B<>nil then
+        begin
+        // add a nil to the end of chain
+        SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
+        SL2.A:=Last.B;
+        Last.B:=SL2;
+        Last:=SL2;
+        // Last.B is now nil
+        end;
+      Last.B:=Add;
+      while Last.B is TJSStatementList do
+        Last:=TJSStatementList(Last.B);
+      end;
+    end
+  else
     begin
-      un1 := TJSUnary(SL2.A);
-      asi := TJSAssignStatement(un1.A);
-      varname := TJSPrimaryExpressionIdent(asi.LHS).Name;
-      if varname = (clname) then
+    if Last=nil then
+      begin
+      // start list
+      Last:=TJSStatementList(CreateElement(TJSStatementList,Src));
+      First:=Last;
+      Last.A:=Add;
+      end
+    else if Last.B=nil then
+      // second element
+      Last.B:=Add
+    else
       begin
-        classfound := True;
-        fd := TJSFunctionDeclarationStatement(TJSCallExpression(asi.Expr).Expr);
+      // add to chain
+      while Last.B is TJSStatementList do
+        Last:=TJSStatementList(Last.B);
+      SL2:=TJSStatementList(CreateElement(TJSStatementList,Src));
+      SL2.A:=Last.B;
+      Last.B:=SL2;
+      Last:=SL2;
+      Last.B:=Add;
       end;
     end;
-    SL2 := TJSStatementList(SL2.B);
-  end;
+end;
 
-  if not (classfound) then
-    Exit;
+function TPasToJSConverter.CreateValInit(PasType: TPasType; Expr: TPasElement;
+  El: TPasElement; AContext: TConvertContext): TJSElement;
+var
+  T: TPasType;
+  Lit: TJSLiteral;
+  bt: TResolverBaseType;
+  JSBaseType: TPas2jsBaseType;
+  C: TClass;
+begin
+  T:=PasType;
+  if AContext.Resolver<>nil then
+    T:=AContext.Resolver.ResolveAliasType(T);
 
-  fundec := GetFunctionDefinitionInUnary(fd, funname, True);
-  if Assigned(fundec) then
-  begin
-    if (p is TPasConstructor) then
+  //writeln('START TPasToJSConverter.CreateValInit PasType=',GetObjName(PasType),' El=',GetObjName(El),' T=',GetObjName(T),' Expr=',GetObjName(Expr));
+  if T=nil then
     begin
-      main_const := GetFunctionDefinitionInUnary(fd, clname, False);
-      main_const.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
-      main_const.AFunction.Name := clname;
+    // untyped var/const
+    if Expr=nil then
+      begin
+      if AContext.Resolver=nil then
+        exit(CreateLiteralUndefined(El));
+      RaiseInconsistency(20170415185745);
+      end;
+    Result:=ConvertElement(Expr,AContext);
+    if Result=nil then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateValInit PasType=',GetObjName(PasType),' El=',GetObjName(El),' T=',GetObjName(T),' Expr=',GetObjName(Expr));
+      {$ENDIF}
+      RaiseNotSupported(Expr,AContext,20170415185927);
+      end;
+    exit;
+    end;
+
+  C:=T.ClassType;
+  if C=TPasArrayType then
+    Result:=CreateArrayInit(TPasArrayType(T),Expr,El,AContext)
+  else if C=TPasRecordType then
+    Result:=CreateRecordInit(TPasRecordType(T),Expr,El,AContext)
+  else if Assigned(Expr) then
+    Result:=ConvertElement(Expr,AContext)
+  else if C=TPasSetType then
+    Result:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El))
+  else
+    begin
+    // always init with a default value to create a typed variable (faster and more readable)
+    Lit:=TJSLiteral(CreateElement(TJSLiteral,El));
+    Result:=Lit;
+    if (C=TPasPointerType)
+        or (C=TPasClassType)
+        or (C=TPasClassOfType)
+        or (C=TPasProcedureType)
+        or (C=TPasFunctionType) then
+      Lit.Value.IsNull:=true
+    else if C=TPasStringType then
+      Lit.Value.AsString:=''
+    else if C=TPasEnumType then
+      Lit.Value.AsNumber:=0
+    else if C=TPasUnresolvedSymbolRef then
+      begin
+      if T.CustomData is TResElDataBaseType then
+        begin
+        bt:=TResElDataBaseType(T.CustomData).BaseType;
+        if bt in btAllJSInteger then
+          Lit.Value.AsNumber:=0
+        else if bt in btAllJSFloats then
+          Lit.Value.CustomValue:='0.0'
+        else if bt in btAllJSStringAndChars then
+          Lit.Value.AsString:=''
+        else if bt in btAllJSBooleans then
+          Lit.Value.AsBoolean:=false
+        else if bt in [btNil,btPointer,btProc] then
+          Lit.Value.IsNull:=true
+        else if (bt=btCustom) and (T.CustomData is TResElDataPas2JSBaseType) then
+          begin
+          JSBaseType:=TResElDataPas2JSBaseType(T.CustomData).JSBaseType;
+          if JSBaseType=pbtJSValue then
+            Lit.Value.IsUndefined:=true;
+          end
+        else
+          begin
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.CreateVarInit unknown PasType T=',GetObjName(T),' basetype=',AContext.Resolver.BaseTypeNames[bt]);
+          {$ENDIF}
+          RaiseNotSupported(PasType,AContext,20170208162121);
+          end;
+        end
+      else if AContext.Resolver<>nil then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateValInit PasType=',GetObjName(PasType),' El=',GetObjName(El),' T=',GetObjName(T),' Expr=',GetObjName(Expr));
+        {$ENDIF}
+        RaiseNotSupported(El,AContext,20170415190259);
+        end
+      else if (CompareText(T.Name,'longint')=0)
+           or (CompareText(T.Name,'int64')=0)
+           or (CompareText(T.Name,'real')=0)
+           or (CompareText(T.Name,'double')=0)
+           or (CompareText(T.Name,'single')=0) then
+        Lit.Value.AsNumber:=0.0
+      else if (CompareText(T.Name,'boolean')=0) then
+        Lit.Value.AsBoolean:=false
+      else if (CompareText(T.Name,'string')=0)
+           or (CompareText(T.Name,'char')=0)
+      then
+        Lit.Value.AsString:=''
+      else
+        begin
+        Lit.Value.IsUndefined:=true;
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateVarInit unknown PasType class=',T.ClassName,' name=',T.Name);
+        {$ENDIF}
+        end;
+      end
+    else
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateValInit unknown PasType ',GetObjName(T));
+      {$ENDIF}
+      RaiseNotSupported(PasType,AContext,20170208161506);
+      end;
+    end;
+  if Result=nil then
+    begin
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.CreateValInit PasType=',GetObjName(PasType),' El=',GetObjName(El),' T=',GetObjName(T),' Expr=',GetObjName(Expr));
+    {$ENDIF}
+    RaiseNotSupported(El,AContext,20170415190103);
+    end;
+end;
+
+function TPasToJSConverter.CreateVarInit(El: TPasVariable;
+  AContext: TConvertContext): TJSElement;
+begin
+  Result:=CreateValInit(El.VarType,El.Expr,El,AContext);
+end;
+
+function TPasToJSConverter.CreateVarStatement(const aName: String;
+  Init: TJSElement; El: TPasElement): TJSVariableStatement;
+// craete "var aname = init"
+begin
+  Result:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
+  Result.A:=CreateVarDecl(aName,Init,El);
+end;
+
+function TPasToJSConverter.CreateVarDecl(const aName: String; Init: TJSElement;
+  El: TPasElement): TJSVarDeclaration;
+begin
+  Result:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,El));
+  Result.Name:=aName;
+  Result.Init:=Init;
+end;
+
+function TPasToJSConverter.CreateLiteralNumber(El: TPasElement;
+  const n: TJSNumber): TJSLiteral;
+begin
+  Result:=TJSLiteral(CreateElement(TJSLiteral,El));
+  Result.Value.AsNumber:=n;
+end;
+
+function TPasToJSConverter.CreateLiteralString(El: TPasElement; const s: string
+  ): TJSLiteral;
+begin
+  Result:=TJSLiteral(CreateElement(TJSLiteral,El));
+  Result.Value.AsString:=TJSString(s);
+end;
+
+function TPasToJSConverter.CreateLiteralJSString(El: TPasElement;
+  const s: TJSString): TJSLiteral;
+begin
+  Result:=TJSLiteral(CreateElement(TJSLiteral,El));
+  Result.Value.AsString:=s;
+end;
+
+function TPasToJSConverter.CreateLiteralBoolean(El: TPasElement; b: boolean
+  ): TJSLiteral;
+begin
+  Result:=TJSLiteral(CreateElement(TJSLiteral,El));
+  Result.Value.AsBoolean:=b;
+end;
+
+function TPasToJSConverter.CreateLiteralNull(El: TPasElement): TJSLiteral;
+begin
+  Result:=TJSLiteral(CreateElement(TJSLiteral,El));
+  Result.Value.IsNull:=true;
+end;
+
+function TPasToJSConverter.CreateLiteralUndefined(El: TPasElement): TJSLiteral;
+begin
+  Result:=TJSLiteral(CreateElement(TJSLiteral,El));
+  Result.Value.IsUndefined:=true;
+end;
+
+function TPasToJSConverter.CreateSetLiteralElement(Expr: TPasExpr;
+  AContext: TConvertContext): TJSElement;
+var
+  LitVal: TJSValue;
+  NewEl: TJSElement;
+  WS: TJSString;
+  ExprResolved: TPasResolverResult;
+  Call: TJSCallExpression;
+  DotExpr: TJSDotMemberExpression;
+begin
+  Result:=ConvertElement(Expr,AContext);
+  if Result=nil then
+    RaiseNotSupported(Expr,AContext,20170415192209);
+  if Result.ClassType=TJSLiteral then
+    begin
+    // argument is a literal  -> convert to number
+    LitVal:=TJSLiteral(Result).Value;
+    case LitVal.ValueType of
+      jstBoolean:
+        begin
+        if LitVal.AsBoolean=LowJSBoolean then
+          NewEl:=CreateLiteralNumber(Expr,0)
+        else
+          NewEl:=CreateLiteralNumber(Expr,1);
+        Result.Free;
+        exit(NewEl);
+        end;
+      jstNumber:
+        exit;
+      jstString:
+        begin
+        WS:=LitVal.AsString;
+        Result.Free;
+        if length(WS)<>1 then
+          DoError(20170415193254,nXExpectedButYFound,sXExpectedButYFound,['char','string'],Expr);
+        Result:=CreateLiteralNumber(Expr,ord(WS[1]));
+        exit;
+        end;
+    else
+      RaiseNotSupported(Expr,AContext,20170415205955);
+    end;
     end
+  else if Result.ClassType=TJSCallExpression then
+    begin
+    Call:=TJSCallExpression(Result);
+    if (Call.Expr is TJSDotMemberExpression) then
+      begin
+      DotExpr:=TJSDotMemberExpression(Call.Expr);
+      if DotExpr.Name='charCodeAt' then
+        exit;
+      if DotExpr.Name='charAt' then
+        begin
+        DotExpr.Name:='charCodeAt';
+        exit;
+        end;
+      end;
+    end;
+
+  if AContext.Resolver<>nil then
+    begin
+    AContext.Resolver.ComputeElement(Expr,ExprResolved,[]);
+    if ExprResolved.BaseType in btAllJSStringAndChars then
+      begin
+      // aChar -> aChar.charCodeAt()
+      Call:=TJSCallExpression(CreateElement(TJSCallExpression,Expr));
+      Call.Expr:=CreateDotExpression(Expr,Result,CreatePrimitiveDotExpr('charCodeAt'));
+      Result:=Call;
+      end
+    else if ExprResolved.BaseType=btContext then
+      begin
+      if ExprResolved.TypeEl.ClassType=TPasEnumType then
+        // ok
+      else
+        RaiseNotSupported(Expr,AContext,20170415191933);
+      end
     else
+      RaiseNotSupported(Expr,AContext,20170415191822);
+    end;
+end;
+
+function TPasToJSConverter.ClonePrimaryExpression(El: TJSPrimaryExpression;
+  Src: TPasElement): TJSPrimaryExpression;
+begin
+  Result:=TJSPrimaryExpression(CreateElement(TJSElementClass(El.ClassType),Src));
+  if Result.ClassType=TJSPrimaryExpressionIdent then
+    TJSPrimaryExpressionIdent(Result).Name:=TJSPrimaryExpressionIdent(El).Name;
+end;
+
+function TPasToJSConverter.CreateRecordInit(aRecord: TPasRecordType;
+  Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;
+// new recordtype()
+var
+  NewMemE: TJSNewMemberExpression;
+begin
+  if Expr<>nil then
+    RaiseNotSupported(Expr,AContext,20161024192747);
+  NewMemE:=TJSNewMemberExpression(CreateElement(TJSNewMemberExpression,El));
+  Result:=NewMemE;
+  NewMemE.MExpr:=CreateReferencePathExpr(aRecord,AContext);
+end;
+
+function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
+  Expr: TPasElement; El: TPasElement; AContext: TConvertContext): TJSElement;
+var
+  Call: TJSCallExpression;
+  DimArray, ArrLit: TJSArrayLiteral;
+  i, DimSize: Integer;
+  RangeResolved, ElTypeResolved, ExprResolved: TPasResolverResult;
+  Range: TPasExpr;
+  Lit: TJSLiteral;
+  CurArrayType: TPasArrayType;
+  DefaultValue: TJSElement;
+  ArrayValues: TPasExprArray;
+begin
+  if Assigned(Expr) then
     begin
-      fundec.AFunction := TJSFunctionDeclarationStatement(E).AFunction;
-      fundec.AFunction.Name := '';
+    // init array with constant(s)
+    if AContext.Resolver=nil then
+      DoError(20161024192739,nInitializedArraysNotSupported,sInitializedArraysNotSupported,[],ArrayType);
+    ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+    try
+      AContext.Resolver.ComputeElement(Expr,ExprResolved,[rcConstant]);
+      if (ExprResolved.BaseType=btSet)
+          and (ExprResolved.ExprEl is TArrayValues) then
+        begin
+        ArrayValues:=TArrayValues(ExprResolved.ExprEl).Values;
+        for i:=0 to length(ArrayValues)-1 do
+          ArrLit.Elements.AddElement.Expr:=ConvertElement(ArrayValues[i],AContext);
+        end
+      else
+        RaiseNotSupported(Expr,AContext,20170223133034);
+      Result:=ArrLit;
+    finally
+      if Result=nil then
+        ArrLit.Free;
+    end;
+    end
+  else if length(ArrayType.Ranges)=0 then
+    begin
+    // empty dynamic array: []
+    Result:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+    end
+  else
+    begin
+    // static array
+    // create "rtl.arrayNewMultiDim([dim1,dim2,...],defaultvalue)"
+    if AContext.Resolver=nil then
+      RaiseNotSupported(El,AContext,20170223113050,'');
+    Result:=nil;
+    try
+      Call:=CreateCallExpression(El);
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_NewMultiDim]]);
+      // add parameter [dim1,dim2,...]
+      DimArray:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+      Call.AddArg(DimArray);
+      CurArrayType:=ArrayType;
+      while true do
+        begin
+        for i:=0 to length(CurArrayType.Ranges)-1 do
+          begin
+          Range:=CurArrayType.Ranges[i];
+          // compute size of this dimension
+          AContext.Resolver.ComputeElement(Range,RangeResolved,[rcConstant]);
+          DimSize:=AContext.Resolver.GetRangeLength(RangeResolved);
+          if DimSize=0 then
+            RaiseNotSupported(Range,AContext,20170223113318);
+          Lit:=CreateLiteralNumber(El,DimSize);
+          DimArray.Elements.AddElement.Expr:=Lit;
+          end;
+        AContext.Resolver.ComputeElement(CurArrayType.ElType,ElTypeResolved,[rcType]);
+        if (ElTypeResolved.TypeEl is TPasArrayType) then
+          begin
+          CurArrayType:=TPasArrayType(ElTypeResolved.TypeEl);
+          if length(CurArrayType.Ranges)>0 then
+            begin
+            // nested static array
+            continue;
+            end;
+          end;
+        break;
+        end;
+
+      // add parameter defaultvalue
+      DefaultValue:=CreateValInit(ElTypeResolved.TypeEl,nil,El,AContext);
+      Call.AddArg(DefaultValue);
+
+      Result:=Call;
+    finally
+      if Result=nil then
+        Call.Free;
+    end;
     end;
-  end;
 end;
 
-function TPasToJSConverter.GetFunctionDefinitionInUnary(
-  const fd: TJSFunctionDeclarationStatement; const funname: string;
-  inunary: boolean): TJSFunctionDeclarationStatement;
+function TPasToJSConverter.CreateCmpArrayWithNil(El: TPasElement;
+  JSArray: TJSElement; OpCode: TExprOpCode): TJSElement;
 var
-  k: integer;
-  fundec: TJSFunctionDeclarationStatement;
-  je: TJSElement;
-  cname: TJSString;
+  Call: TJSCallExpression;
+  BinExpr: TJSBinaryExpression;
 begin
-  Result := nil;
-  for k := 0 to TJSSourceElements(FD.AFunction.Body.A).Statements.Count - 1 do
+  if not (OpCode in [eopEqual,eopNotEqual]) then
+    RaiseInconsistency(20170401184819);
+  Call:=CreateCallExpression(El);
+  Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_Length]]);
+  Call.AddArg(JSArray);
+  if OpCode=eopEqual then
+    BinExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,El))
+  else
+    BinExpr:=TJSRelationalExpressionGT(CreateElement(TJSRelationalExpressionGT,El));
+  BinExpr.A:=Call;
+  BinExpr.B:=CreateLiteralNumber(El,0);
+  Result:=BinExpr;
+end;
+
+function TPasToJSConverter.CreateReferencePath(El: TPasElement;
+  AContext: TConvertContext; Kind: TRefPathKind; Full: boolean;
+  Ref: TResolvedReference): string;
+{ Notes:
+ - local var, argument or result variable, even higher lvl does not need a reference path
+   local vars are also argument, result var, result variable
+ - with context uses the local $withnnn var
+ - auto created local var
+ otherwise use absolute path
+}
+
+  function GetReferenceEl: TPasElement;
+  begin
+    if Ref<>nil then
+      Result:=Ref.Element
+    else
+      Result:=El;
+  end;
+
+  function IsLocalVar: boolean;
+  begin
+    Result:=false;
+    if El.ClassType=TPasArgument then
+      exit(true);
+    if El.ClassType=TPasResultElement then
+      exit(true);
+    if AContext.Resolver=nil then
+      exit(true);
+    if El.Parent=nil then
+      RaiseNotSupported(El,AContext,20170203121306,GetObjName(El));
+    if El.Parent.ClassType=TPasImplExceptOn then
+      exit(true);
+    if not (El.Parent is TProcedureBody) then exit;
+    Result:=true;
+  end;
+
+  procedure Prepend(var aPath: string; Prefix: string);
+  begin
+    if aPath<>'' then
+      aPath:='.'+aPath;
+    aPath:=Prefix+aPath;
+  end;
+
+  function IsClassFunction(Proc: TPasElement): boolean;
+  var
+    C: TClass;
+  begin
+    if Proc=nil then exit(false);
+    C:=Proc.ClassType;
+    Result:=(C=TPasClassFunction) or (C=TPasClassProcedure)
+         or (C=TPasClassConstructor) or (C=TPasClassDestructor);
+  end;
+
+  procedure Append_GetClass(Member: TPasElement);
   begin
-    je := TJSSourceElements(FD.AFunction.Body.A).Statements.Nodes[k].Node;
-    if inunary then
-      cname := GetFunctionUnaryName(je, fundec)
+    if (Member.Parent as TPasClassType).IsExternal then
+      exit;
+    if Result<>'' then
+      Result:=Result+'.'+FBuiltInNames[pbivnPtrClass]
+    else
+      Result:=FBuiltInNames[pbivnPtrClass];
+  end;
+
+var
+  FoundModule: TPasModule;
+  ParentEl: TPasElement;
+  Dot: TDotContext;
+  WithData: TPas2JSWithExprScope;
+  ProcScope: TPasProcedureScope;
+  ShortName: String;
+  SelfContext: TFunctionContext;
+begin
+  Result:='';
+  {$IFDEF VerbosePas2JS}
+  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' SelfContext=',GetObjName(AContext.GetSelfContext));
+  //AContext.WriteStack;
+  {$ENDIF}
+
+  if AContext is TDotContext then
+    begin
+    Dot:=TDotContext(AContext);
+    if Dot.Resolver<>nil then
+      begin
+      if El is TPasVariable then
+        begin
+        //writeln('TPasToJSConverter.CreateReferencePath Left=',GetResolverResultDbg(Dot.LeftResolved),' Right=class var ',GetObjName(El));
+        if (ClassVarModifiersType*TPasVariable(El).VarModifiers<>[])
+            and (Dot.Access=caAssign)
+            and Dot.Resolver.ResolvedElIsClassInstance(Dot.LeftResolved) then
+          begin
+          // writing a class var
+          Append_GetClass(El);
+          end;
+        end
+      else if IsClassFunction(El) then
+        begin
+        if Dot.Resolver.ResolvedElIsClassInstance(Dot.LeftResolved) then
+          // accessing a class method from an object, 'this' must be the class
+          Append_GetClass(El);
+        end;
+      end;
+    end
+  else if (Ref<>nil) and (Ref.WithExprScope<>nil) then
+    begin
+    // using local WITH var
+    WithData:=Ref.WithExprScope as TPas2JSWithExprScope;
+    Prepend(Result,WithData.WithVarName);
+    end
+  else if IsLocalVar then
+    begin
+    // El is local var -> does not need path
+    end
+  else if (El is TPasProcedure) and (TPasProcedure(El).LibrarySymbolName<>nil)
+      and not (El.Parent is TPasClassType) then
+    begin
+    // an external function -> use the literal
+    if Kind=rpkPathAndName then
+      Result:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,AContext,true)
     else
+      Result:='';
+    exit;
+    end
+  else if (El is TPasVariable) and (TPasVariable(El).ExportName<>nil)
+      and not (El.Parent is TPasClassType) then
+    begin
+    // an external var -> use the literal
+    if Kind=rpkPathAndName then
+      Result:=ComputeConstString(TPasVariable(El).ExportName,AContext,true)
+    else
+      Result:='';
+    exit;
+    end
+  else if (El.ClassType=TPasClassType) and TPasClassType(El).IsExternal then
+    begin
+    // an external var -> use the literal
+    Result:=TPasClassType(El).ExternalName;
+    exit;
+    end
+  else
     begin
-      if je is TJSFunctionDeclarationStatement then
+    // need full path
+    if El.Parent=nil then
+      RaiseNotSupported(El,AContext,20170201172141,GetObjName(El));
+    if (El.CustomData is TPasProcedureScope) then
       begin
-        cname := TJSFunctionDeclarationStatement(je).AFunction.Name;
-        fundec := TJSFunctionDeclarationStatement(je);
+      // proc: always use the the declaration, not the body
+      ProcScope:=TPasProcedureScope(El.CustomData);
+      if ProcScope.DeclarationProc<>nil then
+        El:=ProcScope.DeclarationProc;
+      end;
+
+    ParentEl:=El.Parent;
+    while ParentEl<>nil do
+      begin
+      if (ParentEl.CustomData is TPasProcedureScope) then
+        begin
+        // proc: always use the the declaration, not the body
+        ProcScope:=TPasProcedureScope(ParentEl.CustomData);
+        if ProcScope.DeclarationProc<>nil then
+          ParentEl:=ProcScope.DeclarationProc;
+        end;
+
+      // check if there is a local var
+      ShortName:=AContext.GetLocalName(ParentEl);
+
+      if ParentEl.ClassType=TImplementationSection then
+        begin
+        // element is in an implementation section (not program/library section)
+        if ShortName<>'' then
+          Prepend(Result,ShortName)
+        else
+          begin
+          // in other unit -> use pas.unitname.$impl
+          FoundModule:=El.GetModule;
+          if FoundModule=nil then
+            RaiseInconsistency(20161024192755);
+          Prepend(Result,TransformModuleName(FoundModule,true,AContext)
+             +'.'+FBuiltInNames[pbivnImplementation]);
+          end;
+        break;
+        end
+      else if ParentEl is TPasModule then
+        begin
+        // element is in an unit interface or program/library section
+        if ShortName<>'' then
+          Prepend(Result,ShortName)
+        else
+          Prepend(Result,TransformModuleName(TPasModule(ParentEl),true,AContext));
+        break;
+        end
+      else if (ParentEl.ClassType=TPasClassType)
+          or (ParentEl.ClassType=TPasRecordType) then
+        begin
+        // parent is a class or record declaration
+        if Full then
+          Prepend(Result,ParentEl.Name)
+        else
+          begin
+          // Pascal and JS have similar scoping rules (we are not in a dotscope),
+          // so 'this' can be used.
+          if ShortName<>'' then
+            Result:=ShortName
+          else
+            Result:='this';
+          SelfContext:=AContext.GetSelfContext;
+          if (SelfContext<>nil) and not IsClassFunction(SelfContext.PasElement) then
+            begin
+            // inside a method -> Self is a class instance
+            if El is TPasVariable then
+              begin
+              //writeln('TPasToJSConverter.CreateReferencePath class var ',GetObjName(El),' This=',GetObjName(This));
+              if (ClassVarModifiersType*TPasVariable(El).VarModifiers<>[])
+                  and (AContext.Access=caAssign) then
+                begin
+                  Append_GetClass(El); // writing a class var
+                end;
+              end
+            else if IsClassFunction(El) then
+              Append_GetClass(El); // accessing a class function
+            end;
+          break;
+          end;
+        end
+      else if ParentEl.ClassType=TPasEnumType then
+        Prepend(Result,ParentEl.Name);
+      ParentEl:=ParentEl.Parent;
       end;
     end;
-    if funname = cname then
-      Result := fundec;
-  end;
+  if (Result<>'') and (Kind in [rpkPathWithDot,rpkPathAndName]) then
+    Result:=Result+'.';
+  if Kind=rpkPathAndName then
+    Result:=Result+TransformVariableName(El,AContext);
 end;
 
-Function TPasToJSConverter.GetFunctionUnaryName(var je: TJSElement;
-  var fundec: TJSFunctionDeclarationStatement): TJSString;
+function TPasToJSConverter.CreateReferencePathExpr(El: TPasElement;
+  AContext: TConvertContext; Full: boolean; Ref: TResolvedReference
+  ): TJSElement;
 var
-  cname: TJSString;
-  asi: TJSAssignStatement;
-  un1: TJSUnary;
+  Name: String;
 begin
-  if not (je is TJSUnary) then
-    Exit;
-  un1 := TJSUnary(je);
-  asi := TJSAssignStatement(un1.A);
-  if not (asi.Expr is TJSFunctionDeclarationStatement) then
-    Exit;
-  fundec := TJSFunctionDeclarationStatement(asi.Expr);
-  cname := TJSDotMemberExpression(asi.LHS).Name;
-  Result := cname;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.CreateReferencePathExpr El="',GetObjName(El),'" El.Parent=',GetObjName(El.Parent));
+  {$ENDIF}
+  Name:=CreateReferencePath(El,AContext,rpkPathAndName,Full,Ref);
+  Result:=CreatePrimitiveDotExpr(Name);
 end;
 
-function TPasToJSConverter.CreateProcedureDeclaration(const El: TPasElement):
-TJSFunctionDeclarationStatement;
+procedure TPasToJSConverter.CreateProcedureCall(var Call: TJSCallExpression;
+  Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext);
+// create a call, adding call by reference and default values
+begin
+  if Call=nil then
+    Call:=TJSCallExpression(CreateElement(TJSCallExpression,Args));
+  if ((Args=nil) or (length(Args.Params)=0))
+      and ((TargetProc=nil) or (TargetProc.Args.Count=0)) then
+    exit;
+  if Call.Args=nil then
+    Call.Args:=TJSArguments(CreateElement(TJSArguments,Args));
+  CreateProcedureCallArgs(Call.Args.Elements,Args,TargetProc,AContext);
+end;
+
+procedure TPasToJSConverter.CreateProcedureCallArgs(
+  Elements: TJSArrayLiteralElements; Args: TParamsExpr;
+  TargetProc: TPasProcedureType; AContext: TConvertContext);
+// Add call arguments. Handle call by reference and default values
 var
-  FD: TJSFuncDef;
-  FS: TJSFunctionDeclarationStatement;
+  ArgContext: TConvertContext;
+  i: Integer;
+  Arg: TJSElement;
+  TargetArgs: TFPList;
+  TargetArg: TPasArgument;
+  OldAccess: TCtxAccess;
 begin
-  FS := TJSFunctionDeclarationStatement(
-    CreateElement(TJSFunctionDeclarationStatement, EL));
-  Result := FS;
-  FD := TJSFuncDef.Create;
-  FS.AFunction := FD;
-  Result := FS;
+  // get context
+  ArgContext:=AContext;
+  while ArgContext is TDotContext do
+    ArgContext:=ArgContext.Parent;
+  i:=0;
+  OldAccess:=ArgContext.Access;
+  if TargetProc<>nil then
+    TargetArgs:=TargetProc.Args
+  else
+    TargetArgs:=nil;
+  // add params
+  if Args<>nil then
+    while i<length(Args.Params) do
+      begin
+      if (TargetArgs<>nil) and (i<TargetArgs.Count) then
+        TargetArg:=TPasArgument(TargetArgs[i])
+      else
+        TargetArg:=nil;
+      Arg:=CreateProcCallArg(Args.Params[i],TargetArg,ArgContext);
+      Elements.AddElement.Expr:=Arg;
+      inc(i);
+      end;
+  // fill up default values
+  if TargetProc<>nil then
+    begin
+    while i<TargetArgs.Count do
+      begin
+      TargetArg:=TPasArgument(TargetArgs[i]);
+      if TargetArg.ValueExpr=nil then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateProcedureCallArgs missing default value: TargetProc=',TargetProc.Name,' i=',i);
+        {$ENDIF}
+        RaiseNotSupported(Args,AContext,20170201193601);
+        end;
+      AContext.Access:=caRead;
+      Arg:=ConvertElement(TargetArg.ValueExpr,ArgContext);
+      Elements.AddElement.Expr:=Arg;
+      inc(i);
+      end;
+    end;
+  ArgContext.Access:=OldAccess;
 end;
-Function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn; AContext : TConvertContext): TJSElement;
 
-Var
-  I : TJSIfStatement;
-  IO : TJSRelationalExpressionInstanceOf;
-  L : TJSStatementList;
-  V : TJSVarDeclaration;
+function TPasToJSConverter.CreateProcCallArg(El: TPasExpr;
+  TargetArg: TPasArgument; AContext: TConvertContext): TJSElement;
+var
+  ExprResolved, ArgResolved: TPasResolverResult;
+  ExprFlags: TPasResolverComputeFlags;
+  NeedVar: Boolean;
+begin
+  Result:=nil;
+  if TargetArg=nil then
+    begin
+    // simple conversion
+    AContext.Access:=caRead;
+    Result:=ConvertElement(El,AContext);
+    exit;
+    end;
+
+  if not (TargetArg.Access in [argDefault,argVar,argOut,argConst]) then
+    DoError(20170213220927,nPasElementNotSupported,sPasElementNotSupported,
+            [AccessNames[TargetArg.Access]],El);
 
+  NeedVar:=TargetArg.Access in [argVar,argOut];
+  AContext.Resolver.ComputeElement(TargetArg,ArgResolved,[]);
+  ExprFlags:=[];
+  if NeedVar then
+    Include(ExprFlags,rcNoImplicitProc)
+  else if AContext.Resolver.IsProcedureType(ArgResolved,true) then
+    Include(ExprFlags,rcNoImplicitProcType);
+
+  if (ArgResolved.TypeEl is TPasArrayType)
+      and (El is TParamsExpr) and (TParamsExpr(El).Kind=pekSet) then
+    begin
+    // passing a set to an open array
+    if NeedVar then
+      RaiseNotSupported(El,AContext,20170326213042);
+    Result:=ConvertOpenArrayParam(AContext.Resolver.ResolveAliasType(ArgResolved.TypeEl),
+                                  TParamsExpr(El),AContext);
+    exit;
+    end;
+
+  AContext.Resolver.ComputeElement(El,ExprResolved,ExprFlags);
+
+  // consider TargetArg access
+  if NeedVar then
+    Result:=CreateProcCallArgRef(El,ExprResolved,TargetArg,AContext)
+  else
+    begin
+    // pass as default, const or constref
+    AContext.Access:=caRead;
+
+    if (ExprResolved.BaseType=btNil) and (ArgResolved.TypeEl is TPasArrayType) then
+      begin
+      // arrays must never be null -> pass []
+      Result:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+      exit;
+      end;
+
+    Result:=ConvertElement(El,AContext);
+
+    if TargetArg.Access=argDefault then
+      begin
+      if (ExprResolved.BaseType=btSet) and (ExprResolved.IdentEl<>nil) then
+        begin
+        // right side is a set variable -> create reference
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.CreateProcedureCallArg create reference of SET variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+        {$ENDIF}
+        // create  rtl.refSet(right)
+        Result:=CreateReferencedSet(El,Result);
+        exit;
+        end
+      else if ExprResolved.BaseType=btContext then
+        begin
+        if ExprResolved.TypeEl.ClassType=TPasRecordType then
+          begin
+          // right side is a record -> clone
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.CreateProcedureCallArg clone RECORD variable Right={',GetResolverResultDbg(ExprResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(ExprResolved.IdentEl));
+          {$ENDIF}
+          // create  "new RightRecordType(RightRecord)"
+          Result:=CreateCloneRecord(El,ExprResolved,Result,AContext);
+          exit;
+          end;
+        end;
+      end;
+    end;
+end;
+
+function TPasToJSConverter.CreateProcCallArgRef(El: TPasExpr;
+  ResolvedEl: TPasResolverResult; TargetArg: TPasArgument;
+  AContext: TConvertContext): TJSElement;
+const
+  GetPathName = 'p';
+  SetPathName = 's';
+  ParamName = 'a';
+var
+  Obj: TJSObjectLiteral;
+
+  procedure AddVar(const aName: string; var Expr: TJSElement);
+  var
+    ObjLit: TJSObjectLiteralElement;
+  begin
+    if Expr=nil then exit;
+    ObjLit:=Obj.Elements.AddElement;
+    ObjLit.Name:=TJSString(aName);
+    ObjLit.Expr:=Expr;
+    Expr:=nil;
+  end;
+
+var
+  ParamContext: TParamContext;
+  FullGetter, GetPathExpr, SetPathExpr, GetExpr, SetExpr, ParamExpr: TJSElement;
+  AssignSt: TJSSimpleAssignStatement;
+  ObjLit: TJSObjectLiteralElement;
+  FuncSt: TJSFunctionDeclarationStatement;
+  RetSt: TJSReturnStatement;
+  GetDotPos, SetDotPos: Integer;
+  GetPath, SetPath: String;
+  BracketExpr: TJSBracketMemberExpression;
+  DotExpr: TJSDotMemberExpression;
 begin
-  I:=TJSIfStatement(CreateElement(TJSIfStatement,El));
-  IO:=TJSRelationalExpressionInstanceOf(CreateElement(TJSRelationalExpressionInstanceOf,EL));
-  IO.A:=CreateIdentifierExpr(GetExceptionObjectName(AContext),El,AContext);
-  IO.B:=CreateIdentifierExpr(El.TypeName,El,AContext);
-  I.Cond:=IO;
-  L:=TJSStatementList(CreateElement(TJSStatementList,EL.Body));
-  I.btrue:=L;
-  V:=TJSVarDeclaration(CreateElement(TJSVarDeclaration,EL));
-  L.A:=V;
-  V.Name:=TransFormVariableName(EL.VariableName,AContext);//
-  V.Init:=CreateIdentifierExpr(GetExceptionObjectName(AContext),EL,AContext);
-  L.B:=TJSStatementList(CreateElement(TJSStatementList,EL.Body));
-  L:=TJSStatementList(L.B);
-  L.A:=ConvertElement(EL.Body,AContext);
-  Result:=I;
+  // pass reference -> create a temporary JS object with a FullGetter and setter
+  Obj:=nil;
+  FullGetter:=nil;
+  ParamContext:=TParamContext.Create(El,nil,AContext);
+  GetPathExpr:=nil;
+  SetPathExpr:=nil;
+  GetExpr:=nil;
+  SetExpr:=nil;
+  try
+    // create FullGetter and setter
+    ParamContext.Access:=caByReference;
+    ParamContext.Arg:=TargetArg;
+    ParamContext.Expr:=El;
+    ParamContext.ResolvedExpr:=ResolvedEl;
+    FullGetter:=ConvertElement(El,ParamContext);
+    // FullGetter is now a full JS expression to retrieve the value.
+    if ParamContext.ReusingReference then
+      begin
+      // result is already a reference
+      Result:=FullGetter;
+      exit;
+      end;
+
+    // if ParamContext.Getter is set then
+    // ParamContext.Getter is the last part of the FullGetter
+    // FullSetter is created from FullGetter by replacing the Getter with the Setter
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.CreateProcedureCallArg VAR FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter));
+    {$ENDIF}
+    if (ParamContext.Getter=nil)<>(ParamContext.Setter=nil) then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter));
+      {$ENDIF}
+      RaiseInconsistency(20170213222941);
+      end;
+
+    // create "{p:Result,get:function(){return this.p.Getter},set:function(v){this.p.Setter(v);}}"
+    Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
+
+    if FullGetter.ClassType=TJSPrimaryExpressionIdent then
+      begin
+      // create "{get:function(){return FullGetter;},set:function(v){FullGetter=v;}}"
+      if (ParamContext.Getter<>nil) and (ParamContext.Getter<>FullGetter) then
+        RaiseInconsistency(20170213224339);
+      GetPath:=String(TJSPrimaryExpressionIdent(FullGetter).Name);
+      GetDotPos:=PosLast('.',GetPath);
+      if GetDotPos>0 then
+        begin
+        // e.g. path1.path2.readvar
+        // create
+        //    GetPathExpr: path1.path2
+        //    GetExpr:     this.p.readvar
+        // Will create "{p:GetPathExpr, get:function(){return GetExpr;},
+        //                              set:function(v){GetExpr = v;}}"
+        GetPathExpr:=CreatePrimitiveDotExpr(LeftStr(GetPath,GetDotPos-1));
+        GetExpr:=CreateDotExpression(El,CreatePrimitiveDotExpr('this.'+GetPathName),
+            CreatePrimitiveDotExpr(copy(GetPath,GetDotPos+1)));
+        if ParamContext.Setter=nil then
+          SetExpr:=CreateDotExpression(El,CreatePrimitiveDotExpr('this.'+GetPathName),
+            CreatePrimitiveDotExpr(copy(GetPath,GetDotPos+1)));
+        end
+      else
+        begin
+        // local var
+        GetExpr:=FullGetter;
+        FullGetter:=nil;
+        if ParamContext.Setter=nil then
+          SetExpr:=CreatePrimitiveDotExpr(GetPath);
+        end;
+
+      if ParamContext.Setter<>nil then
+        begin
+        // custom Setter
+        SetExpr:=ParamContext.Setter;
+        ParamContext.Setter:=nil;
+        if SetExpr.ClassType=TJSPrimaryExpressionIdent then
+          begin
+          SetPath:=String(TJSPrimaryExpressionIdent(SetExpr).Name);
+          SetDotPos:=PosLast('.',SetPath);
+          FreeAndNil(SetExpr);
+          if LeftStr(GetPath,GetDotPos)=LeftStr(SetPath,SetDotPos) then
+            begin
+            // use GetPathExpr for setter
+            SetExpr:=CreateDotExpression(El,CreatePrimitiveDotExpr('this.'+GetPathName),
+                CreatePrimitiveDotExpr(copy(SetPath,GetDotPos+1)));
+            end
+          else
+            begin
+            // setter needs its own SetPathExpr
+            SetPathExpr:=CreatePrimitiveDotExpr(LeftStr(SetPath,SetDotPos-1));
+            SetExpr:=CreateDotExpression(El,CreatePrimitiveDotExpr('this.'+SetPathName),
+                CreatePrimitiveDotExpr(copy(SetPath,GetDotPos+1)));
+            end;
+          end;
+        end;
+      end
+    else if FullGetter.ClassType=TJSDotMemberExpression then
+      begin
+      if ParamContext.Setter<>nil then
+        RaiseNotSupported(El,AContext,20170214231900);
+      // convert  this.r.i  to
+      // {p:this.r,
+      //  get:function{return this.p.i;},
+      //  set:function(v){this.p.i=v;}
+      // }
+      // GetPathExpr:  this.r
+      // GetExpr:  this.p.i
+      // SetExpr:  this.p.i
+      DotExpr:=TJSDotMemberExpression(FullGetter);
+      GetPathExpr:=DotExpr.MExpr;
+      DotExpr.MExpr:=CreatePrimitiveDotExpr('this.'+GetPathName);
+      GetExpr:=DotExpr;
+      FullGetter:=nil;
+      SetExpr:=CreateDotExpression(El,
+        CreatePrimitiveDotExpr('this.'+GetPathName),
+        CreatePrimitiveDotExpr(String(DotExpr.Name)));
+      end
+    else if FullGetter.ClassType=TJSBracketMemberExpression then
+      begin
+      if ParamContext.Setter<>nil then
+        RaiseNotSupported(El,AContext,20170214215150);
+      // convert  this.arr[value]  to
+      // {a:value,
+      //  p:this.arr,
+      //  get:function{return this.p[this.a];},
+      //  set:function(v){this.p[this.a]=v;}
+      // }
+      BracketExpr:=TJSBracketMemberExpression(FullGetter);
+      ParamExpr:=BracketExpr.Name;
+
+      // create "a:value"
+      BracketExpr.Name:=CreatePrimitiveDotExpr('this.'+ParamName);
+      AddVar(ParamName,ParamExpr);
+
+      // create GetPathExpr "this.arr"
+      GetPathExpr:=BracketExpr.MExpr;
+      BracketExpr.MExpr:=CreatePrimitiveDotExpr('this.'+GetPathName);
+
+      // GetExpr  "this.p[this.a]"
+      GetExpr:=BracketExpr;
+      FullGetter:=nil;
+
+      // SetExpr  "this.p[this.a]"
+      BracketExpr:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+      SetExpr:=BracketExpr;
+      BracketExpr.MExpr:=CreatePrimitiveDotExpr('this.'+GetPathName);
+      BracketExpr.Name:=CreatePrimitiveDotExpr('this.'+ParamName);
+
+      end
+    else
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateProcedureCallArg FullGetter=',GetObjName(FullGetter),' Getter=',GetObjName(ParamContext.Getter),' Setter=',GetObjName(ParamContext.Setter));
+      {$ENDIF}
+      RaiseNotSupported(El,AContext,20170213230336);
+      end;
+
+    if (SetExpr.ClassType=TJSPrimaryExpressionIdent)
+        or (SetExpr.ClassType=TJSDotMemberExpression)
+        or (SetExpr.ClassType=TJSBracketMemberExpression) then
+      begin
+      // create   SetExpr = v;
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AssignSt.LHS:=SetExpr;
+      AssignSt.Expr:=CreatePrimitiveDotExpr(TempRefObjSetterArgName);
+      SetExpr:=AssignSt;
+      end
+    else if (SetExpr.ClassType=TJSCallExpression) then
+      // has already the form  Func(v)
+    else
+      RaiseInconsistency(20170213225940);
+
+    // add   p:GetPathExpr
+    AddVar(GetPathName,GetPathExpr);
+
+    // add   get:function(){ return GetExpr; }
+    ObjLit:=Obj.Elements.AddElement;
+    ObjLit.Name:=TempRefObjGetterName;
+    FuncSt:=CreateFunction(El);
+    ObjLit.Expr:=FuncSt;
+    RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
+    FuncSt.AFunction.Body.A:=RetSt;
+    RetSt.Expr:=GetExpr;
+    GetExpr:=nil;
+
+    // add   s:GetPathExpr
+    AddVar(SetPathName,SetPathExpr);
+
+    // add   set:function(v){ SetExpr }
+    ObjLit:=Obj.Elements.AddElement;
+    ObjLit.Name:=TempRefObjSetterName;
+    FuncSt:=CreateFunction(El);
+    ObjLit.Expr:=FuncSt;
+    FuncSt.AFunction.Params.Add(TempRefObjSetterArgName);
+    FuncSt.AFunction.Body.A:=SetExpr;
+    SetExpr:=nil;
+
+    Result:=Obj;
+  finally
+    if Result=nil then
+      begin
+      GetPathExpr.Free;
+      SetPathExpr.Free;
+      GetExpr.Free;
+      SetExpr.Free;
+      Obj.Free;
+      ParamContext.Setter.Free;
+      FullGetter.Free;
+      end;
+    ParamContext.Free;
+  end;
 end;
 
-Function TPasToJSConverter.ConvertStatement(El: TPasImplStatement; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertExceptOn(El: TPasImplExceptOn;
+  AContext: TConvertContext): TJSElement;
+// convert "on T do ;" to "if(T.isPrototypeOf(exceptObject)){}"
+// convert "on E:T do ;" to "if(T.isPrototypeOf(exceptObject)){ var E=exceptObject; }"
+Var
+  IfSt : TJSIfStatement;
+  ListFirst , ListLast: TJSStatementList;
+  DotExpr: TJSDotMemberExpression;
+  Call: TJSCallExpression;
+  V: TJSVariableStatement;
+begin
+  Result:=nil;
+  // create "if()"
+  IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
+  try
+    // create "T.isPrototypeOf"
+    DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+    DotExpr.MExpr:=CreateReferencePathExpr(El.TypeEl,AContext);
+    DotExpr.Name:='isPrototypeOf';
+    // create "T.isPrototypeOf(exceptObject)"
+    Call:=CreateCallExpression(El);
+    Call.Expr:=DotExpr;
+    Call.AddArg(CreatePrimitiveDotExpr(FBuiltInNames[pbivnExceptObject]));
+    IfSt.Cond:=Call;
+
+    if El.VarEl<>nil then
+      begin
+      // add "var E=exceptObject;"
+      ListFirst:=TJSStatementList(CreateElement(TJSStatementList,El.Body));
+      ListLast:=ListFirst;
+      IfSt.BTrue:=ListFirst;
+      V:=CreateVarStatement(TransformVariableName(El,El.VariableName,AContext),
+        CreatePrimitiveDotExpr(FBuiltInNames[pbivnExceptObject]),El);
+      ListFirst.A:=V;
+      // add statements
+      AddToStatementList(ListFirst,ListLast,ConvertElement(El.Body,AContext),El);
+      end
+    else if El.Body<>nil then
+      // add statements
+      IfSt.BTrue:=ConvertElement(El.Body,AContext);
+
+    Result:=IfSt;
+  finally
+    if Result=nil then
+      IfSt.Free;
+  end;
+end;
+
+function TPasToJSConverter.ConvertStatement(El: TPasImplStatement;
+  AContext: TConvertContext): TJSElement;
 
 begin
   Result:=Nil;
@@ -1632,118 +11543,669 @@ begin
     Result:=ConvertExceptOn(TPasImplExceptOn(El),AContext)
   else if (El is TPasImplForLoop) then
     Result:=ConvertForStatement(TPasImplForLoop(El),AContext)
+  else if (El is TPasImplAsmStatement) then
+    Result:=ConvertAsmStatement(TPasImplAsmStatement(El),AContext)
   else
-    DoError('Unknown statement Class: %s',[El.ClassName]);
+    RaiseNotSupported(El,AContext,20161024192759);
 {
   TPasImplCaseStatement = class(TPasImplStatement)
 }
 end;
 
-
-Function TPasToJSConverter.ConvertCommands(El: TPasImplCommands; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertCommands(El: TPasImplCommands;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192806);
   Result:=Nil;
-  //  TPasImplCommands = class(TPasImplElement)
+  // ToDo: TPasImplCommands = class(TPasImplElement)
 end;
 
-Function TPasToJSConverter.ConvertLabelMark(El: TPasImplLabelMark; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertConst(El: TPasConst; AContext: TConvertContext
+  ): TJSElement;
+// Important: returns nil if const was added to higher context
+Var
+  AssignSt: TJSSimpleAssignStatement;
+  Obj: TJSObjectLiteral;
+  ObjLit: TJSObjectLiteralElement;
+  ConstContext: TFunctionContext;
+  C: TJSElement;
+  V: TJSVariableStatement;
+  Src: TJSSourceElements;
+begin
+  Result:=nil;
+  if not AContext.IsGlobal then
+    begin
+    // local const are stored in interface/implementation
+    ConstContext:=AContext.GetGlobalFunc;
+    if not (ConstContext.JSElement is TJSSourceElements) then
+      begin
+      {$IFDEF VerbosePas2JS}
+      writeln('TPasToJSConverter.CreateConstDecl ConstContext=',GetObjName(ConstContext),' JSElement=',GetObjName(ConstContext.JSElement));
+      {$ENDIF}
+      RaiseNotSupported(El,AContext,20170220153216);
+      end;
+    Src:=TJSSourceElements(ConstContext.JSElement);
+    C:=ConvertVariable(El,AContext);
+    V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
+    V.A:=C;
+    AddToSourceElements(Src,V);
+    end
+  else if AContext is TObjectContext then
+    begin
+    // create 'A: initvalue'
+    Obj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
+    ObjLit:=Obj.Elements.AddElement;
+    ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
+    ObjLit.Expr:=CreateVarInit(El,AContext);
+    end
+  else
+    begin
+    // create 'this.A=initvalue'
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    Result:=AssignSt;
+    AssignSt.LHS:=CreateSubDeclNameExpr(El,El.Name,AContext);
+    AssignSt.Expr:=CreateVarInit(El,AContext);
+    end;
+end;
+
+function TPasToJSConverter.ConvertLabelMark(El: TPasImplLabelMark;
+  AContext: TConvertContext): TJSElement;
 
 begin
+  RaiseNotSupported(El,AContext,20161024192857);
   Result:=Nil;
- //    TPasImplLabelMark = class(TPasImplLabelMark) then
+  // ToDo:   TPasImplLabelMark = class(TPasImplLabelMark) then
 end;
 
-Function TPasToJSConverter.ConvertElement(El: TPasElement; AContext : TConvertContext): TJSElement;
+function TPasToJSConverter.ConvertElement(El: TPasElement;
+  AContext: TConvertContext): TJSElement;
+var
+  C: TClass;
 begin
-  If (El is TPasPackage)  then
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertElement El=',GetObjName(El),' Context=',GetObjName(AContext));
+  {$ENDIF}
+  if El=nil then
+    begin
+    Result:=nil;
+    RaiseInconsistency(20161024190203);
+    end;
+  C:=El.ClassType;
+  If (C=TPasPackage)  then
     Result:=ConvertPackage(TPasPackage(El),AContext)
-  else If (El is TPasModule)  then
-    Result:=ConvertModule(TPasModule(El),AContext)
-  else if (EL is TPasExpr) then
-    Result:=ConvertExpression(TPasExpr(El),AContext)
-  else if (EL is TPasDeclarations) then
-    Result:=ConvertDeclarations(TPasDeclarations(El),AContext)
-  else if (EL is TPasType) then
-    Result:=ConvertType(TPasType(El),AContext)
-  else if (EL is TPasProcedure) then
-    Result:=ConvertProcedure(TPasProcedure(El),AContext)
-  else if (EL is TPasProcedureImpl) then
-    Result:=ConvertProcedureImpl(TPasProcedureImpl(El),AContext)
-  else if (EL is TPasImplBlock) then
-    Result:=ConvertImplBlock(TPasImplBlock(El),AContext)
-  else if (EL is TPasResString) then
+  else if (C=TPasResString) then
     Result:=ConvertResString(TPasResString(El),AContext)
-  else if (EL is TPasArgument) then
-    Result:=ConvertArgument(TPasArgument(El),AContext)
-  else if (EL is TPasResultElement) then
-    Result:=ConvertResultElement(TPasResultElement(El),AContext)
-  else if (EL is TPasConst) then
+  else if (C=TPasConst) then
     Result:=ConvertConst(TPasConst(El),AContext)
-  else if (EL is TPasProperty) then
+  else if (C=TPasProperty) then
     Result:=ConvertProperty(TPasProperty(El),AContext)
-  else if (EL is TPasVariable) then
+  else if (C=TPasVariable) then
     Result:=ConvertVariable(TPasVariable(El),AContext)
-  else if (EL is TPasExportSymbol) then
+  else if (C=TPasExportSymbol) then
     Result:=ConvertExportSymbol(TPasExportSymbol(El),AContext)
-  else if (EL is TPasLabels) then
+  else if (C=TPasLabels) then
     Result:=ConvertLabels(TPasLabels(El),AContext)
-  else if (EL is TPasImplCommand) then
+  else if (C=TPasImplCommand) then
     Result:=ConvertCommand(TPasImplCommand(El),AContext)
-  else if (EL is TPasImplCommands) then
+  else if (C=TPasImplCommands) then
     Result:=ConvertCommands(TPasImplCommands(El),AContext)
-  else if (EL is TPasImplLabelMark) then
-    Result:=ConvertLabelMark(TPasImplLabelMark(El),AContext);
+  else if (C=TPasImplLabelMark) then
+    Result:=ConvertLabelMark(TPasImplLabelMark(El),AContext)
+  else if C.InheritsFrom(TPasExpr) then
+    Result:=ConvertExpression(TPasExpr(El),AContext)
+  else if C.InheritsFrom(TPasDeclarations) then
+    Result:=ConvertDeclarations(TPasDeclarations(El),AContext)
+  else if C.InheritsFrom(TPasProcedure) then
+    Result:=ConvertProcedure(TPasProcedure(El),AContext)
+  else if C.InheritsFrom(TPasImplBlock) then
+    Result:=ConvertImplBlock(TPasImplBlock(El),AContext)
+  else if C.InheritsFrom(TPasModule)  then
+    Result:=ConvertModule(TPasModule(El),AContext)
+  else
+    begin
+    Result:=nil;
+    RaiseNotSupported(El, AContext, 20161024190449);
+    end;
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertElement END ',GetObjName(El));
+  {$ENDIF}
 end;
 
-Procedure TPasToJSConverter.DoError(Const Msg: String);
+function TPasToJSConverter.ConvertRecordType(El: TPasRecordType;
+  AContext: TConvertContext): TJSElement;
+(*
+  type
+    TMyRecord = record
+      i: longint;
+      s: string;
+      d: double;
+      r: TOtherRecord;
+    end;
+
+    this.TMyRecord=function(s) {
+      if (s){
+        this.i = s.i;
+        this.s = s.s;
+        this.d = s.d;
+        this.r = new this.TOtherRecord(s.r);
+      } else {
+        this.i = 0;
+        this.s = "";
+        this.d = 0.0;
+        this.r = new this.TOtherRecord();
+      };
+      this.$equal = function(b){
+        return (this.i == b.i) && (this.s == b.s) && (this.d == b.d)
+          && (this.r.$equal(b.r))
+      };
+    };
+*)
+const
+  SrcParamName = 's';
+  EqualParamName = 'b';
+
+  procedure AddCloneStatements(IfSt: TJSIfStatement;
+    FuncContext: TFunctionContext);
+  var
+    i: Integer;
+    PasVar: TPasVariable;
+    VarAssignSt: TJSSimpleAssignStatement;
+    First, Last: TJSStatementList;
+    VarDotExpr: TJSDotMemberExpression;
+    PasVarType: TPasType;
+    ResolvedPasVar: TPasResolverResult;
+  begin
+    // init members with s
+    First:=nil;
+    Last:=nil;
+    for i:=0 to El.Members.Count-1 do
+      begin
+      PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
+      // create 'this.A = s.A;'
+      VarAssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PasVar));
+      AddToStatementList(First,Last,VarAssignSt,PasVar);
+      if i=0 then IfSt.BTrue:=First;
+      VarAssignSt.LHS:=CreateSubDeclNameExpr(PasVar,PasVar.Name,FuncContext);
+      VarDotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,PasVar));
+      VarAssignSt.Expr:=VarDotExpr;
+      VarDotExpr.MExpr:=CreatePrimitiveDotExpr(SrcParamName);
+      VarDotExpr.Name:=TJSString(TransformVariableName(PasVar,FuncContext));
+      if (AContext.Resolver<>nil) then
+        begin
+        PasVarType:=AContext.Resolver.ResolveAliasType(PasVar.VarType);
+        if PasVarType.ClassType=TPasRecordType then
+          begin
+          SetResolverIdentifier(ResolvedPasVar,btContext,PasVar,PasVarType,[rrfReadable,rrfWritable]);
+          VarAssignSt.Expr:=CreateCloneRecord(PasVar,ResolvedPasVar,VarDotExpr,FuncContext);
+          continue;
+          end
+        else if PasVarType.ClassType=TPasSetType then
+          begin
+          VarAssignSt.Expr:=CreateReferencedSet(PasVar,VarDotExpr);
+          continue;
+          end
+        end;
+      end;
+  end;
+
+  procedure AddInitDefaultStatements(IfSt: TJSIfStatement;
+    FuncContext: TFunctionContext);
+  var
+    i: Integer;
+    PasVar: TPasVariable;
+    JSVar: TJSElement;
+    First, Last: TJSStatementList;
+  begin
+    // the "else" part:
+    // when there is no s parameter, init members with default value
+    First:=nil;
+    Last:=nil;
+    for i:=0 to El.Members.Count-1 do
+      begin
+      PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
+      JSVar:=CreateVarDecl(PasVar,FuncContext);
+      AddToStatementList(First,Last,JSVar,PasVar);
+      if IfSt.BFalse=nil then
+        IfSt.BFalse:=First;
+      end;
+  end;
+
+  procedure Add_AndExpr_ToReturnSt(RetSt: TJSReturnStatement;
+    PasVar: TPasVariable; var LastAndExpr: TJSLogicalAndExpression;
+    Expr: TJSElement);
+  var
+    AndExpr: TJSLogicalAndExpression;
+  begin
+    if RetSt.Expr=nil then
+      RetSt.Expr:=Expr
+    else
+      begin
+      AndExpr:=TJSLogicalAndExpression(CreateElement(TJSLogicalAndExpression,PasVar));
+      if LastAndExpr=nil then
+        begin
+        AndExpr.A:=RetSt.Expr;
+        RetSt.Expr:=AndExpr;
+        end
+      else
+        begin
+        AndExpr.A:=LastAndExpr.B;
+        LastAndExpr.B:=AndExpr;
+        end;
+      AndExpr.B:=Expr;
+      LastAndExpr:=AndExpr;
+      end;
+  end;
+
+  procedure AddEqualFunction(var BodyFirst, BodyLast: TJSStatementList;
+    FuncContext: TFunctionContext);
+  // add equal function:
+  // this.$equal = function(b){
+  //   return (this.member1 == b.member1);
+  // };
+  var
+    AssignSt: TJSSimpleAssignStatement;
+    FD: TJSFuncDef;
+    RetSt: TJSReturnStatement;
+    i: Integer;
+    PasVar: TPasVariable;
+    FDS: TJSFunctionDeclarationStatement;
+    EqExpr: TJSEqualityExpressionEQ;
+    LastAndExpr: TJSLogicalAndExpression;
+    VarType: TPasType;
+    Call: TJSCallExpression;
+    VarName: String;
+  begin
+    // add "this.$equal ="
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    AssignSt.LHS:=CreateMemberExpression(['this',FBuiltInNames[pbifnRecordEqual]]);
+    AddToStatementList(BodyFirst,BodyLast,AssignSt,El);
+    // add "function(b){"
+    FDS:=CreateFunction(El);
+    AssignSt.Expr:=FDS;
+    FD:=FDS.AFunction;
+    FD.Params.Add(EqualParamName);
+    FD.Body:=TJSFunctionBody(CreateElement(TJSFunctionBody,El));
+    // add "return "
+    RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
+    FD.Body.A:=RetSt;
+    LastAndExpr:=nil;
+    for i:=0 to El.Members.Count-1 do
+      begin
+      PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
+      // "this.member = b.member;"
+      VarType:=PasVar.VarType;
+      if FuncContext.Resolver<>nil then
+        VarType:=FuncContext.Resolver.ResolveAliasType(VarType);
+      VarName:=TransformVariableName(PasVar,FuncContext);
+      if VarType.ClassType=TPasRecordType then
+        begin
+        // record
+        // add "this.member.$equal(b.member)"
+        Call:=CreateCallExpression(PasVar);
+        Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,Call);
+        Call.Expr:=CreateMemberExpression(['this',VarName,FBuiltInNames[pbifnRecordEqual]]);
+        Call.AddArg(CreateMemberExpression([EqualParamName,VarName]));
+        end
+      else if VarType.ClassType=TPasSetType then
+        begin
+        // set
+        // add "rtl.eqSet(this.member,b.member)"
+        Call:=CreateCallExpression(PasVar);
+        Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,Call);
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Equal]]);
+        Call.AddArg(CreateMemberExpression(['this',VarName]));
+        Call.AddArg(CreateMemberExpression([EqualParamName,VarName]));
+        end
+      else if VarType is TPasProcedureType then
+        begin
+        // proc type
+        // add "rtl.eqCallback(this.member,b.member)"
+        Call:=CreateCallExpression(PasVar);
+        Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,Call);
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnProcType_Equal]]);
+        Call.AddArg(CreateMemberExpression(['this',VarName]));
+        Call.AddArg(CreateMemberExpression([EqualParamName,VarName]));
+        end
+      else
+        begin
+        // default: use simple equal "=="
+        EqExpr:=TJSEqualityExpressionEQ(CreateElement(TJSEqualityExpressionEQ,PasVar));
+        Add_AndExpr_ToReturnSt(RetSt,PasVar,LastAndExpr,EqExpr);
+        EqExpr.A:=CreateMemberExpression(['this',VarName]);
+        EqExpr.B:=CreateMemberExpression([EqualParamName,VarName]);
+        end;
+      end;
+  end;
+
+  procedure AddRTTIFields(Args: TJSArguments);
+  var
+    i: Integer;
+    PasVar: TPasVariable;
+  begin
+    for i:=0 to El.Members.Count-1 do
+      begin
+      PasVar:=TPasVariable(El.Members[i]);
+      if not IsElementUsed(PasVar) then continue;
+      // add quoted "fieldname"
+      Args.AddElement(CreateLiteralString(PasVar,TransformVariableName(PasVar,AContext)));
+      // add typeinfo ref
+      Args.AddElement(CreateTypeInfoRef(PasVar.VarType,AContext,PasVar));
+      end;
+  end;
+
+var
+  AssignSt: TJSSimpleAssignStatement;
+  FDS: TJSFunctionDeclarationStatement;
+  FD: TJSFuncDef;
+  BodyFirst, BodyLast, List: TJSStatementList;
+  FuncContext: TFunctionContext;
+  ObjLit: TJSObjectLiteral;
+  ObjEl: TJSObjectLiteralElement;
+  IfSt: TJSIfStatement;
+  Call: TJSCallExpression;
+  ok: Boolean;
+begin
+  Result:=nil;
+  FuncContext:=nil;
+  ok:=false;
+  try
+    FDS:=CreateFunction(El);
+    if AContext is TObjectContext then
+      begin
+      // add 'TypeName: function(){}'
+      ObjLit:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
+      Result:=ObjLit;
+      ObjEl:=ObjLit.Elements.AddElement;
+      ObjEl.Name:=TJSString(TransformVariableName(El,AContext));
+      ObjEl.Expr:=FDS;
+      end
+    else
+      begin
+      // add 'this.TypeName = function(){}'
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      Result:=AssignSt;
+      AssignSt.LHS:=CreateSubDeclNameExpr(El,El.Name,AContext);
+      AssignSt.Expr:=FDS;
+      end;
+    FD:=FDS.AFunction;
+    // add param s
+    FD.Params.Add(SrcParamName);
+    // create function body
+    FuncContext:=TFunctionContext.Create(El,FD.Body,AContext);
+    FuncContext.ThisPas:=El;
+    FuncContext.IsGlobal:=true;
+    if El.Members.Count>0 then
+      begin
+      BodyFirst:=nil;
+      BodyLast:=nil;
+
+      // add if(s)
+      IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
+      AddToStatementList(BodyFirst,BodyLast,IfSt,El);
+      FD.Body.A:=BodyFirst;
+      IfSt.Cond:=CreatePrimitiveDotExpr(SrcParamName);
+      // add clone statements
+      AddCloneStatements(IfSt,FuncContext);
+      // add init default statements
+      AddInitDefaultStatements(IfSt,FuncContext);
+
+      // add equal function
+      AddEqualFunction(BodyFirst,BodyLast,FuncContext);
+
+      end;
+
+    if HasTypeInfo(El,AContext) then
+      begin
+      // add $rtti as second statement
+      if not (AContext is TFunctionContext) then
+        RaiseNotSupported(El,AContext,20170412120012);
+
+      List:=TJSStatementList(CreateElement(TJSStatementList,El));
+      List.A:=Result;
+      Result:=List;
+      // module.$rtti.$Record("typename",{});
+      Call:=CreateRTTINewType(El,FBuiltInNames[pbifnRTTINewRecord],false,AContext,ObjLit);
+      List.B:=Call;
+      if ObjLit=nil then
+        RaiseInconsistency(20170412124804);
+      if El.Members.Count>0 then
+        begin
+        // module.$rtti.$Record("typename",{}).addFields(
+        //  "fieldname1",type1,"fieldname2",type2,...
+        //  );
+        Call:=CreateCallExpression(El);
+        Call.Expr:=CreateDotExpression(El,List.B,
+          CreatePrimitiveDotExpr(FBuiltInNames[pbifnRTTIAddFields]));
+        List.B:=Call;
+        AddRTTIFields(Call.Args);
+        end;
+      end;
+    ok:=true;;
+  finally
+    FuncContext.Free;
+    if not ok then
+      FreeAndNil(Result);
+  end;
+end;
+
+procedure TPasToJSConverter.DoError(Id: int64; const Msg: String);
+var
+  E: EPas2JS;
 begin
-  Raise EPas2JS.Create(Msg);
+  E:=EPas2JS.Create(Msg);
+  E.Id:=Id;
+  E.MsgType:=mtError;
+  Raise E;
 end;
 
-Procedure TPasToJSConverter.DoError(Const Msg: String;
-  Const Args: Array of Const);
+procedure TPasToJSConverter.DoError(Id: int64; const Msg: String;
+  const Args: array of const);
+var
+  E: EPas2JS;
 begin
-  Raise EPas2JS.CreateFmt(Msg,Args);
+  E:=EPas2JS.CreateFmt(Msg,Args);
+  E.Id:=Id;
+  E.MsgType:=mtError;
+  Raise E;
 end;
 
-procedure TPasToJSConverter.SetCurrentContext(AValue: TJSElement);
+procedure TPasToJSConverter.DoError(Id: int64; MsgNumber: integer;
+  const MsgPattern: string; const Args: array of const; El: TPasElement);
+var
+  E: EPas2JS;
 begin
-  if FCurrentContext=AValue then Exit;
-  FCurrentContext:=AValue;
+  E:=EPas2JS.CreateFmt(MsgPattern,Args);
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.DoError ',id,' ',El.FullName,':',El.ClassName,' Msg="',E.Message,'"');
+  {$ENDIF}
+  E.PasElement:=El;
+  E.MsgNumber:=MsgNumber;
+  E.Id:=Id;
+  E.MsgType:=mtError;
+  CreateMsgArgs(E.Args,Args);
+  raise E;
 end;
 
-Function TPasToJSConverter.CreateJSContext(AContext : TConvertContext) : TJSElement;
+procedure TPasToJSConverter.RaiseNotSupported(El: TPasElement;
+  AContext: TConvertContext; Id: int64; const Msg: string);
+var
+  E: EPas2JS;
+begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.RaiseNotSupported ',id,' ',El.FullName,':',El.ClassName,' Msg="',Msg,'"');
+  {$ENDIF}
+  if AContext=nil then ;
+  E:=EPas2JS.CreateFmt(sPasElementNotSupported,[GetObjName(El)]);
+  if Msg<>'' then
+    E.Message:=E.Message+': '+Msg;
+  E.PasElement:=El;
+  E.MsgNumber:=nPasElementNotSupported;
+  SetLength(E.Args,1);
+  E.Args[0]:=El.ClassName;
+  E.Id:=Id;
+  E.MsgType:=mtError;
+  raise E;
+end;
 
+procedure TPasToJSConverter.RaiseIdentifierNotFound(Identifier: string;
+  El: TPasElement; Id: int64);
+var
+  E: EPas2JS;
 begin
-  Result:=TJSObjectLiteral.Create(0,0);
+  E:=EPas2JS.CreateFmt(sIdentifierNotFound,[Identifier]);
+  E.PasElement:=El;
+  E.MsgNumber:=nIdentifierNotFound;
+  SetLength(E.Args,1);
+  E.Args[0]:=Identifier;
+  E.Id:=Id;
+  E.MsgType:=mtError;
+  raise E;
+end;
 
+function TPasToJSConverter.TransformVariableName(El: TPasElement;
+  const AName: String; AContext: TConvertContext): String;
+var
+  i: Integer;
+  c: Char;
+begin
+  if AContext=nil then ;
+  if Pos('.',AName)>0 then
+    RaiseInconsistency(20170203164711);
+  if UseLowerCase then
+    Result:=LowerCase(AName)
+  else
+    Result:=AName;
+  if not IsPreservedWord(Result) then
+    exit;
+  for i:=1 to length(Result) do
+    begin
+    c:=Result[i];
+    case c of
+    'a'..'z','A'..'Z':
+      begin
+      Result[i]:=chr(ord(c) xor 32);
+      if not IsPreservedWord(Result) then
+        exit;
+      end;
+    end;
+    end;
+  RaiseNotSupported(El,AContext,20170203131832);
 end;
 
-Function TPasToJSConverter.TransFormVariableName(Const AName: String;
+function TPasToJSConverter.TransformVariableName(El: TPasElement;
   AContext: TConvertContext): String;
 begin
-  Result:=LowerCase(AName);
+  if (El is TPasProcedure) and (TPasProcedure(El).LibrarySymbolName<>nil) then
+    Result:=ComputeConstString(TPasProcedure(El).LibrarySymbolName,AContext,true)
+  else if (El is TPasVariable) and (TPasVariable(El).ExportName<>nil) then
+    Result:=ComputeConstString(TPasVariable(El).ExportName,AContext,true)
+  else
+    Result:=TransformVariableName(El,El.Name,AContext);
 end;
 
-Function TPasToJSConverter.TransFormVariableName(El: TPasElement; AContext: TConvertContext): String;
+function TPasToJSConverter.TransformModuleName(El: TPasModule;
+  AddModulesPrefix: boolean; AContext: TConvertContext): String;
+var
+  p, StartP: Integer;
+  aName, Part: String;
 begin
-  Result:=TransFormVariableName(EL.Name,AContext);
-  // Add to context.
+  if El is TPasProgram then
+    Result:='program'
+  else
+    begin
+    Result:='';
+    aName:=El.Name;
+    p:=1;
+    while p<=length(aName) do
+      begin
+      StartP:=p;
+      while (p<=length(aName)) and (aName[p]<>'.') do inc(p);
+      Part:=copy(aName,StartP,p-StartP);
+      Part:=TransformVariableName(El,Part,AContext);
+      if Result<>'' then Result:=Result+'.';
+      Result:=Result+Part;
+      inc(p);
+      end;
+    end;
+  if AddModulesPrefix then
+    begin
+    if Pos('.',Result)>0 then
+      Result:=FBuiltInNames[pbivnModules]+'["'+Result+'"]'
+    else
+      Result:=FBuiltInNames[pbivnModules]+'.'+Result;
+    end;
 end;
 
-Function TPasToJSConverter.TransFormFunctionName(El: TPasElement;
-  AContext: TConvertContext): String;
+function TPasToJSConverter.IsPreservedWord(const aName: string): boolean;
+var
+  l, r, m, cmp: Integer;
 begin
-  Result:=LowerCase(EL.Name);
+  Result:=true;
+  if aName=FBuiltInNames[pbivnModules] then exit;
+  if aName=FBuiltInNames[pbivnRTL] then exit;
+
+  // search default list
+  l:=low(JSReservedWords);
+  r:=high(JSReservedWords);
+  while l<=r do
+    begin
+    m:=(l+r) div 2;
+    cmp:=CompareStr(aName,JSReservedWords[m]);
+    //writeln('TPasToJSConverter.IsPreservedWord Name="',aName,'" l=',l,' r=',r,' m=',m,' JSReservedWords[m]=',JSReservedWords[m],' cmp=',cmp);
+    if cmp>0 then
+      l:=m+1
+    else if cmp<0 then
+      r:=m-1
+    else
+      exit;
+    end;
+
+  // search user list
+  l:=0;
+  r:=length(FPreservedWords)-1;
+  while l<=r do
+    begin
+    m:=(l+r) div 2;
+    cmp:=CompareStr(aName,FPreservedWords[m]);
+    //writeln('TPasToJSConverter.IsPreservedWord Name="',aName,'" l=',l,' r=',r,' m=',m,' FReservedWords[m]=',FReservedWords[m],' cmp=',cmp);
+    if cmp>0 then
+      l:=m+1
+    else if cmp<0 then
+      r:=m-1
+    else
+      exit;
+    end;
+
+  Result:=false;
 end;
 
-Function TPasToJSConverter.ConvertElement(El: TPasElement): TJSElement;
+function TPasToJSConverter.ConvertPasElement(El: TPasElement;
+  Resolver: TPas2JSResolver): TJSElement;
+var
+  aContext: TRootContext;
 begin
-//  CurrentContext:=CreateJSContext(Nil);
-  Result:=ConvertElement(El,Nil);
+  aContext:=TRootContext.Create(El,nil,nil);
+  try
+    aContext.Resolver:=Resolver;
+    if (El.ClassType=TPasImplBeginBlock) then
+      Result:=ConvertBeginEndStatement(TPasImplBeginBlock(El),AContext,false)
+    else
+      Result:=ConvertElement(El,aContext);
+  finally
+    FreeAndNil(aContext);
+  end;
 end;
 
-end.
+var
+  i: integer;
+initialization
+  for i:=low(JSReservedWords) to High(JSReservedWords)-1 do
+    if CompareStr(JSReservedWords[i],JSReservedWords[i+1])>=0 then
+      raise Exception.Create('20170203135442 '+JSReservedWords[i]+' >= '+JSReservedWords[i+1]);
 
+end.
 
diff --git a/packages/pastojs/tests/tcconverter.pp b/packages/pastojs/tests/tcconverter.pp
index ce0b9c60e1..2cae852338 100644
--- a/packages/pastojs/tests/tcconverter.pp
+++ b/packages/pastojs/tests/tcconverter.pp
@@ -11,7 +11,11 @@
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
- **********************************************************************}
+ **********************************************************************
+
+ Examples:
+    ./testpas2js --suite=TTestExpressionConverter.TestVariable
+}
 unit tcconverter;
 
 {$mode objfpc}{$H+}
@@ -19,7 +23,7 @@ unit tcconverter;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, testutils, testregistry, fppas2js, jsbase, jstree, pastree;
+  Classes, SysUtils, fpcunit, testregistry, fppas2js, jsbase, jstree, pastree;
 
 type
 
@@ -59,6 +63,8 @@ type
     Class Function CreateCondition: TPasExpr;
   end;
 
+  { TTestTestConverter }
+
   TTestTestConverter = class(TTestConverter)
   published
     procedure TestEmpty;
@@ -181,8 +187,8 @@ begin
   R:=TPasImplIfElse.Create('',Nil);
   R.ConditionExpr:=CreateCondition;
   E:=TJSIfStatement(Convert(R,TJSIfStatement));
-  AssertEquals('If branch is empty block statement',TJSEmptyBlockStatement,E.btrue.ClassType);
-  AssertNull('No else branch',E.bfalse);
+  AssertNull('If branch is empty',E.BTrue);
+  AssertNull('No else branch',E.BFalse);
   AssertIdentifier('Left hand side OK',E.Cond,'a');
 end;
 
@@ -262,7 +268,6 @@ begin
   E:=TJSExpressionStatement(Convert(R,TJSExpressionStatement));
   AssertNotNull('Have call node',E.A);
   AssertEquals('Have call expression',TJSCallExpression,E.A.ClassType);
-  AssertEquals('Have call expression',TJSCallExpression,E.A.ClassType);
   C:=TJSCallExpression(E.A);
   AssertIdentifier('Call expression',C.Expr,'a');
 end;
@@ -327,7 +332,7 @@ begin
   AssertIdentifier('Conditional expression',TJSUnaryNotExpression(E.Cond).A,'a');
   L:=AssertListStatement('Multiple statements',E.Body);
   AssertAssignStatement('First List statement is assignment',L.A,'b','c');
-  AssertAssignStatement('Second List statement is assignment',L.b,'d','e');
+  AssertAssignStatement('Second List statement is assignment',L.B,'d','e');
 end;
 
 Procedure TTestStatementConverter.TestRepeatUntilStatementThree;
@@ -362,35 +367,51 @@ Var
   F : TPasImplForLoop;
   E : TJSForStatement;
   L : TJSStatementList;
-  VS : TJSVariableStatement;
   VD : TJSVarDeclaration;
   A : TJSSimpleAssignStatement;
   I : TJSUnaryPostPlusPlusExpression;
   C : TJSRelationalExpressionLE;
+  VS: TJSVariableStatement;
+  LoopEndVar: String;
 
 begin
-  // For I:=0 to 100 do a:=b;
+  // For I:=1 to 100 do a:=b;
   F:=TPasImplForLoop.Create('',Nil);
   F.Variable:=TPasVariable.Create('I',F);
-  F.VariableName:='I';
+  F.VariableName:=CreateIdent('I');
   F.StartExpr:=CreateLiteral(1);
   F.EndExpr:=CreateLiteral(100);
   F.Body:=CreateAssignStatement();
   L:=TJSStatementList(Convert(F,TJSStatementList));
-  VS:=TJSVariableStatement(AssertElement('Start with upper limit temp var',TJSVariableStatement,L.A));
-  VD:=TJSVarDeclaration(AssertElement('Have variable',TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for end value','i$endloopvalue',VD.Name);
+  // Should be a list of two statements:
+  //   var $loopend1=100;
+  //   for(i=1; i<=$loopend1; i++){ a:=b; }
+
+  // "var $loopend1=100"
+  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'1';
+  VS:=TJSVariableStatement(AssertElement('First in list is var '+LoopEndVar,TJSVariableStatement,L.A));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
   AssertLiteral('Correct end value',VD.Init,100);
-  E:=TJSForStatement(AssertElement('Second in list is for statement',TJSForStatement,L.B));
-  A:=TJSSimpleAssignStatement(AssertElement('Init statement is assign statement',TJSSimpleAssignStatement,E.Init));
-  AssertLiteral('Init statement RHS is start value',A.Expr,1);
+
+  E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
+
+  // i:=1
+  A:=TJSSimpleAssignStatement(AssertElement('Init statement',TJSSimpleAssignStatement,E.Init));
   AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  AssertLiteral('Init statement RHS is start value',A.Expr,1);
+
+  // i<=$loopend1
+  C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
+  AssertIdentifier('Cond LHS is loop variable',C.A,'i');
+  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
+
+  // i++
   I:=TJSUnaryPostPlusPlusExpression(AssertElement('Increment is ++ statement',TJSUnaryPostPlusPlusExpression,E.Incr));
   AssertIdentifier('++ on correct variable name',I.A,'i');
+
+  // body
   AssertAssignStatement('Correct body',E.Body);
-  C:=TJSRelationalExpressionLE(AssertElement('Condition is <= expression',TJSRelationalExpressionLE,E.Cond));
-  AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is end loop value variable',C.B,'i$endloopvalue');
 end;
 
 Procedure TTestStatementConverter.TestForLoopDown;
@@ -398,36 +419,53 @@ Var
   F : TPasImplForLoop;
   E : TJSForStatement;
   L : TJSStatementList;
-  VS : TJSVariableStatement;
   VD : TJSVarDeclaration;
   A : TJSSimpleAssignStatement;
   I : TJSUnaryPostMinusMinusExpression;
   C : TJSRelationalExpressionGE;
+  VS: TJSVariableStatement;
+  LoopEndVar: String;
 
 begin
-  // For I:=0 to 100 do a:=b;
+  // For I:=100 downto 1 do a:=b;
   F:=TPasImplForLoop.Create('',Nil);
   F.Variable:=TPasVariable.Create('I',F);
-  F.VariableName:='I';
+  F.VariableName:=CreateIdent('I');
   F.StartExpr:=CreateLiteral(100);
   F.EndExpr:=CreateLiteral(1);
   F.LoopType:=ltDown;
   F.Body:=CreateAssignStatement();
   L:=TJSStatementList(Convert(F,TJSStatementList));
-  VS:=TJSVariableStatement(AssertElement('Start with upper limit temp var',TJSVariableStatement,L.A));
-  VD:=TJSVarDeclaration(AssertElement('Have variable',TJSVarDeclaration,VS.A));
-  AssertEquals('Correct name for end value','i$endloopvalue',VD.Name);
+
+  // Should be a list of two statements:
+  //   var $loopend1=1;
+  //   for(i=100; i>=$loopend1; i--){ a:=b; }
+
+  // "var $loopend1=1"
+  LoopEndVar:=Pas2JSBuiltInNames[pbivnLoopEnd]+'1';
+  VS:=TJSVariableStatement(AssertElement('var '+LoopEndVar,TJSVariableStatement,L.A));
+  VD:=TJSVarDeclaration(AssertElement('var '+LoopEndVar,TJSVarDeclaration,VS.A));
+  AssertEquals('Correct name for '+LoopEndVar,LoopEndVar,VD.Name);
   AssertLiteral('Correct end value',VD.Init,1);
-  E:=TJSForStatement(AssertElement('Second in list is for statement',TJSForStatement,L.B));
-  A:=TJSSimpleAssignStatement(AssertElement('Init statement is assign statement',TJSSimpleAssignStatement,E.Init));
-  AssertLiteral('Init statement RHS is start value',A.Expr,100);
+
+  E:=TJSForStatement(AssertElement('Second in list is "for" statement',TJSForStatement,L.B));
+
+  // i=100;
+  A:=TJSSimpleAssignStatement(AssertElement('First in list is Init statement',TJSSimpleAssignStatement,E.Init));
   AssertIdentifier('Init statement LHS is loop variable',A.LHS,'i');
+  AssertLiteral('Init statement RHS is start value',A.Expr,100);
+
+  // i>=$loopend1
+  C:=TJSRelationalExpressionGE(AssertElement('Condition is >= expression',TJSRelationalExpressionGE,E.Cond));
+  AssertIdentifier('Cond LHS is loop variable',C.A,'i');
+  AssertIdentifier('Cond RHS is '+LoopEndVar,C.B,LoopEndVar);
+
+  // i--
   I:=TJSUnaryPostMinusMinusExpression(AssertElement('Increment is -- statement',TJSUnaryPostMinusMinusExpression,E.Incr));
-  AssertIdentifier('++ on correct variable name',I.A,'i');
+  AssertIdentifier('-- on correct variable name',I.A,'i');
+
+  // body
   AssertAssignStatement('Correct body',E.Body);
-  C:=TJSRelationalExpressionGE(AssertElement('Condition is <= expression',TJSRelationalExpressionGE,E.Cond));
-  AssertIdentifier('Cond LHS is loop variable',C.A,'i');
-  AssertIdentifier('Cond RHS is end loop value variable',C.B,'i$endloopvalue');
 end;
 
 Procedure TTestStatementConverter.TestBeginEndBlockEmpty;
@@ -564,22 +602,36 @@ Procedure TTestStatementConverter.TestTryExceptStatement;
 Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
+  ExceptObjName: String;
 
 begin
-  // Try a:=B except b:=c end;
+  // Try a:=b except b:=c end;
+  (*
+    Becomes:
+    try {
+     a=b;
+    } catch ($e) {
+      b = c;
+    }
+  *)
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
   F.AddElement(CreateAssignStatement('b','c'));
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  L:=AssertListStatement('try..except block is statement list',EL.Block);
+  // Convert
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
+  // check "catch(exceptobject)"
+  ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
+  AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
+  // check "a=b;"
+  L:=AssertListStatement('try..except block is statement list',El.Block);
   AssertAssignStatement('Correct assignment in try..except block',L.A,'a','b');
   AssertNull('No second statement',L.B);
+  // check "b=c;'
   L:=AssertListStatement('try..except block is statement list',El.BCatch);
   AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
-  AssertEquals('Correct exception object name','jsexception',EL.Ident);
   AssertNull('No second statement',L.B);
 end;
 
@@ -589,47 +641,59 @@ Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
   O : TPasImplExceptOn;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
   I : TJSIfStatement;
-  IC : TJSRelationalExpressionInstanceOf;
-  V : TJSVarDeclaration;
+  IC : TJSCallExpression;
+  D: TJSDotMemberExpression;
+  ExObj: TJSElement;
+  VS: TJSVariableStatement;
+  V: TJSVarDeclaration;
+  ExceptObjName: String;
 
 begin
   // Try a:=B except on E : exception do  b:=c end;
-  // Try a:=B except on E : exception do  b:=c end;
-  {
+  (*
     Becomes:
     try {
      a=b;
-    } catch (jsexception) {
-      if jsexception instanceof exception {
-        var e = jsexception;
+    } catch (exceptobject) {
+      if (exception.isPrototypeOf(exceptobject)) {
+        var e = exceptobject;
         b = c;
       }
     }
-  }
+  *)
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
-  O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
+  O:=F.AddExceptOn('E','Exception');
   O.Body:=CreateAssignStatement('b','c');
   // Convert
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('Correct exception object name','jsexception',EL.Ident);
-  L:=AssertListStatement('try..except block is statement list',El.BCatch);
-  AssertNull('No second statement',L.B);
-  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
-  Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
-  Assertidentifier('InstanceOf left is exception object',Ic.A,'jsexception');
-  // Lowercased exception - May need checking
-  Assertidentifier('InstanceOf right is original exception type',Ic.B,'exception');
-  L:=AssertListStatement('On block is always a list',i.btrue);
-  V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
+  // check "catch(exceptobject)"
+  ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
+  AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
+  // check "if"
+  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
+  // check if condition "exception.isPrototypeOf(exceptobject)"
+  IC:=TJSCallExpression(AssertElement('If condition is call expression',TJSCallExpression,I.Cond));
+  D:=TJSDotMemberExpression(AssertElement('exception.isPrototypeOf is dot member expression',TJSDotMemberExpression,IC.Expr));
+  Assertidentifier('left side of exception.isPrototypeOf',D.MExpr,'exception');
+  AssertEquals('right side of exception.isPrototypeOf','isPrototypeOf',String(D.Name));
+  AssertNotNull('args of exception.isPrototypeOf(exceptobject)',IC.Args);
+  AssertEquals('args of exception.isPrototypeOf(exceptobject)',1,IC.Args.Elements.Count);
+  ExObj:=IC.Args.Elements.Elements[0].Expr;
+  Assertidentifier('arg of exception.isPrototypeOf(exceptobject)',ExObj,ExceptObjName);
+  // check statement "var e = exceptobject;"
+  L:=AssertListStatement('On block is always a list',I.BTrue);
+  writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
+  VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
+  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',v.init,'jsexception');
-  L:=AssertListStatement('Second statement is again list',L.B);
-  AssertAssignStatement('Original assignment in second statement',L.A,'b','c');
+  Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
+  // check "b = c;"
+  AssertAssignStatement('Original assignment in second statement',L.B,'b','c');
 end;
 
 Procedure TTestStatementConverter.TestReRaise;
@@ -637,47 +701,60 @@ Var
   T : TPasImplTry;
   F : TPasImplTryExcept;
   O : TPasImplExceptOn;
-  El : TJSTryFinallyStatement;
+  El : TJSTryCatchStatement;
   L : TJSStatementList;
   I : TJSIfStatement;
-  IC : TJSRelationalExpressionInstanceOf;
+  IC : TJSCallExpression;
   R : TJSThrowStatement;
   V : TJSVarDeclaration;
+  D: TJSDotMemberExpression;
+  ExObj: TJSElement;
+  VS: TJSVariableStatement;
+  ExceptObjName: String;
 
 begin
-  // Try a:=B except on E : exception do  b:=c end;
-  {
+  // Try a:=B except on E : exception do raise; end;
+  (*
     Becomes:
     try {
      a=b;
-    } catch (jsexception) {
-      if jsexception instanceof exception {
-        var e = jsexception;
-        throw jsexception;
+    } catch ($e) {
+      if (exception.isPrototypeOf($e)) {
+        var e = $e;
+        throw $e;
       }
     }
-  }
+  *)
   T:=TPasImplTry.Create('',Nil);
   T.AddElement(CreateAssignStatement('a','b'));
   F:=T.AddExcept;
-  O:=F.AddExceptOn(CreateIdent('E'),CreateIdent('Exception'));
+  O:=F.AddExceptOn('E','Exception');
   O.Body:=TPasImplRaise.Create('',Nil);
   // Convert
-  El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
-  AssertEquals('Correct exception object name','jsexception',EL.Ident);
-  L:=AssertListStatement('try..except block is statement list',El.BCatch);
-  AssertNull('No second statement',L.B);
-  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
-  Ic:=TJSRelationalExpressionInstanceOf(AssertElement('If condition is InstanceOf expression',TJSRelationalExpressionInstanceOf,I.Cond));
-  Assertidentifier('InstanceOf left is exception object',Ic.A,'jsexception');
-  // Lowercased exception - May need checking
-  L:=AssertListStatement('On block is always a list',i.btrue);
-  V:=TJSVarDeclaration(AssertElement('First statement in list is a var declaration',TJSVarDeclaration,L.A));
+  El:=TJSTryCatchStatement(Convert(T,TJSTryCatchStatement));
+  // check "catch(exceptobject)"
+  ExceptObjName:=lowercase(Pas2JSBuiltInNames[pbivnExceptObject]);
+  AssertEquals('Correct exception object name',ExceptObjName,String(El.Ident));
+  // check "if"
+  I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,El.BCatch));
+  // check if condition "exception.isPrototypeOf(exceptobject)"
+  IC:=TJSCallExpression(AssertElement('If condition is call expression',TJSCallExpression,I.Cond));
+  D:=TJSDotMemberExpression(AssertElement('exception.isPrototypeOf is dot member expression',TJSDotMemberExpression,IC.Expr));
+  Assertidentifier('left side of exception.isPrototypeOf',D.MExpr,'exception');
+  AssertEquals('right side of exception.isPrototypeOf','isPrototypeOf',String(D.Name));
+  AssertNotNull('args of exception.isPrototypeOf(ExceptObject)',IC.Args);
+  AssertEquals('args of exception.isPrototypeOf(ExceptObject)',1,IC.Args.Elements.Count);
+  ExObj:=IC.Args.Elements.Elements[0].Expr;
+  Assertidentifier('arg of exception.isPrototypeOf(ExceptObject)',ExObj,ExceptObjName);
+  // check statement "var e = exceptobject;"
+  L:=AssertListStatement('On block is always a list',I.BTrue);
+  writeln('TTestStatementConverter.TestTryExceptStatementOnE ',L.A.ClassName);
+  VS:=TJSVariableStatement(AssertElement('First statement in list is a var statement',TJSVariableStatement,L.A));
+  V:=TJSVarDeclaration(AssertElement('var declaration e=ExceptObject',TJSVarDeclaration,VS.A));
   AssertEquals('Variable name is identifier in On A : Ex do','e',V.Name);
-  Assertidentifier('Variable init is exception object',v.init,'jsexception');
-  L:=AssertListStatement('Second statement is again list',L.B);
-  R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.A));
-  Assertidentifier('R expression is original exception ',R.A,'jsexception');
+  Assertidentifier('Variable init is exception object',V.Init,ExceptObjName);
+  R:=TJSThrowStatement(AssertElement('On block is throw statement',TJSThrowStatement,L.B));
+  Assertidentifier('R expression is original exception ',R.A,ExceptObjName);
 end;
 
 Procedure TTestStatementConverter.TestVariableStatement;
@@ -724,6 +801,7 @@ begin
   AssertNotNull('Convert returned a result',E);
   if not (E is TJSUnary) then
     Fail('Do not have unary class, but: '+E.ClassName);
+  AssertEquals('TTestExpressionConverter.TestUnaryExpression: wrong class',AClass.ClassName,E.ClassName);
   Result:=TJSUnary(E);
 end;
 
@@ -750,7 +828,7 @@ begin
   S:=TPrimitiveExpr.Create(Nil,pekString,'''me''');
   E:=TestLiteralExpression(S,TJSLiteral);
   AssertEquals('Correct literal type',jstString,E.Value.ValueType);
-  AssertEquals('Correct literal value','me',E.Value.AsString);
+  AssertEquals('Correct literal value','me',String(E.Value.AsString));
 end;
 
 Procedure TTestExpressionConverter.TestPrimitiveNumber;
@@ -811,7 +889,7 @@ Var
 begin
   Id:=TPrimitiveExpr.Create(Nil,pekIdent,'a');
   Res:=TJSPrimaryExpressionIdent(Convert(Id,TJSPrimaryExpressionIdent));
-  AssertEquals('Correct identifier name','a',Res.Name);
+  AssertEquals('Correct identifier name','a',String(Res.Name));
 end;
 
 Procedure TTestExpressionConverter.TestUnaryMinus;
@@ -900,12 +978,15 @@ Procedure TTestExpressionConverter.TestBinaryDiv;
 Var
   B : TBinaryExpr;
   E : TJSMultiplicativeExpressionDiv;
-
+  C: TJSCallExpression;
+  Args: TJSArguments;
 begin
   B:=TBinaryExpr.Create(Nil,pekBinary,eopDiv);
   B.left:=CreateLiteral(1.23);
   B.Right:=CreateLiteral(3.45);
-  E:=TJSMultiplicativeExpressionDiv(TestBinaryExpression(B,TJSMultiplicativeExpressionDiv));
+  C:=TJSCallExpression(Convert(B,TJSCallExpression));
+  Args:=TJSArguments(AssertElement('Math.floor param',TJSArguments,C.Args));
+  E:=TJSMultiplicativeExpressionDiv(AssertElement('param',TJSMultiplicativeExpressionDiv,Args.Elements.Elements[0].Expr));
   AssertLiteral('Correct left literal for div',E.A,1.23);
   AssertLiteral('Correct right literal for div',E.B,3.45);
 end;
@@ -941,13 +1022,13 @@ end;
 Procedure TTestExpressionConverter.TestBinarySHR;
 Var
   B : TBinaryExpr;
-  E : TJSRShiftExpression;
+  E : TJSURShiftExpression;
 
 begin
   B:=TBinaryExpr.Create(Nil,pekBinary,eopSHR);
   B.left:=CreateLiteral(13);
   B.Right:=CreateLiteral(3);
-  E:=TJSRShiftExpression(TestBinaryExpression(B,TJSRShiftExpression));
+  E:=TJSURShiftExpression(TestBinaryExpression(B,TJSURShiftExpression));
   AssertLiteral('Correct left literal for shr',E.A,13);
   AssertLiteral('Correct right literal for shr',E.B,3);
 end;
@@ -1118,8 +1199,6 @@ end;
 Procedure TTestExpressionConverter.TestMemberExpressionArrayTwoDim;
 Var
   B : TParamsExpr;
-  E : TJSBracketMemberExpression;
-
 begin
   // a[b,c];
   B:=TParamsExpr.Create(Nil,pekArrayParams,eopNone);
@@ -1127,7 +1206,7 @@ begin
   B.AddParam(CreateIdent('b'));
   B.AddParam(CreateIdent('c'));
   AttemptConvert:=B;
-  AssertException('Cannot yet convert 2-dim arrays',EPasToJS,@TryConvert);
+  AssertException('Pascal element not supported: TParamsExpr:TParamsExpr: Cannot convert 2-dim arrays',EPas2JS,@TryConvert);
 end;
 
 Procedure TTestExpressionConverter.TestVariable;
@@ -1139,7 +1218,7 @@ begin
   R:=TPasVariable.Create('A',Nil);
   VD:=TJSVarDeclaration(Convert(R,TJSVarDeclaration));
   AssertEquals('Correct name, lowercased','a',VD.Name);
-  AssertNull('No init',VD.Init);
+  AssertNotNull('No init',VD.Init);
 end;
 
 Procedure TTestExpressionConverter.TestArrayVariable;
@@ -1183,7 +1262,7 @@ Function TTestConverter.Convert(AElement: TPasElement; AClass: TJSElementClass
   ): TJSElement;
 begin
   FSource:=AElement;
-  Result:=FConverter.ConvertElement(AElement);
+  Result:=FConverter.ConvertPasElement(AElement,nil);
   FRes:=Result;
   if (AClass<>Nil) then
     begin
@@ -1214,7 +1293,7 @@ end;
 Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSString);
 begin
   AssertLiteral(Msg,Lit,jstString);
-  AssertEquals(Msg+': Correct value',AValue,TJSLiteral(Lit).Value.AsString);
+  AssertEquals(Msg+': Correct value',String(AValue),String(TJSLiteral(Lit).Value.AsString));
 end;
 
 Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSNumber);
@@ -1228,12 +1307,12 @@ Class procedure TTestConverter.AssertIdentifier(Const Msg: String;
 begin
   AssertNotNull(Msg+': Have instance',Ident);
   AssertEquals(Msg+': Correct class',TJSPrimaryExpressionIdent,Ident.ClassType);
-  AssertEquals(Msg+': Correct name',AName,TJSPrimaryExpressionIdent(Ident).Name);
+  AssertEquals(Msg+': Correct name',AName,String(TJSPrimaryExpressionIdent(Ident).Name));
 end;
 
 Class Function TTestConverter.CreateLiteral(AValue: String): TPasExpr;
 begin
-  Result:=TPrimitiveExpr.Create(Nil,pekString,'me');
+  Result:=TPrimitiveExpr.Create(Nil,pekString,AValue);
 end;
 
 Class Function TTestConverter.CreateLiteral(AValue: Double): TPasExpr;
@@ -1243,7 +1322,7 @@ Var
 
 begin
   Str(AValue,S);
-  Result:=TPrimitiveExpr.Create(Nil,pekNumber,S);
+  Result:=TPrimitiveExpr.Create(Nil,pekNumber,Trim(S));
 end;
 
 Class Function TTestConverter.CreateIdent(AName: String): TPrimitiveExpr;
@@ -1283,7 +1362,7 @@ Class Procedure TTestConverter.AssertAssignStatement(Const Msg : String; El : TJ
 begin
   AssertNotNull(Msg+': have statement',EL);
   If not (El is TJSSimpleAssignStatement) then
-    Fail(Msg+': statement is not assign statement but is'+El.ClassName);
+    Fail(Msg+': statement is not assign statement but is '+El.ClassName);
   AssertIdentifier(Msg+': left hand side ('+LHS+')',TJSAssignStatement(EL).LHS,LHS);
   AssertIdentifier(Msg+': left hand side ('+LHS+')',TJSAssignStatement(EL).Expr,RHS);
 end;
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
new file mode 100644
index 0000000000..bb5d214734
--- /dev/null
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -0,0 +1,13689 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2014 by Michael Van Canneyt
+
+    Unit tests for Pascal-to-Javascript converter class.
+
+    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.
+
+ **********************************************************************
+
+ Examples:
+    ./testpas2js --suite=TTestModule.TestEmptyProgram
+    ./testpas2js --suite=TTestModule.TestEmptyUnit
+}
+unit tcmodules;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, contnrs, fppas2js, pastree,
+  PScanner, PasResolver, PParser, PasResolveEval, jstree, jswriter, jsbase;
+
+const
+  // default parser+scanner options
+  po_pas2js = [po_asmwhole,po_resolvestandardtypes];
+  co_tcmodules = [coNoTypeInfo];
+type
+
+  { TTestPasParser }
+
+  TTestPasParser = Class(TPasParser)
+  end;
+
+  TOnFindUnit = function(const aUnitName: String): TPasModule of object;
+
+  { TTestEnginePasResolver }
+
+  TTestEnginePasResolver = class(TPas2JsResolver)
+  private
+    FFilename: string;
+    FModule: TPasModule;
+    FOnFindUnit: TOnFindUnit;
+    FParser: TTestPasParser;
+    FResolver: TStreamResolver;
+    FScanner: TPascalScanner;
+    FSource: string;
+    procedure SetModule(AValue: TPasModule);
+  public
+    destructor Destroy; override;
+    function FindModule(const AName: String): TPasModule; override;
+    property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
+    property Filename: string read FFilename write FFilename;
+    property Resolver: TStreamResolver read FResolver write FResolver;
+    property Scanner: TPascalScanner read FScanner write FScanner;
+    property Parser: TTestPasParser read FParser write FParser;
+    property Source: string read FSource write FSource;
+    property Module: TPasModule read FModule write SetModule;
+  end;
+
+  { TCustomTestModule }
+
+  TCustomTestModule = Class(TTestCase)
+  private
+    FConverter: TPasToJSConverter;
+    FEngine: TTestEnginePasResolver;
+    FExpectedErrorClass: ExceptClass;
+    FExpectedErrorMsg: string;
+    FExpectedErrorNumber: integer;
+    FFilename: string;
+    FFileResolver: TStreamResolver;
+    FJSImplementationSrc: TJSSourceElements;
+    FJSImplementationUses: TJSArrayLiteral;
+    FJSInitBody: TJSFunctionBody;
+    FJSImplentationUses: TJSArrayLiteral;
+    FJSInterfaceUses: TJSArrayLiteral;
+    FJSModule: TJSSourceElements;
+    FJSModuleSrc: TJSSourceElements;
+    FJSSource: TStringList;
+    FModule: TPasModule;
+    FJSModuleCallArgs: TJSArguments;
+    FModules: TObjectList;// list of TTestEnginePasResolver
+    FParser: TTestPasParser;
+    FPasProgram: TPasProgram;
+    FJSRegModuleCall: TJSCallExpression;
+    FScanner: TPascalScanner;
+    FSkipTests: boolean;
+    FSource: TStringList;
+    FFirstPasStatement: TPasImplBlock;
+    function GetModuleCount: integer;
+    function GetModules(Index: integer): TTestEnginePasResolver;
+    function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
+    function FindUnit(const aUnitName: String): TPasModule;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure Add(Line: string); virtual;
+    Procedure Add(const Lines: array of string);
+    Procedure StartParsing; virtual;
+    procedure ParseModule; virtual;
+    procedure ParseProgram; virtual;
+    procedure ParseUnit; virtual;
+  protected
+    function FindModuleWithFilename(aFilename: string): TTestEnginePasResolver; virtual;
+    function AddModule(aFilename: string): TTestEnginePasResolver; virtual;
+    function AddModuleWithSrc(aFilename, Src: string): TTestEnginePasResolver; virtual;
+    function AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+      ImplementationSrc: string): TTestEnginePasResolver; virtual;
+    procedure AddSystemUnit; virtual;
+    procedure StartProgram(NeedSystemUnit: boolean); virtual;
+    procedure StartUnit(NeedSystemUnit: boolean); virtual;
+    procedure ConvertModule; virtual;
+    procedure ConvertProgram; virtual;
+    procedure ConvertUnit; virtual;
+    procedure CheckDottedIdentifier(Msg: string; El: TJSElement; DottedName: string);
+    function GetDottedIdentifier(El: TJSElement): string;
+    procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
+      ImplStatements: string = ''); virtual;
+    procedure CheckDiff(Msg, Expected, Actual: string); virtual;
+    procedure SetExpectedScannerError(Msg: string; MsgNumber: integer);
+    procedure SetExpectedParserError(Msg: string; MsgNumber: integer);
+    procedure SetExpectedPasResolverError(Msg: string; MsgNumber: integer);
+    procedure SetExpectedConverterError(Msg: string; MsgNumber: integer);
+    function IsErrorExpected(E: Exception): boolean;
+    procedure HandleScannerError(E: EScannerError);
+    procedure HandleParserError(E: EParserError);
+    procedure HandlePasResolveError(E: EPasResolve);
+    procedure HandlePas2JSError(E: EPas2JS);
+    procedure HandleException(E: Exception);
+    procedure RaiseException(E: Exception);
+    procedure WriteSources(const aFilename: string; aRow, aCol: integer);
+    function GetDefaultNamespace: string;
+    property PasProgram: TPasProgram Read FPasProgram;
+    property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
+    property ModuleCount: integer read GetModuleCount;
+    property Engine: TTestEnginePasResolver read FEngine;
+    property Filename: string read FFilename;
+    Property Module: TPasModule Read FModule;
+    property FirstPasStatement: TPasImplBlock read FFirstPasStatement;
+    property Converter: TPasToJSConverter read FConverter;
+    property JSSource: TStringList read FJSSource;
+    property JSModule: TJSSourceElements read FJSModule;
+    property JSRegModuleCall: TJSCallExpression read FJSRegModuleCall;
+    property JSModuleCallArgs: TJSArguments read FJSModuleCallArgs;
+    property JSImplementationUses: TJSArrayLiteral read FJSImplementationUses;
+    property JSInterfaceUses: TJSArrayLiteral read FJSInterfaceUses;
+    property JSModuleSrc: TJSSourceElements read FJSModuleSrc;
+    property JSInitBody: TJSFunctionBody read FJSInitBody;
+    property JSImplementationSrc: TJSSourceElements read FJSImplementationSrc;
+    property ExpectedErrorClass: ExceptClass read FExpectedErrorClass write FExpectedErrorClass;
+    property ExpectedErrorMsg: string read FExpectedErrorMsg write FExpectedErrorMsg;
+    property ExpectedErrorNumber: integer read FExpectedErrorNumber write FExpectedErrorNumber;
+    property SkipTests: boolean read FSkipTests write FSkipTests;
+  public
+    property Source: TStringList read FSource;
+    property FileResolver: TStreamResolver read FFileResolver;
+    property Scanner: TPascalScanner read FScanner;
+    property Parser: TTestPasParser read FParser;
+  end;
+
+  { TTestModule }
+
+  TTestModule = class(TCustomTestModule)
+  Published
+    // modules
+    Procedure TestEmptyProgram;
+    Procedure TestEmptyProgramUseStrict;
+    Procedure TestEmptyUnit;
+    Procedure TestEmptyUnitUseStrict;
+    Procedure TestDottedUnitNames;
+    Procedure TestDottedUnitExpr;
+    Procedure Test_ModeFPCFail;
+    Procedure Test_ModeSwitchCBlocksFail;
+
+    // vars/const
+    Procedure TestVarInt;
+    Procedure TestVarBaseTypes;
+    Procedure TestBaseTypeSingleFail;
+    Procedure TestBaseTypeExtendedFail;
+    Procedure TestConstBaseTypes;
+    Procedure TestUnitImplVars;
+    Procedure TestUnitImplConsts;
+    Procedure TestUnitImplRecord;
+    Procedure TestRenameJSNameConflict;
+    Procedure TestLocalConst;
+    Procedure TestVarExternal;
+    Procedure TestVarExternalOtherUnit;
+
+    // numbers
+    Procedure TestDouble;
+
+    // strings
+    Procedure TestCharConst;
+    Procedure TestChar_Compare;
+    Procedure TestChar_Ord;
+    Procedure TestChar_Chr;
+    Procedure TestStringConst;
+    Procedure TestString_Length;
+    Procedure TestString_Compare;
+    Procedure TestString_SetLength;
+    Procedure TestString_CharAt;
+    Procedure TestStr;
+    Procedure TestBaseType_AnsiStringFail;
+    Procedure TestBaseType_UnicodeStringFail;
+    Procedure TestBaseType_ShortStringFail;
+    Procedure TestBaseType_RawByteStringFail;
+    Procedure TestTypeShortstring_Fail;
+
+    // alias types
+    Procedure TestAliasTypeRef;
+    Procedure TestTypeCast_BaseTypes;
+    Procedure TestTypeCast_AliasBaseTypes;
+
+    // functions
+    Procedure TestEmptyProc;
+    Procedure TestProcOneParam;
+    Procedure TestFunctionWithoutParams;
+    Procedure TestProcedureWithoutParams;
+    Procedure TestPrgProcVar;
+    Procedure TestProcTwoArgs;
+    Procedure TestProc_DefaultValue;
+    Procedure TestUnitProcVar;
+    Procedure TestImplProc;
+    Procedure TestFunctionResult;
+    Procedure TestNestedProc;
+    Procedure TestForwardProc;
+    Procedure TestNestedForwardProc;
+    Procedure TestAssignFunctionResult;
+    Procedure TestFunctionResultInCondition;
+    Procedure TestExit;
+    Procedure TestBreak;
+    Procedure TestContinue;
+    Procedure TestProc_External;
+    Procedure TestProc_ExternalOtherUnit;
+    Procedure TestProc_Asm;
+    Procedure TestProc_Assembler;
+    Procedure TestProc_VarParam;
+    Procedure TestProc_Overload;
+    Procedure TestProc_OverloadForward;
+    Procedure TestProc_OverloadUnit;
+    Procedure TestProc_OverloadNested;
+    Procedure TestProc_Varargs;
+
+    // enums, sets
+    Procedure TestEnum_Name;
+    Procedure TestEnum_Number;
+    Procedure TestEnum_Functions;
+    Procedure TestEnum_AsParams;
+    Procedure TestSet;
+    Procedure TestSet_Operators;
+    Procedure TestSet_Operator_In;
+    Procedure TestSet_Functions;
+    Procedure TestSet_PassAsArgClone;
+    Procedure TestSet_AsParams;
+    Procedure TestSet_Property;
+    Procedure TestSet_EnumConst;
+    Procedure TestSet_AnonymousEnumType;
+    Procedure TestSet_CharFail;
+    Procedure TestSet_BooleanFail;
+    Procedure TestSet_ConstEnum;
+    Procedure TestSet_ConstChar;
+
+    // statements
+    Procedure TestNestBegin;
+    Procedure TestIncDec;
+    Procedure TestAssignments;
+    Procedure TestArithmeticOperators1;
+    Procedure TestLogicalOperators;
+    Procedure TestBitwiseOperators;
+    Procedure TestFunctionInt;
+    Procedure TestFunctionString;
+    Procedure TestForLoop;
+    Procedure TestForLoopInFunction;
+    Procedure TestForLoop_ReadVarAfter;
+    Procedure TestForLoop_Nested;
+    Procedure TestRepeatUntil;
+    Procedure TestAsmBlock;
+    Procedure TestAsmPas_Impl; // ToDo
+    Procedure TestTryFinally;
+    Procedure TestTryExcept;
+    Procedure TestCaseOf;
+    Procedure TestCaseOf_UseSwitch;
+    Procedure TestCaseOfNoElse;
+    Procedure TestCaseOfNoElse_UseSwitch;
+    Procedure TestCaseOfRange;
+
+    // arrays
+    Procedure TestArray_Dynamic;
+    Procedure TestArray_Dynamic_Nil;
+    Procedure TestArray_DynMultiDimensional;
+    Procedure TestArrayOfRecord;
+    // ToDo: Procedure TestArrayOfSet;
+    Procedure TestArray_AsParams;
+    Procedure TestArrayElement_AsParams;
+    Procedure TestArrayElementFromFuncResult_AsParams;
+    Procedure TestArrayEnumTypeRange;
+    Procedure TestArray_SetLengthOutArg;
+    Procedure TestArray_SetLengthProperty;
+    Procedure TestArray_OpenArrayOfString;
+    Procedure TestArray_Concat;
+    Procedure TestArray_Copy;
+    Procedure TestArray_InsertDelete;
+    Procedure TestArray_DynArrayConst;
+    Procedure TestExternalClass_TypeCastArrayToExternalArray;
+    Procedure TestExternalClass_TypeCastArrayFromExternalArray;
+    // ToDo: static array const
+    // ToDo: SetLength(array of static array)
+    // ToDo: SetLength(dim1,dim2)
+
+    // record
+    Procedure TestRecord_Var;
+    Procedure TestWithRecordDo;
+    Procedure TestRecord_Assign;
+    Procedure TestRecord_PassAsArgClone;
+    Procedure TestRecord_AsParams;
+    Procedure TestRecordElement_AsParams;
+    Procedure TestRecordElementFromFuncResult_AsParams;
+    Procedure TestRecordElementFromWith_AsParams;
+    Procedure TestRecord_Equal;
+    Procedure TestRecord_TypeCastJSValueToRecord;
+    // ToDo: const record
+
+    // classes
+    Procedure TestClass_TObjectDefaultConstructor;
+    Procedure TestClass_TObjectConstructorWithParams;
+    Procedure TestClass_Var;
+    Procedure TestClass_Method;
+    Procedure TestClass_Implementation;
+    Procedure TestClass_Inheritance;
+    Procedure TestClass_AbstractMethod;
+    Procedure TestClass_CallInherited_NoParams;
+    Procedure TestClass_CallInherited_WithParams;
+    Procedure TestClasS_CallInheritedConstructor;
+    Procedure TestClass_ClassVar;
+    Procedure TestClass_CallClassMethod;
+    Procedure TestClass_Property;
+    Procedure TestClass_Property_ClassMethod;
+    Procedure TestClass_Property_Index;
+    Procedure TestClass_PropertyOfTypeArray;
+    Procedure TestClass_PropertyDefault;
+    Procedure TestClass_PropertyOverride;
+    Procedure TestClass_Assigned;
+    Procedure TestClass_WithClassDoCreate;
+    Procedure TestClass_WithClassInstDoProperty;
+    Procedure TestClass_WithClassInstDoPropertyWithParams;
+    Procedure TestClass_WithClassInstDoFunc;
+    Procedure TestClass_TypeCast;
+    Procedure TestClass_TypeCastUntypedParam;
+    Procedure TestClass_Overloads;
+    Procedure TestClass_OverloadsAncestor;
+    Procedure TestClass_OverloadConstructor;
+    Procedure TestClass_ReintroducedVar;
+    Procedure TestClass_RaiseDescendant;
+    Procedure TestClass_ExternalMethod;
+    Procedure TestClass_ExternalVirtualNameMismatchFail;
+    Procedure TestClass_ExternalOverrideFail;
+    Procedure TestClass_ExternalVar;
+    Procedure TestClass_Const;
+    Procedure TestClass_LocalVarSelfFail;
+    Procedure TestClass_ArgSelfFail;
+    Procedure TestClass_NestedSelf;
+    Procedure TestClass_NestedClassSelf;
+    Procedure TestClass_NestedCallInherited;
+    Procedure TestClass_TObjectFree;
+    Procedure TestClass_TObjectFreeNewInstance;
+    Procedure TestClass_TObjectFreeLowerCase;
+    Procedure TestClass_TObjectFreeFunctionFail;
+    Procedure TestClass_TObjectFreePropertyFail;
+
+    // class of
+    Procedure TestClassOf_Create;
+    Procedure TestClassOf_Call;
+    Procedure TestClassOf_Assign;
+    Procedure TestClassOf_Is;
+    Procedure TestClassOf_Compare;
+    Procedure TestClassOf_ClassVar;
+    Procedure TestClassOf_ClassMethod;
+    Procedure TestClassOf_ClassProperty;
+    Procedure TestClassOf_ClassMethodSelf;
+    Procedure TestClassOf_TypeCast;
+    Procedure TestClassOf_ImplicitFunctionCall;
+
+    // nested class
+    Procedure TestNestedClass_Fail;
+
+    // external class
+    Procedure TestExternalClass_Var;
+    //ToDo Procedure TestExternalClass_Const;
+    Procedure TestExternalClass_Dollar;
+    Procedure TestExternalClass_DuplicateVarFail;
+    Procedure TestExternalClass_Method;
+    Procedure TestExternalClass_NonExternalOverride;
+    Procedure TestExternalClass_Property;
+    Procedure TestExternalClass_ClassProperty;
+    Procedure TestExternalClass_ClassOf;
+    Procedure TestExternalClass_ClassOtherUnit;
+    Procedure TestExternalClass_Is;
+    Procedure TestExternalClass_As;
+    Procedure TestExternalClass_DestructorFail;
+    Procedure TestExternalClass_New;
+    Procedure TestExternalClass_ClassOf_New;
+    Procedure TestExternalClass_FuncClassOf_New;
+    Procedure TestExternalClass_LocalConstSameName;
+    Procedure TestExternalClass_ReintroduceOverload;
+    Procedure TestExternalClass_Inherited;
+    Procedure TestExternalClass_PascalAncestorFail;
+    Procedure TestExternalClass_NewInstance;
+    Procedure TestExternalClass_NewInstance_NonVirtualFail;
+    Procedure TestExternalClass_NewInstance_FirstParamNotString_Fail;
+    Procedure TestExternalClass_NewInstance_SecondParamTyped_Fail;
+    Procedure TestExternalClass_PascalProperty;
+    Procedure TestExternalClass_TypeCastToRootClass;
+    Procedure TestExternalClass_TypeCastStringToExternalString;
+    Procedure TestExternalClass_CallClassFunctionOfInstanceFail;
+    Procedure TestExternalClass_BracketAccessor;
+    Procedure TestExternalClass_BracketAccessor_2ParamsFail;
+    Procedure TestExternalClass_BracketAccessor_ReadOnly;
+    Procedure TestExternalClass_BracketAccessor_WriteOnly;
+    Procedure TestExternalClass_BracketAccessor_MultiType;
+    Procedure TestExternalClass_BracketAccessor_Index;
+
+    // proc types
+    Procedure TestProcType;
+    Procedure TestProcType_FunctionFPC;
+    Procedure TestProcType_FunctionDelphi;
+    Procedure TestProcType_AsParam;
+    Procedure TestProcType_MethodFPC;
+    Procedure TestProcType_MethodDelphi;
+    Procedure TestProcType_PropertyFPC;
+    Procedure TestProcType_PropertyDelphi;
+    Procedure TestProcType_WithClassInstDoPropertyFPC;
+    Procedure TestProcType_Nested;
+    Procedure TestProcType_NestedOfObject;
+    Procedure TestProcType_ReferenceToProc;
+    Procedure TestProcType_ReferenceToMethod;
+    Procedure TestProcType_Typecast;
+    Procedure TestProcType_PassProcToUntyped;
+
+    // pointer
+    Procedure TestPointer;
+    Procedure TestPointer_Proc;
+    Procedure TestPointer_AssignRecordFail;
+    Procedure TestPointer_AssignStaticArrayFail;
+    Procedure TestPointer_ArrayParamsFail;
+    Procedure TestPointer_TypeCastJSValueToPointer;
+
+    // jsvalue
+    Procedure TestJSValue_AssignToJSValue;
+    Procedure TestJSValue_TypeCastToBaseType;
+    Procedure TestJSValue_Equal;
+    Procedure TestJSValue_If;
+    Procedure TestJSValue_Enum;
+    Procedure TestJSValue_ClassInstance;
+    Procedure TestJSValue_ClassOf;
+    Procedure TestJSValue_ArrayOfJSValue;
+    Procedure TestJSValue_Params;
+    Procedure TestJSValue_UntypedParam;
+    Procedure TestJSValue_FuncResultType;
+    Procedure TestJSValue_ProcType_Assign;
+    Procedure TestJSValue_ProcType_Equal;
+    Procedure TestJSValue_AssignToPointerFail;
+    Procedure TestJSValue_OverloadDouble;
+    Procedure TestJSValue_OverloadNativeInt;
+    Procedure TestJSValue_OverloadWord;
+    Procedure TestJSValue_OverloadString;
+    Procedure TestJSValue_OverloadChar;
+    Procedure TestJSValue_OverloadPointer;
+
+    // RTTI
+    Procedure TestRTTI_ProcType;
+    Procedure TestRTTI_ProcType_ArgFromOtherUnit;
+    Procedure TestRTTI_EnumAndSetType;
+    Procedure TestRTTI_AnonymousEnumType;
+    Procedure TestRTTI_StaticArray;
+    Procedure TestRTTI_DynArray;
+    Procedure TestRTTI_ArrayNestedAnonymous;
+    // ToDo: Procedure TestRTTI_Pointer;
+    Procedure TestRTTI_PublishedMethodOverloadFail;
+    Procedure TestRTTI_PublishedMethodExternalFail;
+    Procedure TestRTTI_PublishedClassPropertyFail;
+    Procedure TestRTTI_PublishedClassFieldFail;
+    Procedure TestRTTI_PublishedFieldExternalFail;
+    Procedure TestRTTI_Class_Field;
+    Procedure TestRTTI_Class_Method;
+    Procedure TestRTTI_Class_MethodArgFlags;
+    Procedure TestRTTI_Class_Property;
+    Procedure TestRTTI_Class_PropertyParams;
+    // ToDo: property default value
+    Procedure TestRTTI_OverrideMethod;
+    Procedure TestRTTI_OverloadProperty;
+    // ToDo: array argument
+    Procedure TestRTTI_ClassForward;
+    Procedure TestRTTI_ClassOf;
+    Procedure TestRTTI_Record;
+    Procedure TestRTTI_LocalTypes;
+    Procedure TestRTTI_TypeInfo_BaseTypes;
+    Procedure TestRTTI_TypeInfo_LocalFail;
+    Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses1;
+    Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses2;
+    Procedure TestRTTI_TypeInfo_ExtTypeInfoClasses3;
+    Procedure TestRTTI_TypeInfo_FunctionClassType;
+  end;
+
+function LinesToStr(Args: array of const): string;
+function ExtractFileUnitName(aFilename: string): string;
+function JSToStr(El: TJSElement): string;
+
+implementation
+
+function LinesToStr(Args: array of const): string;
+var
+  s: String;
+  i: Integer;
+begin
+  s:='';
+  for i:=Low(Args) to High(Args) do
+    case Args[i].VType of
+      vtChar:         s += Args[i].VChar+LineEnding;
+      vtString:       s += Args[i].VString^+LineEnding;
+      vtPChar:        s += Args[i].VPChar+LineEnding;
+      vtWideChar:     s += AnsiString(Args[i].VWideChar)+LineEnding;
+      vtPWideChar:    s += AnsiString(Args[i].VPWideChar)+LineEnding;
+      vtAnsiString:   s += AnsiString(Args[i].VAnsiString)+LineEnding;
+      vtWidestring:   s += AnsiString(WideString(Args[i].VWideString))+LineEnding;
+      vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding;
+    end;
+  Result:=s;
+end;
+
+function ExtractFileUnitName(aFilename: string): string;
+var
+  p: Integer;
+begin
+  Result:=ExtractFileName(aFilename);
+  if Result='' then exit;
+  for p:=length(Result) downto 1 do
+    case Result[p] of
+    '/','\': exit;
+    '.':
+      begin
+      Delete(Result,p,length(Result));
+      exit;
+      end;
+    end;
+end;
+
+function JSToStr(El: TJSElement): string;
+var
+  aWriter: TBufferWriter;
+  aJSWriter: TJSWriter;
+begin
+  aWriter:=TBufferWriter.Create(1000);
+  try
+    aJSWriter:=TJSWriter.Create(aWriter);
+    aJSWriter.IndentSize:=2;
+    aJSWriter.WriteJS(El);
+    Result:=aWriter.AsAnsistring;
+  finally
+    aWriter.Free;
+  end;
+end;
+
+{ TTestEnginePasResolver }
+
+procedure TTestEnginePasResolver.SetModule(AValue: TPasModule);
+begin
+  if FModule=AValue then Exit;
+  if Module<>nil then
+    Module.Release;
+  FModule:=AValue;
+  if Module<>nil then
+    Module.AddRef;
+end;
+
+destructor TTestEnginePasResolver.Destroy;
+begin
+  FreeAndNil(FResolver);
+  Module:=nil;
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  FreeAndNil(FResolver);
+  inherited Destroy;
+end;
+
+function TTestEnginePasResolver.FindModule(const AName: String): TPasModule;
+begin
+  Result:=nil;
+  if Assigned(OnFindUnit) then
+    Result:=OnFindUnit(AName);
+end;
+
+{ TCustomTestModule }
+
+function TCustomTestModule.GetModuleCount: integer;
+begin
+  Result:=FModules.Count;
+end;
+
+function TCustomTestModule.GetModules(Index: integer
+  ): TTestEnginePasResolver;
+begin
+  Result:=TTestEnginePasResolver(FModules[Index]);
+end;
+
+function TCustomTestModule.OnPasResolverFindUnit(const aUnitName: String
+  ): TPasModule;
+var
+  DefNamespace: String;
+begin
+  //writeln('TTestModule.OnPasResolverFindUnit START Unit="',aUnitName,'"');
+  if (Pos('.',aUnitName)<1) then
+    begin
+    DefNamespace:=GetDefaultNamespace;
+    if DefNamespace<>'' then
+      begin
+      Result:=FindUnit(DefNamespace+'.'+aUnitName);
+      if Result<>nil then exit;
+      end;
+    end;
+  Result:=FindUnit(aUnitName);
+  if Result<>nil then exit;
+  writeln('TTestModule.OnPasResolverFindUnit missing unit "',aUnitName,'"');
+  Fail('can''t find unit "'+aUnitName+'"');
+end;
+
+function TCustomTestModule.FindUnit(const aUnitName: String): TPasModule;
+var
+  i: Integer;
+  CurEngine: TTestEnginePasResolver;
+  CurUnitName: String;
+begin
+  //writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
+  Result:=nil;
+  for i:=0 to ModuleCount-1 do
+    begin
+    CurEngine:=Modules[i];
+    CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
+    //writeln('TTestModule.FindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
+    if CompareText(aUnitName,CurUnitName)=0 then
+      begin
+      Result:=CurEngine.Module;
+      if Result<>nil then exit;
+      //writeln('TTestModule.FindUnit PARSING unit "',CurEngine.Filename,'"');
+      FileResolver.FindSourceFile(aUnitName);
+
+      CurEngine.Resolver:=TStreamResolver.Create;
+      CurEngine.Resolver.OwnsStreams:=True;
+      //writeln('TTestModule.FindUnit SOURCE=',CurEngine.Source);
+      CurEngine.Resolver.AddStream(CurEngine.FileName,TStringStream.Create(CurEngine.Source));
+      CurEngine.Scanner:=TPascalScanner.Create(CurEngine.Resolver);
+      CurEngine.Parser:=TTestPasParser.Create(CurEngine.Scanner,CurEngine.Resolver,CurEngine);
+      CurEngine.Parser.Options:=CurEngine.Parser.Options+po_pas2js+[po_KeepScannerError];
+      if CompareText(CurUnitName,'System')=0 then
+        CurEngine.Parser.ImplicitUses.Clear;
+      CurEngine.Scanner.OpenFile(CurEngine.Filename);
+      try
+        CurEngine.Parser.NextToken;
+        CurEngine.Parser.ParseUnit(CurEngine.FModule);
+      except
+        on E: Exception do
+          HandleException(E);
+      end;
+      //writeln('TTestModule.FindUnit END ',CurUnitName);
+      Result:=CurEngine.Module;
+      exit;
+      end;
+    end;
+end;
+
+procedure TCustomTestModule.SetUp;
+begin
+  inherited SetUp;
+  FSkipTests:=false;
+  FSource:=TStringList.Create;
+  FModules:=TObjectList.Create(true);
+
+  FFilename:='test1.pp';
+  FFileResolver:=TStreamResolver.Create;
+  FFileResolver.OwnsStreams:=True;
+  FScanner:=TPascalScanner.Create(FFileResolver);
+  FScanner.AllowedModeSwitches:=msAllPas2jsModeSwitches;
+  FScanner.ReadOnlyModeSwitches:=msAllPas2jsModeSwitchesReadOnly;
+  FScanner.CurrentModeSwitches:=OBJFPCModeSwitches*msAllPas2jsModeSwitches+msAllPas2jsModeSwitchesReadOnly;
+  FEngine:=AddModule(Filename);
+  FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
+  Parser.Options:=Parser.Options+po_pas2js+[po_KeepScannerError];
+  FModule:=Nil;
+  FConverter:=TPasToJSConverter.Create;
+  FConverter.Options:=co_tcmodules;
+
+  FExpectedErrorClass:=nil;
+end;
+
+procedure TCustomTestModule.TearDown;
+begin
+  FSkipTests:=false;
+  FJSModule:=nil;
+  FJSRegModuleCall:=nil;
+  FJSModuleCallArgs:=nil;
+  FJSImplentationUses:=nil;
+  FJSInterfaceUses:=nil;
+  FJSModuleSrc:=nil;
+  FJSInitBody:=nil;
+  FreeAndNil(FJSSource);
+  FreeAndNil(FJSModule);
+  FreeAndNil(FConverter);
+  Engine.Clear;
+  if Assigned(FModule) then
+    begin
+    FModule.Release;
+    FModule:=nil;
+    end;
+  FreeAndNil(FSource);
+  FreeAndNil(FParser);
+  FreeAndNil(FScanner);
+  FreeAndNil(FFileResolver);
+  if FModules<>nil then
+    begin
+    FreeAndNil(FModules);
+    FEngine:=nil;
+    end;
+
+  inherited TearDown;
+end;
+
+procedure TCustomTestModule.Add(Line: string);
+begin
+  Source.Add(Line);
+end;
+
+procedure TCustomTestModule.Add(const Lines: array of string);
+var
+  i: Integer;
+begin
+  for i:=low(Lines) to high(Lines) do
+    Add(Lines[i]);
+end;
+
+procedure TCustomTestModule.StartParsing;
+var
+  Src: String;
+begin
+  Src:=Source.Text;
+  FEngine.Source:=Src;
+  FileResolver.AddStream(FileName,TStringStream.Create(Src));
+  Scanner.OpenFile(FileName);
+  Writeln('// Test : ',Self.TestName);
+  Writeln(Src);
+end;
+
+procedure TCustomTestModule.ParseModule;
+begin
+  if SkipTests then exit;
+  FFirstPasStatement:=nil;
+  try
+    StartParsing;
+    Parser.ParseMain(FModule);
+  except
+    on E: Exception do
+      HandleException(E);
+  end;
+  if SkipTests then exit;
+
+  AssertNotNull('Module resulted in Module',FModule);
+  AssertEquals('modulename',lowercase(ChangeFileExt(FFileName,'')),lowercase(Module.Name));
+  TAssert.AssertSame('Has resolver',Engine,Parser.Engine);
+end;
+
+procedure TCustomTestModule.ParseProgram;
+begin
+  if SkipTests then exit;
+  ParseModule;
+  if SkipTests then exit;
+  AssertEquals('Has program',TPasProgram,Module.ClassType);
+  FPasProgram:=TPasProgram(Module);
+  AssertNotNull('Has program section',PasProgram.ProgramSection);
+  AssertNotNull('Has initialization section',PasProgram.InitializationSection);
+  if (PasProgram.InitializationSection.Elements.Count>0) then
+    if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then
+      FFirstPasStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]);
+end;
+
+procedure TCustomTestModule.ParseUnit;
+begin
+  if SkipTests then exit;
+  ParseModule;
+  if SkipTests then exit;
+  AssertEquals('Has unit (TPasModule)',TPasModule,Module.ClassType);
+  AssertNotNull('Has interface section',Module.InterfaceSection);
+  AssertNotNull('Has implementation section',Module.ImplementationSection);
+  if (Module.InitializationSection<>nil)
+      and (Module.InitializationSection.Elements.Count>0)
+      and (TObject(Module.InitializationSection.Elements[0]) is TPasImplBlock) then
+    FFirstPasStatement:=TPasImplBlock(Module.InitializationSection.Elements[0]);
+end;
+
+function TCustomTestModule.FindModuleWithFilename(aFilename: string
+  ): TTestEnginePasResolver;
+var
+  i: Integer;
+begin
+  for i:=0 to ModuleCount-1 do
+    if CompareText(Modules[i].Filename,aFilename)=0 then
+      exit(Modules[i]);
+  Result:=nil;
+end;
+
+function TCustomTestModule.AddModule(aFilename: string
+  ): TTestEnginePasResolver;
+begin
+  //writeln('TTestModuleConverter.AddModule ',aFilename);
+  if FindModuleWithFilename(aFilename)<>nil then
+    Fail('TTestModuleConverter.AddModule: file "'+aFilename+'" already exists');
+  Result:=TTestEnginePasResolver.Create;
+  Result.Filename:=aFilename;
+  Result.AddObjFPCBuiltInIdentifiers(btAllJSBaseTypes,bfAllJSBaseProcs);
+  Result.OnFindUnit:=@OnPasResolverFindUnit;
+  FModules.Add(Result);
+end;
+
+function TCustomTestModule.AddModuleWithSrc(aFilename, Src: string
+  ): TTestEnginePasResolver;
+begin
+  Result:=AddModule(aFilename);
+  Result.Source:=Src;
+end;
+
+function TCustomTestModule.AddModuleWithIntfImplSrc(aFilename, InterfaceSrc,
+  ImplementationSrc: string): TTestEnginePasResolver;
+var
+  Src: String;
+begin
+  Src:='unit '+ExtractFileUnitName(aFilename)+';'+LineEnding;
+  Src+=LineEnding;
+  Src+='interface'+LineEnding;
+  Src+=LineEnding;
+  Src+=InterfaceSrc;
+  Src+='implementation'+LineEnding;
+  Src+=LineEnding;
+  Src+=ImplementationSrc;
+  Src+='end.'+LineEnding;
+  Result:=AddModuleWithSrc(aFilename,Src);
+end;
+
+procedure TCustomTestModule.AddSystemUnit;
+begin
+  AddModuleWithIntfImplSrc('system.pp',
+    // interface
+    LinesToStr([
+    'type',
+    '  integer=longint;',
+    'var',
+    '  ExitCode: Longint;',
+    ''
+    // implementation
+    ]),LinesToStr([
+    ''
+    ]));
+end;
+
+procedure TCustomTestModule.StartProgram(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('program '+ExtractFileUnitName(Filename)+';');
+  Add('');
+end;
+
+procedure TCustomTestModule.StartUnit(NeedSystemUnit: boolean);
+begin
+  if NeedSystemUnit then
+    AddSystemUnit
+  else
+    Parser.ImplicitUses.Clear;
+  Add('unit Test1;');
+  Add('');
+end;
+
+procedure TCustomTestModule.ConvertModule;
+
+  procedure CheckUsesList(UsesName: String; Arg: TJSArrayLiteralElement;
+    out UsesLit: TJSArrayLiteral);
+  var
+    i: Integer;
+    Item: TJSElement;
+    Lit: TJSLiteral;
+  begin
+    UsesLit:=nil;
+    AssertNotNull(UsesName+' uses section',Arg.Expr);
+    if (Arg.Expr.ClassType=TJSLiteral) and TJSLiteral(Arg.Expr).Value.IsNull then
+      exit; // null is ok
+    AssertEquals(UsesName+' uses section param is array',TJSArrayLiteral,Arg.Expr.ClassType);
+    FJSInterfaceUses:=TJSArrayLiteral(Arg.Expr);
+    for i:=0 to FJSInterfaceUses.Elements.Count-1 do
+      begin
+      Item:=FJSInterfaceUses.Elements.Elements[i].Expr;
+      AssertNotNull(UsesName+' uses section item['+IntToStr(i)+'].Expr',Item);
+      AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is lit',TJSLiteral,Item.ClassType);
+      Lit:=TJSLiteral(Item);
+      AssertEquals(UsesName+' uses section item['+IntToStr(i)+'] is string lit',
+        ord(jsbase.jstString),ord(Lit.Value.ValueType));
+      end;
+  end;
+
+  procedure CheckFunctionParam(ParamName: string; Arg: TJSArrayLiteralElement;
+    out Src: TJSSourceElements);
+  var
+    FunDecl: TJSFunctionDeclarationStatement;
+    FunDef: TJSFuncDef;
+    FunBody: TJSFunctionBody;
+  begin
+    Src:=nil;
+    AssertNotNull(ParamName,Arg.Expr);
+    AssertEquals(ParamName+' Arg.Expr type',TJSFunctionDeclarationStatement,Arg.Expr.ClassType);
+    FunDecl:=Arg.Expr as TJSFunctionDeclarationStatement;
+    AssertNotNull(ParamName+' FunDecl.AFunction',FunDecl.AFunction);
+    AssertEquals(ParamName+' FunDecl.AFunction type',TJSFuncDef,FunDecl.AFunction.ClassType);
+    FunDef:=FunDecl.AFunction as TJSFuncDef;
+    AssertEquals(ParamName+' name empty','',String(FunDef.Name));
+    AssertNotNull(ParamName+' body',FunDef.Body);
+    AssertEquals(ParamName+' body type',TJSFunctionBody,FunDef.Body.ClassType);
+    FunBody:=FunDef.Body as TJSFunctionBody;
+    AssertNotNull(ParamName+' body.A',FunBody.A);
+    AssertEquals(ParamName+' body.A type',TJSSourceElements,FunBody.A.ClassType);
+    Src:=FunBody.A as TJSSourceElements;
+  end;
+
+var
+  ModuleNameExpr: TJSLiteral;
+  InitFunction: TJSFunctionDeclarationStatement;
+  InitAssign: TJSSimpleAssignStatement;
+  InitName: String;
+  LastNode: TJSElement;
+  Arg: TJSArrayLiteralElement;
+begin
+  if SkipTests then exit;
+  try
+    FJSModule:=FConverter.ConvertPasElement(Module,Engine) as TJSSourceElements;
+  except
+    on E: Exception do
+      HandleException(E);
+  end;
+  if SkipTests then exit;
+  if ExpectedErrorClass<>nil then
+    Fail('Missing '+ExpectedErrorClass.ClassName+' error {'+ExpectedErrorMsg+'} ('+IntToStr(ExpectedErrorNumber)+')');
+
+  FJSSource:=TStringList.Create;
+  FJSSource.Text:=JSToStr(JSModule);
+  {$IFDEF VerbosePas2JS}
+  writeln('TTestModule.ConvertModule JS:');
+  write(FJSSource.Text);
+  {$ENDIF}
+
+  // rtl.module(...
+  AssertEquals('jsmodule has one statement - the call',1,JSModule.Statements.Count);
+  AssertNotNull('register module call',JSModule.Statements.Nodes[0].Node);
+  AssertEquals('register module call',TJSCallExpression,JSModule.Statements.Nodes[0].Node.ClassType);
+  FJSRegModuleCall:=JSModule.Statements.Nodes[0].Node as TJSCallExpression;
+  AssertNotNull('register module rtl.module expr',JSRegModuleCall.Expr);
+  AssertNotNull('register module rtl.module args',JSRegModuleCall.Args);
+  AssertEquals('rtl.module args',TJSArguments,JSRegModuleCall.Args.ClassType);
+  FJSModuleCallArgs:=JSRegModuleCall.Args as TJSArguments;
+
+  // parameter 'unitname'
+  if JSModuleCallArgs.Elements.Count<1 then
+    Fail('rtl.module first param unit missing');
+  Arg:=JSModuleCallArgs.Elements.Elements[0];
+  AssertNotNull('module name param',Arg.Expr);
+  ModuleNameExpr:=Arg.Expr as TJSLiteral;
+  AssertEquals('module name param is string',ord(jstString),ord(ModuleNameExpr.Value.ValueType));
+  if Module is TPasProgram then
+    AssertEquals('module name','program',String(ModuleNameExpr.Value.AsString))
+  else
+    AssertEquals('module name',Module.Name,String(ModuleNameExpr.Value.AsString));
+
+  // main uses section
+  if JSModuleCallArgs.Elements.Count<2 then
+    Fail('rtl.module second param main uses missing');
+  Arg:=JSModuleCallArgs.Elements.Elements[1];
+  CheckUsesList('interface',Arg,FJSInterfaceUses);
+
+  // program/library/interface function()
+  if JSModuleCallArgs.Elements.Count<3 then
+    Fail('rtl.module third param intf-function missing');
+  Arg:=JSModuleCallArgs.Elements.Elements[2];
+  CheckFunctionParam('module intf-function',Arg,FJSModuleSrc);
+
+  // search for $mod.$init or $mod.$main - the last statement
+  if Module is TPasProgram then
+    begin
+    InitName:='$main';
+    AssertEquals('$mod.'+InitName+' function 1',true,JSModuleSrc.Statements.Count>0);
+    end
+  else
+    InitName:='$init';
+  FJSInitBody:=nil;
+  if JSModuleSrc.Statements.Count>0 then
+    begin
+    LastNode:=JSModuleSrc.Statements.Nodes[JSModuleSrc.Statements.Count-1].Node;
+    if LastNode is TJSSimpleAssignStatement then
+      begin
+      InitAssign:=LastNode as TJSSimpleAssignStatement;
+      if GetDottedIdentifier(InitAssign.LHS)='$mod.'+InitName then
+        begin
+        InitFunction:=InitAssign.Expr as TJSFunctionDeclarationStatement;
+        FJSInitBody:=InitFunction.AFunction.Body as TJSFunctionBody;
+        end
+      else if Module is TPasProgram then
+        CheckDottedIdentifier('init function',InitAssign.LHS,'$mod.'+InitName);
+      end;
+    end;
+
+  // optional: implementation uses section
+  if JSModuleCallArgs.Elements.Count<4 then
+    exit;
+  Arg:=JSModuleCallArgs.Elements.Elements[3];
+  CheckUsesList('implementation',Arg,FJSImplentationUses);
+
+  // optional: implementation function()
+  if JSModuleCallArgs.Elements.Count<5 then
+    exit;
+  Arg:=JSModuleCallArgs.Elements.Elements[4];
+  CheckFunctionParam('module impl-function',Arg,FJSImplementationSrc);
+end;
+
+procedure TCustomTestModule.ConvertProgram;
+begin
+  Add('end.');
+  ParseProgram;
+  ConvertModule;
+end;
+
+procedure TCustomTestModule.ConvertUnit;
+begin
+  Add('end.');
+  ParseUnit;
+  ConvertModule;
+end;
+
+procedure TCustomTestModule.CheckDottedIdentifier(Msg: string; El: TJSElement;
+  DottedName: string);
+begin
+  if DottedName='' then
+    begin
+    AssertNull(Msg,El);
+    end
+  else
+    begin
+    AssertNotNull(Msg,El);
+    AssertEquals(Msg,DottedName,GetDottedIdentifier(El));
+    end;
+end;
+
+function TCustomTestModule.GetDottedIdentifier(El: TJSElement): string;
+begin
+  if El=nil then
+    Result:=''
+  else if El is TJSPrimaryExpressionIdent then
+    Result:=String(TJSPrimaryExpressionIdent(El).Name)
+  else if El is TJSDotMemberExpression then
+    Result:=GetDottedIdentifier(TJSDotMemberExpression(El).MExpr)+'.'+String(TJSDotMemberExpression(El).Name)
+  else
+    AssertEquals('GetDottedIdentifier',TJSPrimaryExpressionIdent,El.ClassType);
+end;
+
+procedure TCustomTestModule.CheckSource(Msg, Statements: String;
+  InitStatements: string; ImplStatements: string);
+var
+  ActualSrc, ExpectedSrc, InitName: String;
+begin
+  ActualSrc:=JSToStr(JSModuleSrc);
+  ExpectedSrc:=
+    'var $mod = this;'+LineEnding
+   +Statements;
+  if coUseStrict in Converter.Options then
+    ExpectedSrc:='"use strict";'+LineEnding+ExpectedSrc;
+  if Module is TPasProgram then
+    InitName:='$main'
+  else
+    InitName:='$init';
+  if (Module is TPasProgram) or (Trim(InitStatements)<>'') then
+    ExpectedSrc:=ExpectedSrc+LineEnding
+      +'$mod.'+InitName+' = function () {'+LineEnding
+      +InitStatements
+      +'};'+LineEnding;
+  //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
+  CheckDiff(Msg,ExpectedSrc,ActualSrc);
+
+  if (JSImplementationSrc<>nil) then
+    begin
+    ActualSrc:=JSToStr(JSImplementationSrc);
+    ExpectedSrc:=
+      'var $mod = this;'+LineEnding
+     +'var $impl = $mod.$impl;'+LineEnding
+     +ImplStatements;
+    end
+  else
+    begin
+    ActualSrc:='';
+    ExpectedSrc:=ImplStatements;
+    end;
+  //writeln('TTestModule.CheckSource InitStatements="',InitStatements,'"');
+  CheckDiff(Msg,ExpectedSrc,ActualSrc);
+end;
+
+procedure TCustomTestModule.CheckDiff(Msg, Expected, Actual: string);
+// search diff, ignore changes in spaces
+const
+  SpaceChars = [#9,#10,#13,' '];
+var
+  ExpectedP, ActualP: PChar;
+
+  function FindLineEnd(p: PChar): PChar;
+  begin
+    Result:=p;
+    while not (Result^ in [#0,#10,#13]) do inc(Result);
+  end;
+
+  function FindLineStart(p, MinP: PChar): PChar;
+  begin
+    while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
+    Result:=p;
+  end;
+
+  procedure DiffFound;
+  var
+    ActLineStartP, ActLineEndP, p, StartPos: PChar;
+    ExpLine, ActLine: String;
+    i: Integer;
+  begin
+    writeln('Diff found "',Msg,'". Lines:');
+    // write correct lines
+    p:=PChar(Expected);
+    repeat
+      StartPos:=p;
+      while not (p^ in [#0,#10,#13]) do inc(p);
+      ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
+      if p^ in [#10,#13] then begin
+        if (p[1] in [#10,#13]) and (p^<>p[1]) then
+          inc(p,2)
+        else
+          inc(p);
+      end;
+      if p<=ExpectedP then begin
+        writeln('= ',ExpLine);
+      end else begin
+        // diff line
+        // write actual line
+        ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
+        ActLineEndP:=FindLineEnd(ActualP);
+        ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
+        writeln('- ',ActLine);
+        // write expected line
+        writeln('+ ',ExpLine);
+        // write empty line with pointer ^
+        for i:=1 to 2+ExpectedP-StartPos do write(' ');
+        writeln('^');
+        AssertEquals(Msg,ExpLine,ActLine);
+        break;
+      end;
+    until p^=#0;
+    Fail('diff found, but lines are the same, internal error');
+  end;
+
+var
+  IsSpaceNeeded: Boolean;
+  LastChar: Char;
+begin
+  if Expected='' then Expected:=' ';
+  if Actual='' then Actual:=' ';
+  ExpectedP:=PChar(Expected);
+  ActualP:=PChar(Actual);
+  repeat
+    //writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
+    case ExpectedP^ of
+    #0:
+      begin
+      // check that rest of Actual has only spaces
+      while ActualP^ in SpaceChars do inc(ActualP);
+      if ActualP^<>#0 then
+        DiffFound;
+      exit;
+      end;
+    ' ',#9,#10,#13:
+      begin
+      // skip space in Expected
+      IsSpaceNeeded:=false;
+      if ExpectedP>PChar(Expected) then
+        LastChar:=ExpectedP[-1]
+      else
+        LastChar:=#0;
+      while ExpectedP^ in SpaceChars do inc(ExpectedP);
+      if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
+          and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
+        IsSpaceNeeded:=true;
+      if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
+        DiffFound;
+      while ActualP^ in SpaceChars do inc(ActualP);
+      end;
+    else
+      while ActualP^ in SpaceChars do inc(ActualP);
+      if ExpectedP^<>ActualP^ then
+        DiffFound;
+      inc(ExpectedP);
+      inc(ActualP);
+    end;
+  until false;
+end;
+
+procedure TCustomTestModule.SetExpectedScannerError(Msg: string;
+  MsgNumber: integer);
+begin
+  ExpectedErrorClass:=EScannerError;
+  ExpectedErrorMsg:=Msg;
+  ExpectedErrorNumber:=MsgNumber;
+end;
+
+procedure TCustomTestModule.SetExpectedParserError(Msg: string;
+  MsgNumber: integer);
+begin
+  ExpectedErrorClass:=EParserError;
+  ExpectedErrorMsg:=Msg;
+  ExpectedErrorNumber:=MsgNumber;
+end;
+
+procedure TCustomTestModule.SetExpectedPasResolverError(Msg: string;
+  MsgNumber: integer);
+begin
+  ExpectedErrorClass:=EPasResolve;
+  ExpectedErrorMsg:=Msg;
+  ExpectedErrorNumber:=MsgNumber;
+end;
+
+procedure TCustomTestModule.SetExpectedConverterError(Msg: string;
+  MsgNumber: integer);
+begin
+  ExpectedErrorClass:=EPas2JS;
+  ExpectedErrorMsg:=Msg;
+  ExpectedErrorNumber:=MsgNumber;
+end;
+
+function TCustomTestModule.IsErrorExpected(E: Exception): boolean;
+var
+  MsgNumber: Integer;
+begin
+  Result:=false;
+  if (ExpectedErrorClass=nil) or (ExpectedErrorClass<>E.ClassType) then exit;
+  if E is EPas2JS then
+    MsgNumber:=EPas2JS(E).MsgNumber
+  else if E is EPasResolve then
+    MsgNumber:=EPasResolve(E).MsgNumber
+  else if E is EParserError then
+    MsgNumber:=Parser.LastMsgNumber
+  else if E is EScannerError then
+    MsgNumber:=Scanner.LastMsgNumber
+  else
+    MsgNumber:=0;
+  Result:=(MsgNumber=ExpectedErrorNumber) and (E.Message=ExpectedErrorMsg);
+  if Result then
+    SkipTests:=true;
+end;
+
+procedure TCustomTestModule.HandleScannerError(E: EScannerError);
+begin
+  if IsErrorExpected(E) then exit;
+  WriteSources(Scanner.CurFilename,Scanner.CurRow,Scanner.CurColumn);
+  writeln('ERROR: TCustomTestModule.HandleScannerError '+E.ClassName+':'+E.Message
+    +' '+Scanner.CurFilename
+    +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')');
+  RaiseException(E);
+end;
+
+procedure TCustomTestModule.HandleParserError(E: EParserError);
+begin
+  if IsErrorExpected(E) then exit;
+  WriteSources(E.Filename,E.Row,E.Column);
+  writeln('ERROR: TCustomTestModule.HandleParserError '+E.ClassName+':'+E.Message
+    +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
+    +' MainModuleScannerLine="'+Scanner.CurLine+'"'
+    );
+  RaiseException(E);
+end;
+
+procedure TCustomTestModule.HandlePasResolveError(E: EPasResolve);
+var
+  P: TPasSourcePos;
+begin
+  if IsErrorExpected(E) then exit;
+  P:=E.SourcePos;
+  WriteSources(P.FileName,P.Row,P.Column);
+  writeln('ERROR: TCustomTestModule.HandlePasResolveError '+E.ClassName+':'+E.Message
+    +' '+P.FileName+'('+IntToStr(P.Row)+','+IntToStr(P.Column)+')');
+  RaiseException(E);
+end;
+
+procedure TCustomTestModule.HandlePas2JSError(E: EPas2JS);
+var
+  Row, Col: integer;
+begin
+  if IsErrorExpected(E) then exit;
+  Engine.UnmangleSourceLineNumber(E.PasElement.SourceLinenumber,Row,Col);
+  WriteSources(E.PasElement.SourceFilename,Row,Col);
+  writeln('ERROR: TCustomTestModule.HandlePas2JSError '+E.ClassName+':'+E.Message
+    +' '+E.PasElement.SourceFilename
+    +'('+IntToStr(Row)+','+IntToStr(Col)+')');
+  RaiseException(E);
+end;
+
+procedure TCustomTestModule.HandleException(E: Exception);
+begin
+  if E is EScannerError then
+    HandleScannerError(EScannerError(E))
+  else if E is EParserError then
+    HandleParserError(EParserError(E))
+  else if E is EPasResolve then
+    HandlePasResolveError(EPasResolve(E))
+  else if E is EPas2JS then
+    HandlePas2JSError(EPas2JS(E))
+  else
+    begin
+    if IsErrorExpected(E) then exit;
+    if not (E is EAssertionFailedError) then
+      begin
+      WriteSources('',0,0);
+      writeln('ERROR: TCustomTestModule.HandleException '+E.ClassName+':'+E.Message);
+      end;
+    RaiseException(E);
+    end;
+end;
+
+procedure TCustomTestModule.RaiseException(E: Exception);
+var
+  MsgNumber: Integer;
+begin
+  if ExpectedErrorClass<>nil then begin
+    if FExpectedErrorClass=E.ClassType then begin
+      if E is EPas2JS then
+        MsgNumber:=EPas2JS(E).MsgNumber
+      else if E is EPasResolve then
+        MsgNumber:=EPasResolve(E).MsgNumber
+      else if E is EParserError then
+        MsgNumber:=Parser.LastMsgNumber
+      else if E is EScannerError then
+        MsgNumber:=Scanner.LastMsgNumber
+      else
+        MsgNumber:=0;
+      AssertEquals('Expected error message ('+IntToStr(ExpectedErrorNumber)+')','{'+ExpectedErrorMsg+'}','{'+E.Message+'}');
+      AssertEquals('Expected {'+ExpectedErrorMsg+'}, but got msg {'+E.Message+'} number',
+        ExpectedErrorNumber,MsgNumber);
+    end else begin
+      AssertEquals('Wrong exception class',ExpectedErrorClass.ClassName,E.ClassName);
+    end;
+  end;
+  Fail(E.Message);
+end;
+
+procedure TCustomTestModule.WriteSources(const aFilename: string; aRow,
+  aCol: integer);
+var
+  IsSrc: Boolean;
+  i, j: Integer;
+  SrcLines: TStringList;
+  Line: string;
+  aModule: TTestEnginePasResolver;
+begin
+  writeln('TCustomTestModule.WriteSources File="',aFilename,'" Row=',aRow,' Col=',aCol);
+  for i:=0 to ModuleCount-1 do
+    begin
+    aModule:=Modules[i];
+    SrcLines:=TStringList.Create;
+    try
+      SrcLines.Text:=aModule.Source;
+      IsSrc:=ExtractFilename(aModule.Filename)=ExtractFileName(aFilename);
+      writeln('Testcode:-File="',aModule.Filename,'"----------------------------------:');
+      for j:=1 to SrcLines.Count do
+        begin
+        Line:=SrcLines[j-1];
+        if IsSrc and (j=aRow) then
+          begin
+          write('*');
+          Line:=LeftStr(Line,aCol-1)+'|'+copy(Line,aCol,length(Line));
+          end;
+        writeln(Format('%:4d: ',[j]),Line);
+        end;
+    finally
+      SrcLines.Free;
+    end;
+    end;
+end;
+
+function TCustomTestModule.GetDefaultNamespace: string;
+var
+  C: TClass;
+begin
+  Result:='';
+  if FModule=nil then exit;
+  C:=FModule.ClassType;
+  if (C=TPasProgram) or (C=TPasLibrary) or (C=TPasPackage) then
+    Result:=Engine.DefaultNameSpace;
+end;
+
+{ TTestModule }
+
+procedure TTestModule.TestEmptyProgram;
+begin
+  StartProgram(false);
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestEmptyProgram','','');
+end;
+
+procedure TTestModule.TestEmptyProgramUseStrict;
+begin
+  Converter.Options:=Converter.Options+[coUseStrict];
+  StartProgram(false);
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestEmptyProgramUseStrict','','');
+end;
+
+procedure TTestModule.TestEmptyUnit;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  ConvertUnit;
+  CheckSource('TestEmptyUnit',
+    LinesToStr([
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestEmptyUnitUseStrict;
+begin
+  Converter.Options:=Converter.Options+[coUseStrict];
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  ConvertUnit;
+  CheckSource('TestEmptyUnitUseStrict',
+    LinesToStr([
+    ''
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestDottedUnitNames;
+begin
+  AddModuleWithIntfImplSrc('NS1.Unit2.pas',
+    LinesToStr([
+    'var iV: longint;'
+    ]),
+    '');
+
+  FFilename:='ns1.test1.pp';
+  StartProgram(true);
+  Add('uses unIt2;');
+  Add('implementation');
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=iv;');
+  Add('  i:=uNit2.iv;');
+  Add('  i:=Ns1.TEst1.i;');
+  ConvertProgram;
+  CheckSource('TestDottedUnitNames',
+    LinesToStr([
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // this.$init
+    '$mod.i = pas["NS1.Unit2"].iV;',
+    '$mod.i = pas["NS1.Unit2"].iV;',
+    '$mod.i = $mod.i;',
+    '']) );
+end;
+
+procedure TTestModule.TestDottedUnitExpr;
+begin
+  AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
+    LinesToStr([
+    'procedure DoIt;'
+    ]),
+    'procedure DoIt; begin end;');
+
+  FFilename:='Ns1.SubNs1.Test1.pp';
+  StartProgram(true);
+  Add('uses Ns2.sUbnS2.unIt2;');
+  Add('implementation');
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  ns2.subns2.unit2.doit;');
+  Add('  i:=Ns1.SubNS1.TEst1.i;');
+  ConvertProgram;
+  CheckSource('TestDottedUnitExpr',
+    LinesToStr([
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // this.$init
+    'pas["NS2.SubNs2.Unit2"].DoIt();',
+    '$mod.i = $mod.i;',
+    '']) );
+end;
+
+procedure TTestModule.Test_ModeFPCFail;
+begin
+  StartProgram(false);
+  Add('{$mode FPC}');
+  Add('begin');
+  SetExpectedScannerError('Invalid mode: "FPC"',nErrInvalidMode);
+  ConvertProgram;
+end;
+
+procedure TTestModule.Test_ModeSwitchCBlocksFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch cblocks-}');
+  Add('begin');
+  SetExpectedScannerError('Invalid mode switch: "cblocks-"',nErrInvalidModeSwitch);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestVarInt;
+begin
+  StartProgram(false);
+  Add('var MyI: longint;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestVarInt','this.MyI=0;','');
+end;
+
+procedure TTestModule.TestVarBaseTypes;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('  i2: longint = 3;');
+  Add('  s2: string = ''foo'';');
+  Add('  c2: char = ''4'';');
+  Add('  b2: boolean = true;');
+  Add('  d2: double = 5.6;');
+  Add('  i3: longint = $707;');
+  Add('  i4: nativeint = 4503599627370495;');
+  Add('  i5: nativeint = -4503599627370496;');
+  Add('  i6: nativeint =   $fffffffffffff;');
+  Add('  i7: nativeint = -$10000000000000;');
+  Add('  u8: nativeuint =  $fffffffffffff;');
+  Add('  u9: nativeuint =  $0000000000000;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestVarBaseTypes',
+    LinesToStr([
+    'this.i=0;',
+    'this.s="";',
+    'this.c="";',
+    'this.b=false;',
+    'this.d=0.0;',
+    'this.i2=3;',
+    'this.s2="foo";',
+    'this.c2="4";',
+    'this.b2=true;',
+    'this.d2=5.6;',
+    'this.i3=0x707;',
+    'this.i4= 4503599627370495;',
+    'this.i5= -4503599627370496;',
+    'this.i6= 0xfffffffffffff;',
+    'this.i7=-0x10000000000000;',
+    'this.u8= 0xfffffffffffff;',
+    'this.u9= 0x0000000000000;'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestBaseTypeSingleFail;
+begin
+  StartProgram(false);
+  Add('var s: single;');
+  SetExpectedPasResolverError('identifier not found "single"',nIdentifierNotFound);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestBaseTypeExtendedFail;
+begin
+  StartProgram(false);
+  Add('var e: extended;');
+  SetExpectedPasResolverError('identifier not found "extended"',nIdentifierNotFound);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestConstBaseTypes;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  i: longint = 3;');
+  Add('  s: string = ''foo'';');
+  Add('  c: char = ''4'';');
+  Add('  b: boolean = true;');
+  Add('  d: double = 5.6;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestVarBaseTypes',
+    LinesToStr([
+    'this.i=3;',
+    'this.s="foo";',
+    'this.c="4";',
+    'this.b=true;',
+    'this.d=5.6;'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestAliasTypeRef;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  a=longint;');
+  Add('  b=a;');
+  Add('var');
+  Add('  c: A;');
+  Add('  d: B;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestAliasTypeRef',
+    LinesToStr([ // statements
+    'this.c = 0;',
+    'this.d = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestTypeCast_BaseTypes;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  i: longint;');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  i:=longint(i);');
+  Add('  i:=longint(b);');
+  Add('  b:=boolean(b);');
+  Add('  b:=boolean(i);');
+  Add('  d:=double(d);');
+  Add('  d:=double(i);');
+  Add('  s:=string(s);');
+  Add('  s:=string(c);');
+  Add('  c:=char(c);');
+  ConvertProgram;
+  CheckSource('TestAliasTypeRef',
+    LinesToStr([ // statements
+    'this.i = 0;',
+    'this.b = false;',
+    'this.d = 0.0;',
+    'this.s = "";',
+    'this.c = "";',
+    '']),
+    LinesToStr([ // this.$main
+    '$mod.i = $mod.i;',
+    '$mod.i = ($mod.b ? 1 : 0);',
+    '$mod.b = $mod.b;',
+    '$mod.b = $mod.i != 0;',
+    '$mod.d = $mod.d;',
+    '$mod.d = $mod.i;',
+    '$mod.s = $mod.s;',
+    '$mod.s = $mod.c;',
+    '$mod.c = $mod.c;',
+    '']));
+end;
+
+procedure TTestModule.TestTypeCast_AliasBaseTypes;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TYesNo = boolean;');
+  Add('  TFloat = double;');
+  Add('  TCaption = string;');
+  Add('  TChar = char;');
+  Add('var');
+  Add('  i: integer;');
+  Add('  b: TYesNo;');
+  Add('  d: TFloat;');
+  Add('  s: TCaption;');
+  Add('  c: TChar;');
+  Add('begin');
+  Add('  i:=integer(i);');
+  Add('  i:=integer(b);');
+  Add('  b:=TYesNo(b);');
+  Add('  b:=TYesNo(i);');
+  Add('  d:=TFloat(d);');
+  Add('  d:=TFloat(i);');
+  Add('  s:=TCaption(s);');
+  Add('  s:=TCaption(c);');
+  Add('  c:=TChar(c);');
+  ConvertProgram;
+  CheckSource('TestAliasTypeRef',
+    LinesToStr([ // statements
+    'this.i = 0;',
+    'this.b = false;',
+    'this.d = 0.0;',
+    'this.s = "";',
+    'this.c = "";',
+    '']),
+    LinesToStr([ // this.$main
+    '$mod.i = $mod.i;',
+    '$mod.i = ($mod.b ? 1 : 0);',
+    '$mod.b = $mod.b;',
+    '$mod.b = $mod.i != 0;',
+    '$mod.d = $mod.d;',
+    '$mod.d = $mod.i;',
+    '$mod.s = $mod.s;',
+    '$mod.s = $mod.c;',
+    '$mod.c = $mod.c;',
+    '']));
+end;
+
+procedure TTestModule.TestEmptyProc;
+begin
+  StartProgram(false);
+  Add('procedure Test;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestEmptyProc',
+    LinesToStr([ // statements
+    'this.Test = function () {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProcOneParam;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(i: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  PROCA(3);');
+  ConvertProgram;
+  CheckSource('TestProcOneParam',
+    LinesToStr([ // statements
+    'this.ProcA = function (i) {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.ProcA(3);'
+    ]));
+end;
+
+procedure TTestModule.TestFunctionWithoutParams;
+begin
+  StartProgram(false);
+  Add('function FuncA: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  I:=FUNCA();');
+  Add('  I:=FUNCA;');
+  Add('  FUNCA();');
+  Add('  FUNCA;');
+  ConvertProgram;
+  CheckSource('TestProcWithoutParams',
+    LinesToStr([ // statements
+    'this.FuncA = function () {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    'this.i=0;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.i=$mod.FuncA();',
+    '$mod.i=$mod.FuncA();',
+    '$mod.FuncA();',
+    '$mod.FuncA();'
+    ]));
+end;
+
+procedure TTestModule.TestProcedureWithoutParams;
+begin
+  StartProgram(false);
+  Add('procedure ProcA;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  PROCA();');
+  Add('  PROCA;');
+  ConvertProgram;
+  CheckSource('TestProcWithoutParams',
+    LinesToStr([ // statements
+    'this.ProcA = function () {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.ProcA();',
+    '$mod.ProcA();'
+    ]));
+end;
+
+procedure TTestModule.TestIncDec;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(var i: longint);',
+  'begin',
+  '  inc(i);',
+  '  inc(i,2);',
+  'end;',
+  'var',
+  '  Bar: longint;',
+  'begin',
+  '  inc(bar);',
+  '  inc(bar,2);',
+  '  dec(bar);',
+  '  dec(bar,3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestIncDec',
+    LinesToStr([ // statements
+    'this.DoIt = function (i) {',
+    '  i.set(i.get()+1);',
+    '  i.set(i.get()+2);',
+    '};',
+    'this.Bar = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.Bar+=1;',
+    '$mod.Bar+=2;',
+    '$mod.Bar-=1;',
+    '$mod.Bar-=3;'
+    ]));
+end;
+
+procedure TTestModule.TestAssignments;
+begin
+  StartProgram(false);
+  Parser.Options:=Parser.Options+[po_cassignments];
+  Add('var');
+  Add('  Bar:longint;');
+  Add('begin');
+  Add('  bar:=3;');
+  Add('  bar+=4;');
+  Add('  bar-=5;');
+  Add('  bar*=6;');
+  ConvertProgram;
+  CheckSource('TestAssignments',
+    LinesToStr([ // statements
+    'this.Bar = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.Bar=3;',
+    '$mod.Bar+=4;',
+    '$mod.Bar-=5;',
+    '$mod.Bar*=6;'
+    ]));
+end;
+
+procedure TTestModule.TestArithmeticOperators1;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vA,vB,vC:longint;');
+  Add('begin');
+  Add('  va:=1;');
+  Add('  vb:=va+va;');
+  Add('  vb:=va div vb;');
+  Add('  vb:=va mod vb;');
+  Add('  vb:=va+va*vb+va div vb;');
+  Add('  vc:=-va;');
+  Add('  va:=va-vb;');
+  Add('  vb:=va;');
+  Add('  if va<vb then vc:=va else vc:=vb;');
+  ConvertProgram;
+  CheckSource('TestArithmeticOperators1',
+    LinesToStr([ // statements
+    'this.vA = 0;',
+    'this.vB = 0;',
+    'this.vC = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.vA = 1;',
+    '$mod.vB = $mod.vA + $mod.vA;',
+    '$mod.vB = Math.floor($mod.vA / $mod.vB);',
+    '$mod.vB = $mod.vA % $mod.vB;',
+    '$mod.vB = ($mod.vA + ($mod.vA * $mod.vB)) + Math.floor($mod.vA / $mod.vB);',
+    '$mod.vC = -$mod.vA;',
+    '$mod.vA = $mod.vA - $mod.vB;',
+    '$mod.vB = $mod.vA;',
+    'if ($mod.vA < $mod.vB){ $mod.vC = $mod.vA } else $mod.vC = $mod.vB;'
+    ]));
+end;
+
+procedure TTestModule.TestLogicalOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vA,vB,vC:boolean;');
+  Add('begin');
+  Add('  va:=vb and vc;');
+  Add('  va:=vb or vc;');
+  Add('  va:=true and vc;');
+  Add('  va:=(vb and vc) or (va and vb);');
+  Add('  va:=not vb;');
+  ConvertProgram;
+  CheckSource('TestLogicalOperators',
+    LinesToStr([ // statements
+    'this.vA = false;',
+    'this.vB = false;',
+    'this.vC = false;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.vA = $mod.vB && $mod.vC;',
+    '$mod.vA = $mod.vB || $mod.vC;',
+    '$mod.vA = true && $mod.vC;',
+    '$mod.vA = ($mod.vB && $mod.vC) || ($mod.vA && $mod.vB);',
+    '$mod.vA = !$mod.vB;'
+    ]));
+end;
+
+procedure TTestModule.TestBitwiseOperators;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vA,vB,vC:longint;');
+  Add('begin');
+  Add('  va:=vb and vc;');
+  Add('  va:=vb or vc;');
+  Add('  va:=vb xor vc;');
+  Add('  va:=vb shl vc;');
+  Add('  va:=vb shr vc;');
+  Add('  va:=3 and vc;');
+  Add('  va:=(vb and vc) or (va and vb);');
+  Add('  va:=not vb;');
+  ConvertProgram;
+  CheckSource('TestBitwiseOperators',
+    LinesToStr([ // statements
+    'this.vA = 0;',
+    'this.vB = 0;',
+    'this.vC = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.vA = $mod.vB & $mod.vC;',
+    '$mod.vA = $mod.vB | $mod.vC;',
+    '$mod.vA = $mod.vB ^ $mod.vC;',
+    '$mod.vA = $mod.vB << $mod.vC;',
+    '$mod.vA = $mod.vB >>> $mod.vC;',
+    '$mod.vA = 3 & $mod.vC;',
+    '$mod.vA = ($mod.vB & $mod.vC) | ($mod.vA & $mod.vB);',
+    '$mod.vA = ~$mod.vB;'
+    ]));
+end;
+
+procedure TTestModule.TestPrgProcVar;
+begin
+  StartProgram(false);
+  Add('procedure Proc1;');
+  Add('type');
+  Add('  t1=longint;');
+  Add('var');
+  Add('  vA:t1;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestPrgProcVar',
+    LinesToStr([ // statements
+    'this.Proc1 = function () {',
+    '  var vA=0;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestUnitProcVar;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('');
+  Add('type tA=string; // unit scope');
+  Add('procedure Proc1;');
+  Add('');
+  Add('implementation');
+  Add('');
+  Add('procedure Proc1;');
+  Add('type tA=longint; // local proc scope');
+  Add('var  v1:tA; // using local tA');
+  Add('begin');
+  Add('end;');
+  Add('var  v2:tA; // using interface tA');
+  ConvertUnit;
+  CheckSource('TestUnitProcVar',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'this.Proc1 = function () {',
+    '  var v1 = 0;',
+    '};',
+    '']),
+    // this.$init
+    '',
+    // implementation
+    LinesToStr([
+    '$impl.v2 = "";',
+    '']));
+end;
+
+procedure TTestModule.TestImplProc;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('');
+  Add('procedure Proc1;');
+  Add('');
+  Add('implementation');
+  Add('');
+  Add('procedure Proc1; begin end;');
+  Add('procedure Proc2; begin end;');
+  Add('initialization');
+  Add('  Proc1;');
+  Add('  Proc2;');
+  ConvertUnit;
+  CheckSource('TestImplProc',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'this.Proc1 = function () {',
+    '};',
+    '']),
+    LinesToStr([ // this.$init
+    '$mod.Proc1();',
+    '$impl.Proc2();',
+    '']),
+    LinesToStr([ // implementation
+    '$impl.Proc2 = function () {',
+    '};',
+    ''])
+    );
+end;
+
+procedure TTestModule.TestFunctionResult;
+begin
+  StartProgram(false);
+  Add('function Func1: longint;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestFunctionResult',
+    LinesToStr([ // statements
+    'this.Func1 = function () {',
+    '  var Result = 0;',
+    '  Result = 3;',
+    '  return Result;',
+    '};'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestNestedProc;
+begin
+  StartProgram(false);
+  Add('var vInUnit: longint;');
+  Add('function DoIt(pA,pD: longint): longint;');
+  Add('var');
+  Add('  vB: longint;');
+  Add('  vC: longint;');
+  Add('  function Nesty(pA: longint): longint; ');
+  Add('  var vB: longint;');
+  Add('  begin');
+  Add('    Result:=pa+vb+vc+pd+vInUnit;');
+  Add('  end;');
+  Add('begin');
+  Add('  Result:=pa+vb+vc;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestNestedProc',
+    LinesToStr([ // statements
+    'this.vInUnit = 0;',
+    'this.DoIt = function (pA, pD) {',
+    '  var Result = 0;',
+    '  var vB = 0;',
+    '  var vC = 0;',
+    '  function Nesty(pA) {',
+    '    var Result = 0;',
+    '    var vB = 0;',
+    '    Result = (((pA + vB) + vC) + pD) + $mod.vInUnit;',
+    '    return Result;',
+    '  };',
+    '  Result = (pA + vB) + vC;',
+    '  return Result;',
+    '};'
+    ]),
+    '');
+end;
+
+procedure TTestModule.TestForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure FuncA(Bar: longint); forward;');
+  Add('procedure FuncB(Bar: longint);');
+  Add('begin');
+  Add('  funca(bar);');
+  Add('end;');
+  Add('procedure funca(bar: longint);');
+  Add('begin');
+  Add('  if bar=3 then ;');
+  Add('end;');
+  Add('begin');
+  Add('  funca(4);');
+  Add('  funcb(5);');
+  ConvertProgram;
+  CheckSource('TestForwardProc',
+    LinesToStr([ // statements'
+    'this.FuncB = function (Bar) {',
+    '  $mod.FuncA(Bar);',
+    '};',
+    'this.FuncA = function (Bar) {',
+    '  if (Bar == 3);',
+    '};'
+    ]),
+    LinesToStr([
+    '$mod.FuncA(4);',
+    '$mod.FuncB(5);'
+    ])
+    );
+end;
+
+procedure TTestModule.TestNestedForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure FuncA;');
+  Add('  procedure FuncB(i: longint); forward;');
+  Add('  procedure FuncC(i: longint);');
+  Add('  begin');
+  Add('    funcb(i);');
+  Add('  end;');
+  Add('  procedure FuncB(i: longint);');
+  Add('  begin');
+  Add('    if i=3 then ;');
+  Add('  end;');
+  Add('begin');
+  Add('  funcc(4)');
+  Add('end;');
+  Add('begin');
+  Add('  funca;');
+  ConvertProgram;
+  CheckSource('TestNestedForwardProc',
+    LinesToStr([ // statements'
+    'this.FuncA = function () {',
+    '  function FuncC(i) {',
+    '    FuncB(i);',
+    '  };',
+    '  function FuncB(i) {',
+    '    if (i == 3);',
+    '  };',
+    '  FuncC(4);',
+    '};'
+    ]),
+    LinesToStr([
+    '$mod.FuncA();'
+    ])
+    );
+end;
+
+procedure TTestModule.TestAssignFunctionResult;
+begin
+  StartProgram(false);
+  Add('function Func1: longint;');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  i:=func1();');
+  Add('  i:=func1()+func1();');
+  ConvertProgram;
+  CheckSource('TestAssignFunctionResult',
+    LinesToStr([ // statements
+     'this.Func1 = function () {',
+     '  var Result = 0;',
+     '  return Result;',
+     '};',
+     'this.i = 0;'
+    ]),
+    LinesToStr([
+    '$mod.i = $mod.Func1();',
+    '$mod.i = $mod.Func1() + $mod.Func1();'
+    ]));
+end;
+
+procedure TTestModule.TestFunctionResultInCondition;
+begin
+  StartProgram(false);
+  Add('function Func1: longint;');
+  Add('begin');
+  Add('end;');
+  Add('function Func2: boolean;');
+  Add('begin');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  if func2 then ;');
+  Add('  if i=func1() then ;');
+  Add('  if i=func1 then ;');
+  ConvertProgram;
+  CheckSource('TestFunctionResultInCondition',
+    LinesToStr([ // statements
+     'this.Func1 = function () {',
+     '  var Result = 0;',
+     '  return Result;',
+     '};',
+     'this.Func2 = function () {',
+     '  var Result = false;',
+     '  return Result;',
+     '};',
+     'this.i = 0;'
+    ]),
+    LinesToStr([
+    'if ($mod.Func2());',
+    'if ($mod.i == $mod.Func1());',
+    'if ($mod.i == $mod.Func1());'
+    ]));
+end;
+
+procedure TTestModule.TestExit;
+begin
+  StartProgram(false);
+  Add('procedure ProcA;');
+  Add('begin');
+  Add('  exit;');
+  Add('end;');
+  Add('function FuncB: longint;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(3);');
+  Add('end;');
+  Add('function FuncC: string;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(''a'');');
+  Add('  exit(''abc'');');
+  Add('end;');
+  Add('begin');
+  Add('  exit;');
+  Add('  exit(1);');
+  ConvertProgram;
+  CheckSource('TestExit',
+    LinesToStr([ // statements
+    'this.ProcA = function () {',
+    '  return;',
+    '};',
+    'this.FuncB = function () {',
+    '  var Result = 0;',
+    '  return Result;',
+    '  return 3;',
+    '  return Result;',
+    '};',
+    'this.FuncC = function () {',
+    '  var Result = "";',
+    '  return Result;',
+    '  return "a";',
+    '  return "abc";',
+    '  return Result;',
+    '};'
+    ]),
+    LinesToStr([
+    'return;',
+    'return 1;',
+    '']));
+end;
+
+procedure TTestModule.TestBreak;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  repeat');
+  Add('    break;');
+  Add('  until true;');
+  Add('  while true do');
+  Add('    break;');
+  Add('  for i:=1 to 2 do');
+  Add('    break;');
+  ConvertProgram;
+  CheckSource('TestBreak',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    'do {',
+    '  break;',
+    '} while (!true);',
+    'while (true) break;',
+    'var $loopend1 = 2;',
+    'for ($mod.i = 1; $mod.i <= $loopend1; $mod.i++) break;',
+    'if ($mod.i > $loopend1) $mod.i--;'
+    ]));
+end;
+
+procedure TTestModule.TestContinue;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  repeat');
+  Add('    continue;');
+  Add('  until true;');
+  Add('  while true do');
+  Add('    continue;');
+  Add('  for i:=1 to 2 do');
+  Add('    continue;');
+  ConvertProgram;
+  CheckSource('TestContinue',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    'do {',
+    '  continue;',
+    '} while (!true);',
+    'while (true) continue;',
+    'var $loopend1 = 2;',
+    'for ($mod.i = 1; $mod.i <= $loopend1; $mod.i++) continue;',
+    'if ($mod.i > $loopend1) $mod.i--;'
+    ]));
+end;
+
+procedure TTestModule.TestProc_External;
+begin
+  StartProgram(false);
+  Add('procedure Foo; external name ''console.log'';');
+  Add('function Bar: longint; external name ''get.item'';');
+  Add('function Bla(s: string): longint; external name ''apply.something'';');
+  Add('var');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Foo;');
+  Add('  i:=Bar;');
+  Add('  i:=Bla(''abc'');');
+  ConvertProgram;
+  CheckSource('TestProcedureExternal',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    'console.log();',
+    '$mod.i = get.item();',
+    '$mod.i = apply.something("abc");'
+    ]));
+end;
+
+procedure TTestModule.TestProc_ExternalOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'procedure Now; external name ''Date.now'';',
+    'procedure DoIt;'
+    ]),
+    'procedure doit; begin end;');
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('implementation');
+  Add('begin');
+  Add('  now;');
+  Add('  now();');
+  Add('  uNit2.now;');
+  Add('  uNit2.now();');
+  Add('  doit;');
+  Add('  uNit2.doit;');
+  ConvertUnit;
+  CheckSource('TestProcedureExternalOtherUnit',
+    LinesToStr([
+    '']),
+    LinesToStr([
+    'Date.now();',
+    'Date.now();',
+    'Date.now();',
+    'Date.now();',
+    'pas.unit2.DoIt();',
+    'pas.unit2.DoIt();',
+    '']));
+end;
+
+procedure TTestModule.TestProc_Asm;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('begin;');
+  Add('  asm');
+  Add('  { a:{ b:{}, c:[]}, d:''1'' };');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcedureAsm',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  { a:{ b:{}, c:[]}, d:''1'' };',
+    '  return Result;',
+    '};'
+    ]),
+    LinesToStr([
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProc_Assembler;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint; assembler;');
+  Add('asm');
+  Add('{ a:{ b:{}, c:[]}, d:''1'' };');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcedureAssembler',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  { a:{ b:{}, c:[]}, d:''1'' };',
+    '};'
+    ]),
+    LinesToStr([
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProc_VarParam;
+begin
+  StartProgram(false);
+  Add('type integer = longint;');
+  Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
+  Add('var vJ: integer;');
+  Add('begin');
+  Add('  vg:=vg+1;');
+  Add('  vj:=vh+2;');
+  Add('  vi:=vi+3;');
+  Add('  doit(vg,vg,vg);');
+  Add('  doit(vh,vh,vj);');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj,vj,vj);');
+  Add('end;');
+  Add('var i: integer;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestProcedure_VarParam',
+    LinesToStr([ // statements
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = 0;',
+    '  vG = vG + 1;',
+    '  vJ = vH + 2;',
+    '  vI.set(vI.get()+3);',
+    '  $mod.DoIt(vG, vG, {',
+    '    get: function () {',
+    '      return vG;',
+    '    },',
+    '    set: function (v) {',
+    '      vG = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vH, vH, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vI.get(), vI.get(), vI);',
+    '  $mod.DoIt(vJ, vJ, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.i,$mod.i,{',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestProc_Overload;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(vI: longint); begin end;');
+  Add('procedure DoIt(vI, vJ: longint); begin end;');
+  Add('procedure DoIt(vD: double); begin end;');
+  Add('begin');
+  Add('  DoIt(1);');
+  Add('  DoIt(2,3);');
+  Add('  DoIt(4.5);');
+  ConvertProgram;
+  CheckSource('TestProcedureOverload',
+    LinesToStr([ // statements
+    'this.DoIt = function (vI) {',
+    '};',
+    'this.DoIt$1 = function (vI, vJ) {',
+    '};',
+    'this.DoIt$2 = function (vD) {',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt(1);',
+    '$mod.DoIt$1(2, 3);',
+    '$mod.DoIt$2(4.5);',
+    '']));
+end;
+
+procedure TTestModule.TestProc_OverloadForward;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(vI: longint); forward;');
+  Add('procedure DoIt(vI, vJ: longint); begin end;');
+  Add('procedure doit(vi: longint); begin end;');
+  Add('begin');
+  Add('  doit(1);');
+  Add('  doit(2,3);');
+  ConvertProgram;
+  CheckSource('TestProcedureOverloadForward',
+    LinesToStr([ // statements
+    'this.DoIt$1 = function (vI, vJ) {',
+    '};',
+    'this.DoIt = function (vI) {',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt(1);',
+    '$mod.DoIt$1(2, 3);',
+    '']));
+end;
+
+procedure TTestModule.TestProc_OverloadUnit;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('procedure DoIt(vI: longint);');
+  Add('procedure DoIt(vI, vJ: longint);');
+  Add('implementation');
+  Add('procedure DoIt(vI, vJ, vK, vL, vM: longint); forward;');
+  Add('procedure DoIt(vI, vJ, vK: longint); begin end;');
+  Add('procedure DoIt(vi: longint); begin end;');
+  Add('procedure DoIt(vI, vJ, vK, vL: longint); begin end;');
+  Add('procedure DoIt(vi, vj: longint); begin end;');
+  Add('procedure DoIt(vi, vj, vk, vl, vm: longint); begin end;');
+  Add('begin');
+  Add('  doit(1);');
+  Add('  doit(2,3);');
+  Add('  doit(4,5,6);');
+  Add('  doit(7,8,9,10);');
+  Add('  doit(11,12,13,14,15);');
+  ConvertUnit;
+  CheckSource('TestProcedureOverloadUnit',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'this.DoIt = function (vI) {',
+    '};',
+    'this.DoIt$1 = function (vI, vJ) {',
+    '};',
+    '']),
+    LinesToStr([ // this.$init
+    '$mod.DoIt(1);',
+    '$mod.DoIt$1(2, 3);',
+    '$impl.DoIt$3(4,5,6);',
+    '$impl.DoIt$4(7,8,9,10);',
+    '$impl.DoIt$2(11,12,13,14,15);',
+    '']),
+    LinesToStr([ // implementation
+    '$impl.DoIt$3 = function (vI, vJ, vK) {',
+    '};',
+    '$impl.DoIt$4 = function (vI, vJ, vK, vL) {',
+    '};',
+    '$impl.DoIt$2 = function (vI, vJ, vK, vL, vM) {',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestProc_OverloadNested;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(vA: longint); forward;');
+  Add('procedure DoIt(vB, vC: longint);');
+  Add('begin // 2 param overload');
+  Add('  doit(1);');
+  Add('  doit(1,2);');
+  Add('end;');
+  Add('procedure doit(vA: longint);');
+  Add('  procedure DoIt(vA, vB, vC: longint); forward;');
+  Add('  procedure DoIt(vA, vB, vC, vD: longint);');
+  Add('  begin // 4 param overload');
+  Add('    doit(1);');
+  Add('    doit(1,2);');
+  Add('    doit(1,2,3);');
+  Add('    doit(1,2,3,4);');
+  Add('  end;');
+  Add('  procedure doit(vA, vB, vC: longint);');
+  Add('    procedure DoIt(vA, vB, vC, vD, vE: longint); forward;');
+  Add('    procedure DoIt(vA, vB, vC, vD, vE, vF: longint);');
+  Add('    begin // 6 param overload');
+  Add('      doit(1);');
+  Add('      doit(1,2);');
+  Add('      doit(1,2,3);');
+  Add('      doit(1,2,3,4);');
+  Add('      doit(1,2,3,4,5);');
+  Add('      doit(1,2,3,4,5,6);');
+  Add('    end;');
+  Add('    procedure doit(vA, vB, vC, vD, vE: longint);');
+  Add('    begin // 5 param overload');
+  Add('      doit(1);');
+  Add('      doit(1,2);');
+  Add('      doit(1,2,3);');
+  Add('      doit(1,2,3,4);');
+  Add('      doit(1,2,3,4,5);');
+  Add('      doit(1,2,3,4,5,6);');
+  Add('    end;');
+  Add('  begin // 3 param overload');
+  Add('    doit(1);');
+  Add('    doit(1,2);');
+  Add('    doit(1,2,3);');
+  Add('    doit(1,2,3,4);');
+  Add('    doit(1,2,3,4,5);');
+  Add('    doit(1,2,3,4,5,6);');
+  Add('  end;');
+  Add('begin // 1 param overload');
+  Add('  doit(1);');
+  Add('  doit(1,2);');
+  Add('  doit(1,2,3);');
+  Add('  doit(1,2,3,4);');
+  Add('end;');
+  Add('begin // main');
+  Add('  doit(1);');
+  Add('  doit(1,2);');
+  ConvertProgram;
+  CheckSource('TestProcedureOverloadNested',
+    LinesToStr([ // statements
+    'this.DoIt$1 = function (vB, vC) {',
+    '  $mod.DoIt(1);',
+    '  $mod.DoIt$1(1, 2);',
+    '};',
+    'this.DoIt = function (vA) {',
+    '  function DoIt$3(vA, vB, vC, vD) {',
+    '    $mod.DoIt(1);',
+    '    $mod.DoIt$1(1, 2);',
+    '    DoIt$2(1, 2, 3);',
+    '    DoIt$3(1, 2, 3, 4);',
+    '  };',
+    '  function DoIt$2(vA, vB, vC) {',
+    '    function DoIt$5(vA, vB, vC, vD, vE, vF) {',
+    '      $mod.DoIt(1);',
+    '      $mod.DoIt$1(1, 2);',
+    '      DoIt$2(1, 2, 3);',
+    '      DoIt$3(1, 2, 3, 4);',
+    '      DoIt$4(1, 2, 3, 4, 5);',
+    '      DoIt$5(1, 2, 3, 4, 5, 6);',
+    '    };',
+    '    function DoIt$4(vA, vB, vC, vD, vE) {',
+    '      $mod.DoIt(1);',
+    '      $mod.DoIt$1(1, 2);',
+    '      DoIt$2(1, 2, 3);',
+    '      DoIt$3(1, 2, 3, 4);',
+    '      DoIt$4(1, 2, 3, 4, 5);',
+    '      DoIt$5(1, 2, 3, 4, 5, 6);',
+    '    };',
+    '    $mod.DoIt(1);',
+    '    $mod.DoIt$1(1, 2);',
+    '    DoIt$2(1, 2, 3);',
+    '    DoIt$3(1, 2, 3, 4);',
+    '    DoIt$4(1, 2, 3, 4, 5);',
+    '    DoIt$5(1, 2, 3, 4, 5, 6);',
+    '  };',
+    '  $mod.DoIt(1);',
+    '  $mod.DoIt$1(1, 2);',
+    '  DoIt$2(1, 2, 3);',
+    '  DoIt$3(1, 2, 3, 4);',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt(1);',
+    '$mod.DoIt$1(1, 2);',
+    '']));
+end;
+
+procedure TTestModule.TestProc_Varargs;
+begin
+  StartProgram(false);
+  Add('procedure ProcA(i:longint); varargs; external name ''ProcA'';');
+  Add('procedure ProcB; varargs; external name ''ProcB'';');
+  Add('procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';');
+  Add('function GetIt: longint; begin end;');
+  Add('begin');
+  Add('  ProcA(1);');
+  Add('  ProcA(1,2);');
+  Add('  ProcA(1,2.0);');
+  Add('  ProcA(1,2,3);');
+  Add('  ProcA(1,''2'');');
+  Add('  ProcA(2,'''');');
+  Add('  ProcA(3,false);');
+  Add('  ProcB;');
+  Add('  ProcB();');
+  Add('  ProcB(4);');
+  Add('  ProcB(''foo'');');
+  Add('  ProcC;');
+  Add('  ProcC();');
+  Add('  ProcC(4);');
+  Add('  ProcC(5,''foo'');');
+  Add('  ProcB(GetIt);');
+  Add('  ProcB(GetIt());');
+  Add('  ProcB(GetIt,GetIt());');
+  ConvertProgram;
+  CheckSource('TestProc_Varargs',
+    LinesToStr([ // statements
+    'this.GetIt = function () {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    'ProcA(1);',
+    'ProcA(1, 2);',
+    'ProcA(1, 2.0);',
+    'ProcA(1, 2, 3);',
+    'ProcA(1, "2");',
+    'ProcA(2, "");',
+    'ProcA(3, false);',
+    'ProcB();',
+    'ProcB();',
+    'ProcB(4);',
+    'ProcB("foo");',
+    'ProcC(17);',
+    'ProcC(17);',
+    'ProcC(4);',
+    'ProcC(5, "foo");',
+    'ProcB($mod.GetIt());',
+    'ProcB($mod.GetIt());',
+    'ProcB($mod.GetIt(), $mod.GetIt());',
+    '']));
+end;
+
+procedure TTestModule.TestEnum_Name;
+begin
+  StartProgram(false);
+  Add('type TMyEnum = (Red, Green, Blue);');
+  Add('var e: TMyEnum;');
+  Add('var f: TMyEnum = Blue;');
+  Add('begin');
+  Add('  e:=green;');
+  ConvertProgram;
+  CheckSource('TestEnumName',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.e = 0;',
+    'this.f = $mod.TMyEnum.Blue;'
+    ]),
+    LinesToStr([
+    '$mod.e=$mod.TMyEnum.Green;'
+    ]));
+end;
+
+procedure TTestModule.TestEnum_Number;
+begin
+  Converter.Options:=Converter.Options+[coEnumNumbers];
+  StartProgram(false);
+  Add('type TMyEnum = (Red, Green);');
+  Add('var');
+  Add('  e: TMyEnum;');
+  Add('  f: TMyEnum = Green;');
+  Add('begin');
+  Add('  e:=green;');
+  ConvertProgram;
+  CheckSource('TestEnumNumber',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.e = 0;',
+    'this.f = 1;'
+    ]),
+    LinesToStr([
+    '$mod.e=1;'
+    ]));
+end;
+
+procedure TTestModule.TestEnum_Functions;
+begin
+  StartProgram(false);
+  Add('type TMyEnum = (Red, Green);');
+  Add('var');
+  Add('  e: TMyEnum;');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(green);');
+  Add('  i:=ord(e);');
+  Add('  e:=low(tmyenum);');
+  Add('  e:=low(e);');
+  Add('  e:=high(tmyenum);');
+  Add('  e:=high(e);');
+  Add('  e:=pred(green);');
+  Add('  e:=pred(e);');
+  Add('  e:=succ(red);');
+  Add('  e:=succ(e);');
+  Add('  e:=tmyenum(1);');
+  Add('  e:=tmyenum(i);');
+  Add('  s:=str(e);');
+  Add('  str(e,s)');
+  Add('  s:=str(e:3);');
+  ConvertProgram;
+  CheckSource('TestEnumNumber',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.e = 0;',
+    'this.i = 0;',
+    'this.s = "";'
+    ]),
+    LinesToStr([
+    '$mod.i=$mod.TMyEnum.Red;',
+    '$mod.i=$mod.TMyEnum.Green;',
+    '$mod.i=$mod.e;',
+    '$mod.e=$mod.TMyEnum.Red;',
+    '$mod.e=$mod.TMyEnum.Red;',
+    '$mod.e=$mod.TMyEnum.Green;',
+    '$mod.e=$mod.TMyEnum.Green;',
+    '$mod.e=$mod.TMyEnum.Green-1;',
+    '$mod.e=$mod.e-1;',
+    '$mod.e=$mod.TMyEnum.Red+1;',
+    '$mod.e=$mod.e+1;',
+    '$mod.e=1;',
+    '$mod.e=$mod.i;',
+    '$mod.s = $mod.TMyEnum[$mod.e];',
+    '$mod.s = $mod.TMyEnum[$mod.e];',
+    '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
+    '']));
+end;
+
+procedure TTestModule.TestEnum_AsParams;
+begin
+  StartProgram(false);
+  Add('type TEnum = (Red,Blue);');
+  Add('procedure DoIt(vG: TEnum; const vH: TEnum; var vI: TEnum);');
+  Add('var vJ: TEnum;');
+  Add('begin');
+  Add('  vg:=vg;');
+  Add('  vj:=vh;');
+  Add('  vi:=vi;');
+  Add('  doit(vg,vg,vg);');
+  Add('  doit(vh,vh,vj);');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj,vj,vj);');
+  Add('end;');
+  Add('var i: TEnum;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestEnum_AsParams',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "Red",',
+    '  Red: 0,',
+    '  "1": "Blue",',
+    '  Blue: 1',
+    '};',
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = 0;',
+    '  vG = vG;',
+    '  vJ = vH;',
+    '  vI.set(vI.get());',
+    '  $mod.DoIt(vG, vG, {',
+    '    get: function () {',
+    '      return vG;',
+    '    },',
+    '    set: function (v) {',
+    '      vG = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vH, vH, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vI.get(), vI.get(), vI);',
+    '  $mod.DoIt(vJ, vJ, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.i,$mod.i,{',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestSet;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TColor = (Red, Green, Blue);');
+  Add('  TColors = set of TColor;');
+  Add('var');
+  Add('  c: TColor;');
+  Add('  s: TColors;');
+  Add('  t: TColors = [];');
+  Add('  u: TColors = [Red];');
+  Add('begin');
+  Add('  s:=[];');
+  Add('  s:=[Green];');
+  Add('  s:=[Green,Blue];');
+  Add('  s:=[Red..Blue];');
+  Add('  s:=[Red,Green..Blue];');
+  Add('  s:=[Red,c];');
+  Add('  s:=t;');
+  ConvertProgram;
+  CheckSource('TestEnumName',
+    LinesToStr([ // statements
+    'this.TColor = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.c = 0;',
+    'this.s = {};',
+    'this.t = {};',
+    'this.u = rtl.createSet($mod.TColor.Red);'
+    ]),
+    LinesToStr([
+    '$mod.s={};',
+    '$mod.s=rtl.createSet($mod.TColor.Green);',
+    '$mod.s=rtl.createSet($mod.TColor.Green,$mod.TColor.Blue);',
+    '$mod.s=rtl.createSet(null,$mod.TColor.Red,$mod.TColor.Blue);',
+    '$mod.s=rtl.createSet($mod.TColor.Red,null,$mod.TColor.Green,$mod.TColor.Blue);',
+    '$mod.s=rtl.createSet($mod.TColor.Red,$mod.c);',
+    '$mod.s=rtl.refSet($mod.t);',
+    '']));
+end;
+
+procedure TTestModule.TestSet_Operators;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TColor = (Red, Green, Blue);');
+  Add('  TColors = set of tcolor;');
+  Add('var');
+  Add('  vC: TColor;');
+  Add('  vS: TColors;');
+  Add('  vT: TColors;');
+  Add('  vU: TColors;');
+  Add('  B: boolean;');
+  Add('begin');
+  Add('  include(vs,green);');
+  Add('  exclude(vs,vc);');
+  Add('  vs:=vt+vu;');
+  Add('  vs:=vt+[red];');
+  Add('  vs:=[red]+vt;');
+  Add('  vs:=[red]+[green];');
+  Add('  vs:=vt-vu;');
+  Add('  vs:=vt-[red];');
+  Add('  vs:=[red]-vt;');
+  Add('  vs:=[red]-[green];');
+  Add('  vs:=vt*vu;');
+  Add('  vs:=vt*[red];');
+  Add('  vs:=[red]*vt;');
+  Add('  vs:=[red]*[green];');
+  Add('  vs:=vt><vu;');
+  Add('  vs:=vt><[red];');
+  Add('  vs:=[red]><vt;');
+  Add('  vs:=[red]><[green];');
+  Add('  b:=vt=vu;');
+  Add('  b:=vt=[red];');
+  Add('  b:=[red]=vt;');
+  Add('  b:=[red]=[green];');
+  Add('  b:=vt<>vu;');
+  Add('  b:=vt<>[red];');
+  Add('  b:=[red]<>vt;');
+  Add('  b:=[red]<>[green];');
+  Add('  b:=vt<=vu;');
+  Add('  b:=vt<=[red];');
+  Add('  b:=[red]<=vt;');
+  Add('  b:=[red]<=[green];');
+  Add('  b:=vt>=vu;');
+  Add('  b:=vt>=[red];');
+  Add('  b:=[red]>=vt;');
+  Add('  b:=[red]>=[green];');
+  ConvertProgram;
+  CheckSource('TestSet_Operators',
+    LinesToStr([ // statements
+    'this.TColor = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.vC = 0;',
+    'this.vS = {};',
+    'this.vT = {};',
+    'this.vU = {};',
+    'this.B = false;'
+    ]),
+    LinesToStr([
+    '$mod.vS = rtl.includeSet($mod.vS,$mod.TColor.Green);',
+    '$mod.vS = rtl.excludeSet($mod.vS,$mod.vC);',
+    '$mod.vS = rtl.unionSet($mod.vT, $mod.vU);',
+    '$mod.vS = rtl.unionSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.vS = rtl.unionSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.vS = rtl.diffSet($mod.vT, $mod.vU);',
+    '$mod.vS = rtl.diffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.vS = rtl.diffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.vS = rtl.intersectSet($mod.vT, $mod.vU);',
+    '$mod.vS = rtl.intersectSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.vS = rtl.intersectSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.vS = rtl.symDiffSet($mod.vT, $mod.vU);',
+    '$mod.vS = rtl.symDiffSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.vS = rtl.symDiffSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.B = rtl.eqSet($mod.vT, $mod.vU);',
+    '$mod.B = rtl.eqSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.B = rtl.eqSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.B = rtl.neSet($mod.vT, $mod.vU);',
+    '$mod.B = rtl.neSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.B = rtl.neSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.B = rtl.leSet($mod.vT, $mod.vU);',
+    '$mod.B = rtl.leSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.B = rtl.leSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '$mod.B = rtl.geSet($mod.vT, $mod.vU);',
+    '$mod.B = rtl.geSet($mod.vT, rtl.createSet($mod.TColor.Red));',
+    '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), $mod.vT);',
+    '$mod.B = rtl.geSet(rtl.createSet($mod.TColor.Red), rtl.createSet($mod.TColor.Green));',
+    '']));
+end;
+
+procedure TTestModule.TestSet_Operator_In;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TColor = (Red, Green, Blue);');
+  Add('  TColors = set of tcolor;');
+  Add('var');
+  Add('  vC: tcolor;');
+  Add('  vT: tcolors;');
+  Add('  B: boolean;');
+  Add('begin');
+  Add('  b:=red in vt;');
+  Add('  b:=vc in vt;');
+  Add('  b:=green in [red..blue];');
+  Add('  b:=vc in [red..blue];');
+  Add('  ');
+  Add('  if red in vt then ;');
+  Add('  while vC in vt do ;');
+  Add('  repeat');
+  Add('  until vC in vt;');
+  ConvertProgram;
+  CheckSource('TestSet_Operator_In',
+    LinesToStr([ // statements
+    'this.TColor = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1,',
+    '  "2":"Blue",',
+    '  Blue:2',
+    '  };',
+    'this.vC = 0;',
+    'this.vT = {};',
+    'this.B = false;'
+    ]),
+    LinesToStr([
+    '$mod.B = $mod.TColor.Red in $mod.vT;',
+    '$mod.B = $mod.vC in $mod.vT;',
+    '$mod.B = $mod.TColor.Green in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
+    '$mod.B = $mod.vC in rtl.createSet(null, $mod.TColor.Red, $mod.TColor.Blue);',
+    'if ($mod.TColor.Red in $mod.vT) ;',
+    'while ($mod.vC in $mod.vT) {',
+    '};',
+    'do {',
+    '} while (!($mod.vC in $mod.vT));',
+    '']));
+end;
+
+procedure TTestModule.TestSet_Functions;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TMyEnum = (Red, Green);');
+  Add('  TMyEnums = set of TMyEnum;');
+  Add('var');
+  Add('  e: TMyEnum;');
+  Add('  s: TMyEnums;');
+  Add('begin');
+  Add('  e:=Low(TMyEnums);');
+  Add('  e:=Low(s);');
+  Add('  e:=High(TMyEnums);');
+  Add('  e:=High(s);');
+  ConvertProgram;
+  CheckSource('TestSetFunctions',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.e = 0;',
+    'this.s = {};'
+    ]),
+    LinesToStr([
+    '$mod.e=$mod.TMyEnum.Red;',
+    '$mod.e=$mod.TMyEnum.Red;',
+    '$mod.e=$mod.TMyEnum.Green;',
+    '$mod.e=$mod.TMyEnum.Green;',
+    '']));
+end;
+
+procedure TTestModule.TestSet_PassAsArgClone;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TMyEnum = (Red, Green);');
+  Add('  TMyEnums = set of TMyEnum;');
+  Add('procedure DoDefault(s: tmyenums); begin end;');
+  Add('procedure DoConst(const s: tmyenums); begin end;');
+  Add('var');
+  Add('  aSet: tmyenums;');
+  Add('begin');
+  Add('  dodefault(aset);');
+  Add('  doconst(aset);');
+  ConvertProgram;
+  CheckSource('TestSetFunctions',
+    LinesToStr([ // statements
+    'this.TMyEnum = {',
+    '  "0":"Red",',
+    '  Red:0,',
+    '  "1":"Green",',
+    '  Green:1',
+    '  };',
+    'this.DoDefault = function (s) {',
+    '};',
+    'this.DoConst = function (s) {',
+    '};',
+    'this.aSet = {};'
+    ]),
+    LinesToStr([
+    '$mod.DoDefault(rtl.refSet($mod.aSet));',
+    '$mod.DoConst($mod.aSet);',
+    '']));
+end;
+
+procedure TTestModule.TestSet_AsParams;
+begin
+  StartProgram(false);
+  Add('type TEnum = (Red,Blue);');
+  Add('type TEnums = set of TEnum;');
+  Add('procedure DoIt(vG: TEnums; const vH: TEnums; var vI: TEnums);');
+  Add('var vJ: TEnums;');
+  Add('begin');
+  Add('  vg:=vg;');
+  Add('  vj:=vh;');
+  Add('  vi:=vi;');
+  Add('  doit(vg,vg,vg);');
+  Add('  doit(vh,vh,vj);');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj,vj,vj);');
+  Add('end;');
+  Add('var i: TEnums;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestSet_AsParams',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "Red",',
+    '  Red: 0,',
+    '  "1": "Blue",',
+    '  Blue: 1',
+    '};',
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = {};',
+    '  vG = rtl.refSet(vG);',
+    '  vJ = rtl.refSet(vH);',
+    '  vI.set(rtl.refSet(vI.get()));',
+    '  $mod.DoIt(rtl.refSet(vG), vG, {',
+    '    get: function () {',
+    '      return vG;',
+    '    },',
+    '    set: function (v) {',
+    '      vG = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(rtl.refSet(vH), vH, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(rtl.refSet(vI.get()), vI.get(), vI);',
+    '  $mod.DoIt(rtl.refSet(vJ), vJ, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.i = {};'
+    ]),
+    LinesToStr([
+    '$mod.DoIt(rtl.refSet($mod.i),$mod.i,{',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestSet_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (Red,Blue);');
+  Add('  TEnums = set of TEnum;');
+  Add('  TObject = class');
+  Add('    function GetColors: TEnums; external name ''GetColors'';');
+  Add('    procedure SetColors(const Value: TEnums); external name ''SetColors'';');
+  Add('    property Colors: TEnums read GetColors write SetColors;');
+  Add('  end;');
+  Add('procedure DoIt(i: TEnums; const j: TEnums; var k: TEnums; out l: TEnums);');
+  Add('begin end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  Include(Obj.Colors,Red);');
+  Add('  Exclude(Obj.Colors,Red);');
+  //Add('  DoIt(Obj.Colors,Obj.Colors,Obj.Colors,Obj.Colors);');
+  ConvertProgram;
+  CheckSource('TestSet_Property',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "Red",',
+    '  Red: 0,',
+    '  "1": "Blue",',
+    '  Blue: 1',
+    '};',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function (i, j, k, l) {',
+    '};',
+    'this.Obj = null;',
+    '']),
+    LinesToStr([
+    '$mod.Obj.SetColors(rtl.includeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
+    '$mod.Obj.SetColors(rtl.excludeSet($mod.Obj.GetColors(), $mod.TEnum.Red));',
+    '']));
+end;
+
+procedure TTestModule.TestSet_EnumConst;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (Red,Blue);');
+  Add('  TEnums = set of TEnum;');
+  Add('const');
+  Add('  Orange = red;');
+  Add('var');
+  Add('  Enum: tenum;');
+  Add('  Enums: tenums;');
+  Add('begin');
+  Add('  Include(enums,orange);');
+  Add('  Exclude(enums,orange);');
+  Add('  if orange in enums then;');
+  Add('  if orange in [orange,red] then;');
+  ConvertProgram;
+  CheckSource('TestEnumConst',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "Red",',
+    '  Red: 0,',
+    '  "1": "Blue",',
+    '  Blue: 1',
+    '};',
+    'this.Orange = $mod.TEnum.Red;',
+    'this.Enum = 0;',
+    'this.Enums = {};',
+    '']),
+    LinesToStr([
+    '$mod.Enums = rtl.includeSet($mod.Enums, $mod.Orange);',
+    '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.Orange);',
+    'if ($mod.Orange in $mod.Enums) ;',
+    'if ($mod.Orange in rtl.createSet($mod.Orange, $mod.TEnum.Red)) ;',
+    '']));
+end;
+
+procedure TTestModule.TestSet_AnonymousEnumType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFlags = set of (red, green);');
+  Add('const');
+  Add('  favorite = red;');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  Include(f,red);');
+  Add('  Include(f,favorite);');
+  Add('  i:=ord(red);');
+  Add('  i:=ord(favorite);');
+  Add('  i:=ord(low(TFlags));');
+  Add('  i:=ord(low(f));');
+  Add('  i:=ord(low(favorite));');
+  Add('  i:=ord(high(TFlags));');
+  Add('  i:=ord(high(f));');
+  Add('  i:=ord(high(favorite));');
+  Add('  f:=[green,favorite];');
+  ConvertProgram;
+  CheckSource('TestSet_AnonymousEnumType',
+    LinesToStr([ // statements
+    'this.TFlags$a = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "green",',
+    '  green: 1',
+    '};',
+    'this.favorite = $mod.TFlags$a.red;',
+    'this.f = {};',
+    'this.i = 0;',
+    '']),
+    LinesToStr([
+    '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
+    '$mod.f = rtl.includeSet($mod.f, $mod.favorite);',
+    '$mod.i = $mod.TFlags$a.red;',
+    '$mod.i = $mod.favorite;',
+    '$mod.i = $mod.TFlags$a.red;',
+    '$mod.i = $mod.TFlags$a.red;',
+    '$mod.i = $mod.TFlags$a.red;',
+    '$mod.i = $mod.TFlags$a.green;',
+    '$mod.i = $mod.TFlags$a.green;',
+    '$mod.i = $mod.TFlags$a.green;',
+    '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.favorite);',
+    '']));
+end;
+
+procedure TTestModule.TestSet_CharFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TChars = set of char;');
+  Add('begin');
+  SetExpectedPasResolverError('Not supported: set of Char',nNotSupportedX);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestSet_BooleanFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TBools = set of boolean;');
+  Add('begin');
+  SetExpectedPasResolverError('Not supported: set of Boolean',nNotSupportedX);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestSet_ConstEnum;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (red,blue,green);',
+  '  TEnums = set of TEnum;',
+  'const',
+  '  teAny = [low(TEnum)..high(TEnum)];',
+  '  teRedBlue = [low(TEnum)..pred(high(TEnum))];',
+  'var',
+  '  e: TEnum;',
+  '  s: TEnums;',
+  'begin',
+  '  if blue in teAny then;',
+  '  if blue in teAny+[e] then;',
+  '  if blue in teAny+teRedBlue then;',
+  '  s:=teAny;',
+  '  s:=teAny+[e];',
+  '  s:=[e]+teAny;',
+  '  s:=teAny+teRedBlue;',
+  '  s:=teAny+teRedBlue+[e];',
+  '']);
+  ConvertProgram;
+  CheckSource('TestSet_ConstEnum',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1,',
+    '  "2": "green",',
+    '  green: 2',
+    '};',
+    'this.teAny = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green);',
+    'this.teRedBlue = rtl.createSet(null, $mod.TEnum.red, $mod.TEnum.green - 1);',
+    'this.e = 0;',
+    'this.s = {};',
+    '']),
+    LinesToStr([
+    'if ($mod.TEnum.blue in $mod.teAny) ;',
+    'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, rtl.createSet($mod.e))) ;',
+    'if ($mod.TEnum.blue in rtl.unionSet($mod.teAny, $mod.teRedBlue)) ;',
+    '$mod.s = rtl.refSet($mod.teAny);',
+    '$mod.s = rtl.unionSet($mod.teAny, rtl.createSet($mod.e));',
+    '$mod.s = rtl.unionSet(rtl.createSet($mod.e), $mod.teAny);',
+    '$mod.s = rtl.unionSet($mod.teAny, $mod.teRedBlue);',
+    '$mod.s = rtl.unionSet(rtl.unionSet($mod.teAny, $mod.teRedBlue), rtl.createSet($mod.e));',
+    '']));
+end;
+
+procedure TTestModule.TestSet_ConstChar;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  LowChars = [''a''..''z''];');
+  Add('  Chars = LowChars+[''A''..''Z''];');
+  Add('var');
+  Add('  c: char;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  if c in lowchars then ;');
+  Add('  if ''a'' in lowchars then ;');
+  Add('  if s[1] in lowchars then ;');
+  Add('  if c in chars then ;');
+  Add('  if c in [''a''..''z'',''_''] then ;');
+  Add('  if ''b'' in [''a''..''z'',''_''] then ;');
+  ConvertProgram;
+  CheckSource('TestSet_ConstChar',
+    LinesToStr([ // statements
+    'this.LowChars = rtl.createSet(null, 97, 122);',
+    'this.Chars = rtl.unionSet($mod.LowChars, rtl.createSet(null, 65, 90));',
+    'this.c = "";',
+    'this.s = "";',
+    '']),
+    LinesToStr([
+    'if ($mod.c.charCodeAt() in $mod.LowChars) ;',
+    'if (97 in $mod.LowChars) ;',
+    'if ($mod.s.charCodeAt(1 - 1) in $mod.LowChars) ;',
+    'if ($mod.c.charCodeAt() in $mod.Chars) ;',
+    'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
+    'if (98 in rtl.createSet(null, 97, 122, 95)) ;',
+    '']));
+end;
+
+procedure TTestModule.TestNestBegin;
+begin
+  StartProgram(false);
+  Add('begin');
+  Add('  begin');
+  Add('    begin');
+  Add('    end;');
+  Add('    begin');
+  Add('      if true then ;');
+  Add('    end;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestNestBegin',
+    '',
+    'if (true) ;');
+end;
+
+procedure TTestModule.TestUnitImplVars;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  Add('var');
+  Add('  V1:longint;');
+  Add('  V2:longint = 3;');
+  Add('  V3:string = ''abc'';');
+  ConvertUnit;
+  CheckSource('TestUnitImplVars',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    '']),
+    '', // this.$init
+    LinesToStr([ // implementation
+    '$impl.V1 = 0;',
+    '$impl.V2 = 3;',
+    '$impl.V3 = "abc";',
+    '']) );
+end;
+
+procedure TTestModule.TestUnitImplConsts;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  Add('const');
+  Add('  v1 = 3;');
+  Add('  v2:longint = 4;');
+  Add('  v3:string = ''abc'';');
+  ConvertUnit;
+  CheckSource('TestUnitImplConsts',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    '']),
+    '', // this.$init
+    LinesToStr([ // implementation
+    '$impl.v1 = 3;',
+    '$impl.v2 = 4;',
+    '$impl.v3 = "abc";',
+    '']) );
+end;
+
+procedure TTestModule.TestUnitImplRecord;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('implementation');
+  Add('type');
+  Add('  TMyRecord = record');
+  Add('    i: longint;');
+  Add('  end;');
+  Add('var aRec: TMyRecord;');
+  Add('initialization');
+  Add('  arec.i:=3;');
+  ConvertUnit;
+  CheckSource('TestUnitImplRecord',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    '']),
+    // this.$init
+    '$impl.aRec.i = 3;',
+    LinesToStr([ // implementation
+    '$impl.TMyRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    '$impl.aRec = new $impl.TMyRecord();',
+    '']) );
+end;
+
+procedure TTestModule.TestRenameJSNameConflict;
+begin
+  StartProgram(false);
+  Add('var apply: longint;');
+  Add('var bind: longint;');
+  Add('var call: longint;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRenameJSNameConflict',
+    LinesToStr([ // statements
+    'this.Apply = 0;',
+    'this.Bind = 0;',
+    'this.Call = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestLocalConst;
+begin
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('const');
+  Add('  cA: longint = 1;');
+  Add('  cB = 2;');
+  Add('  procedure Sub;');
+  Add('  const');
+  Add('    csA = 3;');
+  Add('    cB: double = 4;');
+  Add('  begin');
+  Add('    cb:=cb+csa;');
+  Add('    ca:=ca+csa+5;');
+  Add('  end;');
+  Add('begin');
+  Add('  ca:=ca+cb+6;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestLocalConst',
+    LinesToStr([
+    'var cA = 1;',
+    'var cB = 2;',
+    'var csA = 3;',
+    'var cB$1 = 4;',
+    'this.DoIt = function () {',
+    '  function Sub() {',
+    '    cB$1 = cB$1 + csA;',
+    '    cA = (cA + csA) + 5;',
+    '  };',
+    '  cA = (cA + cB) + 6;',
+    '};'
+    ]),
+    LinesToStr([
+    ]));
+end;
+
+procedure TTestModule.TestVarExternal;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  NaN: double; external name ''Global.NaN'';');
+  Add('  d: double;');
+  Add('begin');
+  Add('  d:=NaN;');
+  ConvertProgram;
+  CheckSource('TestVarExternal',
+    LinesToStr([
+    'this.d = 0.0;'
+    ]),
+    LinesToStr([
+    '$mod.d = Global.NaN;'
+    ]));
+end;
+
+procedure TTestModule.TestVarExternalOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'var NaN: double; external name ''Global.NaN'';',
+    'var iV: longint;'
+    ]),
+    '');
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('implementation');
+  Add('var');
+  Add('  d: double;');
+  Add('  i: longint; external name ''$i'';');
+  Add('begin');
+  Add('  d:=nan;');
+  Add('  d:=uNit2.nan;');
+  Add('  d:=test1.d;');
+  Add('  i:=iv;');
+  Add('  i:=uNit2.iv;');
+  Add('  i:=test1.i;');
+  ConvertUnit;
+  CheckSource('TestVarExternalOtherUnit',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    '']),
+    LinesToStr([ // this.$init
+    '$impl.d = Global.NaN;',
+    '$impl.d = Global.NaN;',
+    '$impl.d = $impl.d;',
+    '$i = pas.unit2.iV;',
+    '$i = pas.unit2.iV;',
+    '$i = $i;',
+    '']),
+    LinesToStr([ // implementation
+    '$impl.d = 0.0;',
+    '']) );
+end;
+
+procedure TTestModule.TestDouble;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  d: double;',
+  'begin',
+  '  d:=1.0;',
+  '  d:=1.0/3.0;',
+  '  d:=1/3;',
+  '  d:=5.0E-324;',
+  '  d:=1.7E308;',
+  '  d:=10**3;',
+  '  d:=10 mod 3;',
+  '  d:=10 div 3;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestDouble',
+    LinesToStr([
+    'this.d=0.0;'
+    ]),
+    LinesToStr([
+    '$mod.d = 1.0;',
+    '$mod.d = 1.0 / 3.0;',
+    '$mod.d = 1 / 3;',
+    '$mod.d = 5.0E-324;',
+    '$mod.d = 1.7E308;',
+    '$mod.d = Math.pow(10, 3);',
+    '$mod.d = 10 % 3;',
+    '$mod.d = Math.floor(10 / 3);',
+    '']));
+end;
+
+procedure TTestModule.TestCharConst;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  c: char = ''1'';');
+  Add('begin');
+  Add('  c:=#0;');
+  Add('  c:=#1;');
+  Add('  c:=#9;');
+  Add('  c:=#10;');
+  Add('  c:=#13;');
+  Add('  c:=#31;');
+  Add('  c:=#32;');
+  Add('  c:=#$A;');
+  Add('  c:=#$0A;');
+  Add('  c:=#$b;');
+  Add('  c:=#$0b;');
+  Add('  c:=^A;');
+  Add('  c:=''"'';');
+  ConvertProgram;
+  CheckSource('TestCharConst',
+    LinesToStr([
+    'this.c="1";'
+    ]),
+    LinesToStr([
+    '$mod.c="\x00";',
+    '$mod.c="\x01";',
+    '$mod.c="\t";',
+    '$mod.c="\n";',
+    '$mod.c="\r";',
+    '$mod.c="\x1F";',
+    '$mod.c=" ";',
+    '$mod.c="\n";',
+    '$mod.c="\n";',
+    '$mod.c="\x0B";',
+    '$mod.c="\x0B";',
+    '$mod.c="\x01";',
+    '$mod.c=''"'';'
+    ]));
+end;
+
+procedure TTestModule.TestChar_Compare;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:=c=''1'';');
+  Add('  b:=''2''=c;');
+  Add('  b:=''3''=''4'';');
+  Add('  b:=c<>''5'';');
+  Add('  b:=''6''<>c;');
+  Add('  b:=c>''7'';');
+  Add('  b:=''8''>c;');
+  Add('  b:=c>=''9'';');
+  Add('  b:=''A''>=c;');
+  Add('  b:=c<''B'';');
+  Add('  b:=''C''<c;');
+  Add('  b:=c<=''D'';');
+  Add('  b:=''E''<=c;');
+  ConvertProgram;
+  CheckSource('TestChar_Compare',
+    LinesToStr([
+    'this.c="";',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    '$mod.b = $mod.c == "1";',
+    '$mod.b = "2" == $mod.c;',
+    '$mod.b = "3" == "4";',
+    '$mod.b = $mod.c != "5";',
+    '$mod.b = "6" != $mod.c;',
+    '$mod.b = $mod.c > "7";',
+    '$mod.b = "8" > $mod.c;',
+    '$mod.b = $mod.c >= "9";',
+    '$mod.b = "A" >= $mod.c;',
+    '$mod.b = $mod.c < "B";',
+    '$mod.b = "C" < $mod.c;',
+    '$mod.b = $mod.c <= "D";',
+    '$mod.b = "E" <= $mod.c;',
+    '']));
+end;
+
+procedure TTestModule.TestChar_Ord;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  i:=ord(c);');
+  Add('  i:=ord(s[i]);');
+  ConvertProgram;
+  CheckSource('TestChar_Ord',
+    LinesToStr([
+    'this.c = "";',
+    'this.i = 0;',
+    'this.s = "";'
+    ]),
+    LinesToStr([
+    '$mod.i = $mod.c.charCodeAt();',
+    '$mod.i = $mod.s.charCodeAt($mod.i-1);',
+    '']));
+end;
+
+procedure TTestModule.TestChar_Chr;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  c: char;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  c:=chr(i);');
+  ConvertProgram;
+  CheckSource('TestChar_Chr',
+    LinesToStr([
+    'this.c = "";',
+    'this.i = 0;'
+    ]),
+    LinesToStr([
+    '$mod.c = String.fromCharCode($mod.i);',
+    '']));
+end;
+
+procedure TTestModule.TestStringConst;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string = ''abc'';');
+  Add('begin');
+  Add('  s:='''';');
+  Add('  s:=#13#10;');
+  Add('  s:=#9''foo'';');
+  Add('  s:=#$A9;');
+  Add('  s:=''foo''#13''bar'';');
+  Add('  s:=''"'';');
+  Add('  s:=''"''''"'';');
+  ConvertProgram;
+  CheckSource('TestStringConst',
+    LinesToStr([
+    'this.s="abc";'
+    ]),
+    LinesToStr([
+    '$mod.s="";',
+    '$mod.s="\r\n";',
+    '$mod.s="\tfoo";',
+    '$mod.s="©";',
+    '$mod.s="foo\rbar";',
+    '$mod.s=''"'';',
+    '$mod.s=''"\''"'';'
+    ]));
+end;
+
+procedure TTestModule.TestString_Length;
+begin
+  StartProgram(false);
+  Add('const c = ''foo'';');
+  Add('var');
+  Add('  s: string;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  i:=length(s);');
+  Add('  i:=length(s+s);');
+  Add('  i:=length(''abc'');');
+  Add('  i:=length(c);');
+  ConvertProgram;
+  CheckSource('TestString_Length',
+    LinesToStr([
+    'this.c = "foo";',
+    'this.s = "";',
+    'this.i = 0;',
+    '']),
+    LinesToStr([
+    '$mod.i = $mod.s.length;',
+    '$mod.i = ($mod.s+$mod.s).length;',
+    '$mod.i = "abc".length;',
+    '$mod.i = $mod.c.length;',
+    '']));
+end;
+
+procedure TTestModule.TestString_Compare;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s, t: string;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:=s=t;');
+  Add('  b:=s<>t;');
+  Add('  b:=s>t;');
+  Add('  b:=s>=t;');
+  Add('  b:=s<t;');
+  Add('  b:=s<=t;');
+  ConvertProgram;
+  CheckSource('TestString_Compare',
+    LinesToStr([ // statements
+    'this.s = "";',
+    'this.t = "";',
+    'this.b =false;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.b = $mod.s == $mod.t;',
+    '$mod.b = $mod.s != $mod.t;',
+    '$mod.b = $mod.s > $mod.t;',
+    '$mod.b = $mod.s >= $mod.t;',
+    '$mod.b = $mod.s < $mod.t;',
+    '$mod.b = $mod.s <= $mod.t;',
+    '']));
+end;
+
+procedure TTestModule.TestString_SetLength;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(var s: string);',
+  'begin',
+  '  SetLength(s,2);',
+  'end;',
+  'var s: string;',
+  'begin',
+  '  SetLength(s,3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestString_SetLength',
+    LinesToStr([ // statements
+    'this.DoIt = function (s) {',
+    '  s.set(rtl.strSetLength(s.get(), 2));',
+    '};',
+    'this.s = "";',
+    '']),
+    LinesToStr([ // this.$main
+    '$mod.s = rtl.strSetLength($mod.s, 3);'
+    ]));
+end;
+
+procedure TTestModule.TestString_CharAt;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  s: string;');
+  Add('  c: char;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  b:= s[1] = c;');
+  Add('  b:= c = s[1];');
+  Add('  b:= c <> s[1];');
+  Add('  b:= c > s[1];');
+  Add('  b:= c >= s[1];');
+  Add('  b:= c < s[1];');
+  Add('  b:= c <= s[1];');
+  Add('  s[1] := c;');
+  ConvertProgram;
+  CheckSource('TestString_CharAt',
+    LinesToStr([ // statements
+    'this.s = "";',
+    'this.c = "";',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // this.$main
+    '$mod.b = $mod.s.charAt(1-1) == $mod.c;',
+    '$mod.b = $mod.c == $mod.s.charAt(1 - 1);',
+    '$mod.b = $mod.c != $mod.s.charAt(1 - 1);',
+    '$mod.b = $mod.c > $mod.s.charAt(1 - 1);',
+    '$mod.b = $mod.c >= $mod.s.charAt(1 - 1);',
+    '$mod.b = $mod.c < $mod.s.charAt(1 - 1);',
+    '$mod.b = $mod.c <= $mod.s.charAt(1 - 1);',
+    '$mod.s = rtl.setCharAt($mod.s, 1, $mod.c);',
+    '']));
+end;
+
+procedure TTestModule.TestStr;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  b: boolean;');
+  Add('  i: longint;');
+  Add('  d: double;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  str(b,s);');
+  Add('  str(i,s);');
+  Add('  str(d,s);');
+  Add('  str(i:3,s);');
+  Add('  str(d:3:2,s);');
+  Add('  s:=str(b);');
+  Add('  s:=str(i);');
+  Add('  s:=str(d);');
+  Add('  s:=str(i,i);');
+  Add('  s:=str(i:3);');
+  Add('  s:=str(d:3:2);');
+  Add('  s:=str(i:4,i);');
+  Add('  s:=str(i,i:5);');
+  Add('  s:=str(i:4,i:5);');
+  Add('  s:=str(s,s);');
+  Add('  s:=str(s,''foo'');');
+  ConvertProgram;
+  CheckSource('TestStr',
+    LinesToStr([ // statements
+    'this.b = false;',
+    'this.i = 0;',
+    'this.d = 0.0;',
+    'this.s = "";',
+    '']),
+    LinesToStr([ // this.$main
+    '$mod.s = ""+$mod.b;',
+    '$mod.s = ""+$mod.i;',
+    '$mod.s = ""+$mod.d;',
+    '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
+    '$mod.s = rtl.spaceLeft($mod.d.toFixed(2),3);',
+    '$mod.s = ""+$mod.b;',
+    '$mod.s = ""+$mod.i;',
+    '$mod.s = ""+$mod.d;',
+    '$mod.s = (""+$mod.i)+$mod.i;',
+    '$mod.s = rtl.spaceLeft(""+$mod.i,3);',
+    '$mod.s = rtl.spaceLeft($mod.d.toFixed(2),3);',
+    '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + $mod.i;',
+    '$mod.s = ("" + $mod.i) + rtl.spaceLeft("" + $mod.i, 5);',
+    '$mod.s = rtl.spaceLeft("" + $mod.i, 4) + rtl.spaceLeft("" + $mod.i, 5);',
+    '$mod.s = $mod.s + $mod.s;',
+    '$mod.s = $mod.s + "foo";',
+    '']));
+end;
+
+procedure TTestModule.TestBaseType_AnsiStringFail;
+begin
+  StartProgram(false);
+  Add('var s: AnsiString');
+  SetExpectedPasResolverError('identifier not found "AnsiString"',nIdentifierNotFound);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestBaseType_UnicodeStringFail;
+begin
+  StartProgram(false);
+  Add('var s: UnicodeString');
+  SetExpectedPasResolverError('identifier not found "UnicodeString"',nIdentifierNotFound);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestBaseType_ShortStringFail;
+begin
+  StartProgram(false);
+  Add('var s: ShortString');
+  SetExpectedPasResolverError('identifier not found "ShortString"',nIdentifierNotFound);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestBaseType_RawByteStringFail;
+begin
+  StartProgram(false);
+  Add('var s: RawByteString');
+  SetExpectedPasResolverError('identifier not found "RawByteString"',nIdentifierNotFound);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestTypeShortstring_Fail;
+begin
+  StartProgram(false);
+  Add('type t = string[12];');
+  Add('var s: t;');
+  Add('begin');
+  SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestProcTwoArgs;
+begin
+  StartProgram(false);
+  Add('procedure Test(a,b: longint);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestProcTwoArgs',
+    LinesToStr([ // statements
+    'this.Test = function (a,b) {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestProc_DefaultValue;
+begin
+  StartProgram(false);
+  Add('procedure p1(i: longint = 1);');
+  Add('begin');
+  Add('end;');
+  Add('procedure p2(i: longint = 1; c: char = ''a'');');
+  Add('begin');
+  Add('end;');
+  Add('procedure p3(d: double = 1.0; b: boolean = false; s: string = ''abc'');');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  p1;');
+  Add('  p1();');
+  Add('  p1(11);');
+  Add('  p2;');
+  Add('  p2();');
+  Add('  p2(12);');
+  Add('  p2(13,''b'');');
+  Add('  p3();');
+  ConvertProgram;
+  CheckSource('TestProc_DefaultValue',
+    LinesToStr([ // statements
+    'this.p1 = function (i) {',
+    '};',
+    'this.p2 = function (i,c) {',
+    '};',
+    'this.p3 = function (d,b,s) {',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    '  $mod.p1(1);',
+    '  $mod.p1(1);',
+    '  $mod.p1(11);',
+    '  $mod.p2(1,"a");',
+    '  $mod.p2(1,"a");',
+    '  $mod.p2(12,"a");',
+    '  $mod.p2(13,"b");',
+    '  $mod.p3(1.0,false,"abc");'
+    ]));
+end;
+
+procedure TTestModule.TestFunctionInt;
+begin
+  StartProgram(false);
+  Add('function MyTest(Bar: longint): longint;');
+  Add('begin');
+  Add('  Result:=2*bar');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestFunctionInt',
+    LinesToStr([ // statements
+    'this.MyTest = function (Bar) {',
+    '  var Result = 0;',
+    '  Result = 2*Bar;',
+    '  return Result;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestFunctionString;
+begin
+  StartProgram(false);
+  Add('function Test(Bar: string): string;');
+  Add('begin');
+  Add('  Result:=bar+BAR');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestFunctionString',
+    LinesToStr([ // statements
+    'this.Test = function (Bar) {',
+    '  var Result = "";',
+    '  Result = Bar+Bar;',
+    '  return Result;',
+    '};'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestForLoop;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vI, vJ, vN: longint;');
+  Add('begin');
+  Add('  VJ:=0;');
+  Add('  VN:=3;');
+  Add('  for VI:=1 to VN do');
+  Add('  begin');
+  Add('    VJ:=VJ+VI;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestForLoop',
+    LinesToStr([ // statements
+    'this.vI = 0;',
+    'this.vJ = 0;',
+    'this.vN = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '  $mod.vJ = 0;',
+    '  $mod.vN = 3;',
+    '  var $loopend1 = $mod.vN;',
+    '  for ($mod.vI = 1; $mod.vI <= $loopend1; $mod.vI++) {',
+    '    $mod.vJ = $mod.vJ + $mod.vI;',
+    '  };',
+    '  if ($mod.vI > $loopend1) $mod.vI--;'
+    ]));
+end;
+
+procedure TTestModule.TestForLoopInFunction;
+begin
+  StartProgram(false);
+  Add('function SumNumbers(Count: longint): longint;');
+  Add('var');
+  Add('  vI, vJ: longint;');
+  Add('begin');
+  Add('  vj:=0;');
+  Add('  for vi:=1 to count do');
+  Add('  begin');
+  Add('    vj:=vj+vi;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  sumnumbers(3);');
+  ConvertProgram;
+  CheckSource('TestForLoopInFunction',
+    LinesToStr([ // statements
+    'this.SumNumbers = function (Count) {',
+    '  var Result = 0;',
+    '  var vI = 0;',
+    '  var vJ = 0;',
+    '  vJ = 0;',
+    '  var $loopend1 = Count;',
+    '  for (vI = 1; vI <= $loopend1; vI++) {',
+    '    vJ = vJ + vI;',
+    '  };',
+    '  return Result;',
+    '};'
+    ]),
+    LinesToStr([ // $mod.$main
+    '  $mod.SumNumbers(3);'
+    ]));
+end;
+
+procedure TTestModule.TestForLoop_ReadVarAfter;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vI: longint;');
+  Add('begin');
+  Add('  for vi:=1 to 2 do ;');
+  Add('  if vi=3 then ;');
+  ConvertProgram;
+  CheckSource('TestForLoop',
+    LinesToStr([ // statements
+    'this.vI = 0;'
+    ]),
+    LinesToStr([ // this.$main
+    '  var $loopend1 = 2;',
+    '  for ($mod.vI = 1; $mod.vI <= $loopend1; $mod.vI++);',
+    '  if($mod.vI>$loopend1)$mod.vI--;',
+    '  if ($mod.vI==3) ;'
+    ]));
+end;
+
+procedure TTestModule.TestForLoop_Nested;
+begin
+  StartProgram(false);
+  Add('function SumNumbers(Count: longint): longint;');
+  Add('var');
+  Add('  vI, vJ, vK: longint;');
+  Add('begin');
+  Add('  VK:=0;');
+  Add('  for VI:=1 to count do');
+  Add('  begin');
+  Add('    for vj:=1 to vi do');
+  Add('    begin');
+  Add('      vk:=VK+VI;');
+  Add('    end;');
+  Add('  end;');
+  Add('end;');
+  Add('begin');
+  Add('  sumnumbers(3);');
+  ConvertProgram;
+  CheckSource('TestForLoopInFunction',
+    LinesToStr([ // statements
+    'this.SumNumbers = function (Count) {',
+    '  var Result = 0;',
+    '  var vI = 0;',
+    '  var vJ = 0;',
+    '  var vK = 0;',
+    '  vK = 0;',
+    '  var $loopend1 = Count;',
+    '  for (vI = 1; vI <= $loopend1; vI++) {',
+    '    var $loopend2 = vI;',
+    '    for (vJ = 1; vJ <= $loopend2; vJ++) {',
+    '      vK = vK + vI;',
+    '    };',
+    '  };',
+    '  return Result;',
+    '};'
+    ]),
+    LinesToStr([ // $mod.$main
+    '  $mod.SumNumbers(3);'
+    ]));
+end;
+
+procedure TTestModule.TestRepeatUntil;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vI, vJ, vN: longint;');
+  Add('begin');
+  Add('  vn:=3;');
+  Add('  vj:=0;');
+  Add('  VI:=0;');
+  Add('  repeat');
+  Add('    VI:=vi+1;');
+  Add('    vj:=VJ+vI;');
+  Add('  until vi>=vn');
+  ConvertProgram;
+  CheckSource('TestRepeatUntil',
+    LinesToStr([ // statements
+    'this.vI = 0;',
+    'this.vJ = 0;',
+    'this.vN = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '  $mod.vN = 3;',
+    '  $mod.vJ = 0;',
+    '  $mod.vI = 0;',
+    '  do{',
+    '    $mod.vI = $mod.vI + 1;',
+    '    $mod.vJ = $mod.vJ + $mod.vI;',
+    '  }while(!($mod.vI>=$mod.vN));'
+    ]));
+end;
+
+procedure TTestModule.TestAsmBlock;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  vI: longint;');
+  Add('begin');
+  Add('  vi:=1;');
+  Add('  asm');
+  Add('    if (vI==1) {');
+  Add('      vI=2;');
+  Add('    }');
+  Add('    if (vI==2){ vI=3; }');
+  Add('  end;');
+  Add('  VI:=4;');
+  ConvertProgram;
+  CheckSource('TestAsmBlock',
+    LinesToStr([ // statements
+    'this.vI = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.vI = 1;',
+    'if (vI==1) {',
+    '  vI=2;',
+    '}',
+    'if (vI==2){ vI=3; }',
+    ';',
+    '$mod.vI = 4;'
+    ]));
+end;
+
+procedure TTestModule.TestAsmPas_Impl;
+begin
+  StartUnit(false);
+  Add('interface');
+  Add('const cIntf: longint = 1;');
+  Add('var vIntf: longint;');
+  Add('implementation');
+  Add('const cImpl: longint = 2;');
+  Add('var vImpl: longint;');
+  Add('procedure DoIt;');
+  Add('const cLoc: longint = 3;');
+  Add('var vLoc: longint;');
+  Add('begin;');
+  Add('  asm');
+  //Add('    pas(vIntf)=pas(cIntf);');
+  //Add('    pas(vImpl)=pas(cImpl);');
+  //Add('    pas(vLoc)=pas(cLoc);');
+  Add('  end;');
+  Add('end;');
+  ConvertUnit;
+  // ToDo: check use analyzer
+  CheckSource('TestAsmPas_Impl',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'this.cIntf = 1;',
+    'this.vIntf = 0;',
+    '']),
+    '', // this.$init
+    LinesToStr([ // implementation
+    'var cLoc = 3;',
+    '$impl.cImpl = 2;',
+    '$impl.vImpl = 0;',
+    '$impl.DoIt = function () {',
+    '  var vLoc = 0;',
+    '};',
+    '']) );
+end;
+
+procedure TTestModule.TestTryFinally;
+begin
+  StartProgram(false);
+  Add('var i: longint;');
+  Add('begin');
+  Add('  try');
+  Add('    i:=0; i:=2 div i;');
+  Add('  finally');
+  Add('    i:=3');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestTryFinally',
+    LinesToStr([ // statements
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'try {',
+    '  $mod.i = 0;',
+    '  $mod.i = Math.floor(2 / $mod.i);',
+    '} finally {',
+    '  $mod.i = 3;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestTryExcept;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  Exception = class Msg: string; end;');
+  Add('  EInvalidCast = class(Exception) end;');
+  Add('var vI: longint;');
+  Add('begin');
+  Add('  try');
+  Add('    vi:=1;');
+  Add('  except');
+  Add('    vi:=2');
+  Add('  end;');
+  Add('  try');
+  Add('    vi:=3;');
+  Add('  except');
+  Add('    raise;');
+  Add('  end;');
+  Add('  try');
+  Add('    VI:=4;');
+  Add('  except');
+  Add('    on einvalidcast do');
+  Add('      raise;');
+  Add('    on E: exception do');
+  Add('      if e.msg='''' then');
+  Add('        raise e;');
+  Add('    else');
+  Add('      vi:=5');
+  Add('  end;');
+  Add('  try');
+  Add('    VI:=6;');
+  Add('  except');
+  Add('    on einvalidcast do ;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestTryExcept',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.Msg = "";',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "EInvalidCast", $mod.Exception, function () {',
+    '});',
+    'this.vI = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'try {',
+    '  $mod.vI = 1;',
+    '} catch ($e) {',
+    '  $mod.vI = 2;',
+    '};',
+    'try {',
+    '  $mod.vI = 3;',
+    '} catch ($e) {',
+    '  throw $e;',
+    '};',
+    'try {',
+    '  $mod.vI = 4;',
+    '} catch ($e) {',
+    '  if ($mod.EInvalidCast.isPrototypeOf($e)){',
+    '    throw $e',
+    '  } else if ($mod.Exception.isPrototypeOf($e)) {',
+    '    var E = $e;',
+    '    if (E.Msg == "") throw E;',
+    '  } else {',
+    '    $mod.vI = 5;',
+    '  }',
+    '};',
+    'try {',
+    '  $mod.vI = 6;',
+    '} catch ($e) {',
+    '  if ($mod.EInvalidCast.isPrototypeOf($e)){' ,
+    '  } else throw $e',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestCaseOf;
+begin
+  StartProgram(false);
+  Add('var vI: longint;');
+  Add('begin');
+  Add('  case vi of');
+  Add('  1: ;');
+  Add('  2: vi:=3;');
+  Add('  else');
+  Add('    VI:=4');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestCaseOf',
+    LinesToStr([ // statements
+    'this.vI = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $tmp1 = $mod.vI;',
+    'if ($tmp1 == 1) {} else if ($tmp1 == 2){ $mod.vI = 3 }else {',
+    '  $mod.vI = 4;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOf_UseSwitch;
+begin
+  StartProgram(false);
+  Converter.UseSwitchStatement:=true;
+  Add('var Vi: longint;');
+  Add('begin');
+  Add('  case vi of');
+  Add('  1: ;');
+  Add('  2: VI:=3;');
+  Add('  else');
+  Add('    vi:=4');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestCaseOf_UseSwitch',
+    LinesToStr([ // statements
+    'this.Vi = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'switch ($mod.Vi) {',
+    'case 1:',
+    '  break;',
+    'case 2:',
+    '  $mod.Vi = 3;',
+    '  break;',
+    'default:',
+    '  $mod.Vi = 4;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOfNoElse;
+begin
+  StartProgram(false);
+  Add('var Vi: longint;');
+  Add('begin');
+  Add('  case vi of');
+  Add('  1: begin vi:=2; VI:=3; end;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestCaseOfNoElse',
+    LinesToStr([ // statements
+    'this.Vi = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $tmp1 = $mod.Vi;',
+    'if ($tmp1 == 1) {',
+    '  $mod.Vi = 2;',
+    '  $mod.Vi = 3;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOfNoElse_UseSwitch;
+begin
+  StartProgram(false);
+  Converter.UseSwitchStatement:=true;
+  Add('var vI: longint;');
+  Add('begin');
+  Add('  case vi of');
+  Add('  1: begin VI:=2; vi:=3; end;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestCaseOfNoElse_UseSwitch',
+    LinesToStr([ // statements
+    'this.vI = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'switch ($mod.vI) {',
+    'case 1:',
+    '  $mod.vI = 2;',
+    '  $mod.vI = 3;',
+    '  break;',
+    '};'
+    ]));
+end;
+
+procedure TTestModule.TestCaseOfRange;
+begin
+  StartProgram(false);
+  Add('var vI: longint;');
+  Add('begin');
+  Add('  case vi of');
+  Add('  1..3: vi:=14;');
+  Add('  4,5: vi:=16;');
+  Add('  6..7,9..10: ;');
+  Add('  else ;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestCaseOfRange',
+    LinesToStr([ // statements
+    'this.vI = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $tmp1 = $mod.vI;',
+    'if (($tmp1 >= 1) && ($tmp1 <= 3)){',
+    '  $mod.vI = 14',
+    '} else if (($tmp1 == 4) || ($tmp1 == 5)){',
+    '  $mod.vI = 16',
+    '} else if ((($tmp1 >= 6) && ($tmp1 <= 7)) || (($tmp1 >= 9) && ($tmp1 <= 10))) ;'
+    ]));
+end;
+
+procedure TTestModule.TestArray_Dynamic;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrayInt = array of longint;');
+  Add('var');
+  Add('  Arr: TArrayInt;');
+  Add('  i: longint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  SetLength(arr,3);');
+  Add('  arr[0]:=4;');
+  Add('  arr[1]:=length(arr)+arr[0];');
+  Add('  arr[i]:=5;');
+  Add('  arr[arr[i]]:=arr[6];');
+  Add('  i:=low(arr);');
+  Add('  i:=high(arr);');
+  Add('  b:=Assigned(arr);');
+  ConvertProgram;
+  CheckSource('TestArray_Dynamic',
+    LinesToStr([ // statements
+    'this.Arr = [];',
+    'this.i = 0;',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr = rtl.arraySetLength($mod.Arr,3,0);',
+    '$mod.Arr[0] = 4;',
+    '$mod.Arr[1] = rtl.length($mod.Arr) + $mod.Arr[0];',
+    '$mod.Arr[$mod.i] = 5;',
+    '$mod.Arr[$mod.Arr[$mod.i]] = $mod.Arr[6];',
+    '$mod.i = 0;',
+    '$mod.i = rtl.length($mod.Arr) - 1;',
+    '$mod.b = rtl.length($mod.Arr) > 0;',
+    '']));
+end;
+
+procedure TTestModule.TestArray_Dynamic_Nil;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrayInt = array of longint;');
+  Add('var');
+  Add('  Arr: TArrayInt;');
+  Add('procedure DoIt(const i: TArrayInt; j: TArrayInt); begin end;');
+  Add('begin');
+  Add('  arr:=nil;');
+  Add('  if arr=nil then;');
+  Add('  if nil=arr then;');
+  Add('  if arr<>nil then;');
+  Add('  if nil<>arr then;');
+  Add('  DoIt(nil,nil);');
+  ConvertProgram;
+  CheckSource('TestArray_Dynamic',
+    LinesToStr([ // statements
+    'this.Arr = [];',
+    'this.DoIt = function(i,j){',
+    '};'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr = [];',
+    'if (rtl.length($mod.Arr) == 0) ;',
+    'if (rtl.length($mod.Arr) == 0) ;',
+    'if (rtl.length($mod.Arr) > 0) ;',
+    'if (rtl.length($mod.Arr) > 0) ;',
+    '$mod.DoIt([],[]);',
+    '']));
+end;
+
+procedure TTestModule.TestArray_DynMultiDimensional;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrayInt = array of longint;');
+  Add('  TArrayArrayInt = array of TArrayInt;');
+  Add('var');
+  Add('  Arr: TArrayInt;');
+  Add('  Arr2: TArrayArrayInt;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  arr2:=nil;');
+  Add('  if arr2=nil then;');
+  Add('  if nil=arr2 then;');
+  Add('  i:=low(arr2);');
+  Add('  i:=low(arr2[1]);');
+  Add('  i:=high(arr2);');
+  Add('  i:=high(arr2[2]);');
+  Add('  arr2[3]:=arr;');
+  Add('  arr2[4][5]:=i;');
+  Add('  i:=arr2[6][7];');
+  Add('  arr2[8,9]:=i;');
+  Add('  i:=arr2[10,11];');
+  Add('  SetLength(arr2,14);');
+  Add('  SetLength(arr2[15],16);');
+  ConvertProgram;
+  CheckSource('TestArray_Dynamic',
+    LinesToStr([ // statements
+    'this.Arr = [];',
+    'this.Arr2 = [];',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr2 = [];',
+    'if (rtl.length($mod.Arr2) == 0) ;',
+    'if (rtl.length($mod.Arr2) == 0) ;',
+    '$mod.i = 0;',
+    '$mod.i = 0;',
+    '$mod.i = rtl.length($mod.Arr2) - 1;',
+    '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
+    '$mod.Arr2[3] = $mod.Arr;',
+    '$mod.Arr2[4][5] = $mod.i;',
+    '$mod.i = $mod.Arr2[6][7];',
+    '$mod.Arr2[8][9] = $mod.i;',
+    '$mod.i = $mod.Arr2[10][11];',
+    '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, 14, []);',
+    '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 16, 0);',
+    '']));
+end;
+
+procedure TTestModule.TestArrayOfRecord;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record');
+  Add('    Int: longint;');
+  Add('  end;');
+  Add('  TArrayRec = array of TRec;');
+  Add('var');
+  Add('  Arr: TArrayRec;');
+  Add('  r: TRec;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  SetLength(arr,3);');
+  Add('  arr[0].int:=4;');
+  Add('  arr[1].int:=length(arr)+arr[2].int;');
+  Add('  arr[arr[i].int].int:=arr[5].int;');
+  Add('  arr[7]:=r;');
+  Add('  r:=arr[8];');
+  Add('  i:=low(arr);');
+  Add('  i:=high(arr);');
+  ConvertProgram;
+  CheckSource('TestArrayOfRecord',
+    LinesToStr([ // statements
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.Int = s.Int;',
+    '  } else {',
+    '    this.Int = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.Int == b.Int;',
+    '  };',
+    '};',
+    'this.Arr = [];',
+    'this.r = new $mod.TRec();',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr = rtl.arraySetLength($mod.Arr,3, $mod.TRec);',
+    '$mod.Arr[0].Int = 4;',
+    '$mod.Arr[1].Int = rtl.length($mod.Arr)+$mod.Arr[2].Int;',
+    '$mod.Arr[$mod.Arr[$mod.i].Int].Int = $mod.Arr[5].Int;',
+    '$mod.Arr[7] = new $mod.TRec($mod.r);',
+    '$mod.r = new $mod.TRec($mod.Arr[8]);',
+    '$mod.i = 0;',
+    '$mod.i = rtl.length($mod.Arr)-1;',
+    '']));
+end;
+
+procedure TTestModule.TestArray_AsParams;
+begin
+  StartProgram(false);
+  Add('type integer = longint;');
+  Add('type TArrInt = array of integer;');
+  Add('procedure DoIt(vG: TArrInt; const vH: TArrInt; var vI: TArrInt);');
+  Add('var vJ: TArrInt;');
+  Add('begin');
+  Add('  vg:=vg;');
+  Add('  vj:=vh;');
+  Add('  vi:=vi;');
+  Add('  doit(vg,vg,vg);');
+  Add('  doit(vh,vh,vj);');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj,vj,vj);');
+  Add('end;');
+  Add('var i: TArrInt;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestArray_AsParams',
+    LinesToStr([ // statements
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = [];',
+    '  vG = vG;',
+    '  vJ = vH;',
+    '  vI.set(vI.get());',
+    '  $mod.DoIt(vG, vG, {',
+    '    get: function () {',
+    '      return vG;',
+    '    },',
+    '    set: function (v) {',
+    '      vG = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vH, vH, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vI.get(), vI.get(), vI);',
+    '  $mod.DoIt(vJ, vJ, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.i = [];'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.i,$mod.i,{',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestArrayElement_AsParams;
+begin
+  StartProgram(false);
+  Add('type integer = longint;');
+  Add('type TArrayInt = array of integer;');
+  Add('procedure DoIt(vG: Integer; const vH: Integer; var vI: Integer);');
+  Add('var vJ: tarrayint;');
+  Add('begin');
+  Add('  vi:=vi;');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj[1+1],vj[1+2],vj[1+3]);');
+  Add('end;');
+  Add('var a: TArrayInt;');
+  Add('begin');
+  Add('  doit(a[1+4],a[1+5],a[1+6]);');
+  ConvertProgram;
+  CheckSource('TestArrayElement_AsParams',
+    LinesToStr([ // statements
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = [];',
+    '  vI.set(vI.get());',
+    '  $mod.DoIt(vI.get(), vI.get(), vI);',
+    '  $mod.DoIt(vJ[1+1], vJ[1+2], {',
+    '    a:1+3,',
+    '    p:vJ,',
+    '    get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '    set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.a = [];'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.a[1+4],$mod.a[1+5],{',
+    '  a: 1+6,',
+    '  p: $mod.a,',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestArrayElementFromFuncResult_AsParams;
+begin
+  StartProgram(false);
+  Add('type Integer = longint;');
+  Add('type TArrayInt = array of integer;');
+  Add('function GetArr(vB: integer = 0): tarrayint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  doit(getarr[1+1],getarr[1+2],getarr[1+3]);');
+  Add('  doit(getarr()[2+1],getarr()[2+2],getarr()[2+3]);');
+  Add('  doit(getarr(7)[3+1],getarr(8)[3+2],getarr(9)[3+3]);');
+  ConvertProgram;
+  CheckSource('TestArrayElementFromFuncResult_AsParams',
+    LinesToStr([ // statements
+    'this.GetArr = function (vB) {',
+    '  var Result = [];',
+    '  return Result;',
+    '};',
+    'this.DoIt = function (vG,vH,vI) {',
+    '};'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.GetArr(0)[1+1],$mod.GetArr(0)[1+2],{',
+    '  a: 1+3,',
+    '  p: $mod.GetArr(0),',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '});',
+    '$mod.DoIt($mod.GetArr(0)[2+1],$mod.GetArr(0)[2+2],{',
+    '  a: 2+3,',
+    '  p: $mod.GetArr(0),',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '});',
+    '$mod.DoIt($mod.GetArr(7)[3+1],$mod.GetArr(8)[3+2],{',
+    '  a: 3+3,',
+    '  p: $mod.GetArr(9),',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestArrayEnumTypeRange;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,blue);');
+  Add('  TEnumArray = array[TEnum] of longint;');
+  Add('var');
+  Add('  e: TEnum;');
+  Add('  i: longint;');
+  Add('  a: TEnumArray;');
+  Add('  numbers: TEnumArray = (1,2);');
+  Add('  names: array[TEnum] of string = (''red'',''blue'');');
+  Add('begin');
+  Add('  e:=low(a);');
+  Add('  e:=high(a);');
+  Add('  i:=a[red]+length(a);');
+  Add('  a[e]:=a[e];');
+  ConvertProgram;
+  CheckSource('TestArrayEnumTypeRange',
+    LinesToStr([ // statements
+    '  this.TEnum = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1',
+    '};',
+    'this.e = 0;',
+    'this.i = 0;',
+    'this.a = rtl.arrayNewMultiDim([2],0);',
+    'this.numbers = [1, 2];',
+    'this.names = ["red", "blue"];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.e = $mod.TEnum.red;',
+    '$mod.e = $mod.TEnum.blue;',
+    '$mod.i = $mod.a[$mod.TEnum.red]+2;',
+    '$mod.a[$mod.e] = $mod.a[$mod.e];',
+    '']));
+end;
+
+procedure TTestModule.TestArray_SetLengthOutArg;
+begin
+  StartProgram(false);
+  Add([
+  'type TArrInt = array of longint;',
+  'procedure DoIt(out a: TArrInt);',
+  'begin',
+  '  SetLength(a,2);',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_SetLengthOutArg',
+    LinesToStr([ // statements
+    'this.DoIt = function (a) {',
+    '  a.set(rtl.arraySetLength(a.get(), 2, 0));',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestArray_SetLengthProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArrInt = array of longint;');
+  Add('  TObject = class');
+  Add('    function GetColors: TArrInt; external name ''GetColors'';');
+  Add('    procedure SetColors(const Value: TArrInt); external name ''SetColors'';');
+  Add('    property Colors: TArrInt read GetColors write SetColors;');
+  Add('  end;');
+  Add('var Obj: TObject;');
+  Add('begin');
+  Add('  SetLength(Obj.Colors,2);');
+  ConvertProgram;
+  CheckSource('TestArray_SetLengthProperty',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    '']),
+    LinesToStr([
+    '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 2, 0));',
+    '']));
+end;
+
+procedure TTestModule.TestArray_OpenArrayOfString;
+begin
+  StartProgram(false);
+  Add('procedure DoIt(const a: array of String);');
+  Add('var');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('begin');
+  Add('  for i:=low(a) to high(a) do s:=a[length(a)-i-1];');
+  Add('end;');
+  Add('var s: string;');
+  Add('begin');
+  Add('  DoIt([]);');
+  Add('  DoIt([s,''foo'','''',s+s]);');
+  ConvertProgram;
+  CheckSource('TestArray_OpenArrayOfString',
+    LinesToStr([ // statements
+    'this.DoIt = function (a) {',
+    '  var i = 0;',
+    '  var s = "";',
+    '  var $loopend1 = rtl.length(a) - 1;',
+    '  for (i = 0; i <= $loopend1; i++) s = a[(rtl.length(a) - i) - 1];',
+    '};',
+    'this.s = "";',
+    '']),
+    LinesToStr([
+    '$mod.DoIt([]);',
+    '$mod.DoIt([$mod.s, "foo", "", $mod.s + $mod.s]);',
+    '']));
+end;
+
+procedure TTestModule.TestArray_Concat;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TFlag = (big,small);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TRec = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('  TArrInt = array of integer;');
+  Add('  TArrRec = array of TRec;');
+  Add('  TArrSet = array of TFlags;');
+  Add('  TArrJSValue = array of jsvalue;');
+  Add('var');
+  Add('  ArrInt: tarrint;');
+  Add('  ArrRec: tarrrec;');
+  Add('  ArrSet: tarrset;');
+  Add('  ArrJSValue: tarrjsvalue;');
+  Add('begin');
+  Add('  arrint:=concat(arrint);');
+  Add('  arrint:=concat(arrint,arrint);');
+  Add('  arrint:=concat(arrint,arrint,arrint);');
+  Add('  arrrec:=concat(arrrec);');
+  Add('  arrrec:=concat(arrrec,arrrec);');
+  Add('  arrrec:=concat(arrrec,arrrec,arrrec);');
+  Add('  arrset:=concat(arrset);');
+  Add('  arrset:=concat(arrset,arrset);');
+  Add('  arrset:=concat(arrset,arrset,arrset);');
+  Add('  arrjsvalue:=concat(arrjsvalue);');
+  Add('  arrjsvalue:=concat(arrjsvalue,arrjsvalue);');
+  Add('  arrjsvalue:=concat(arrjsvalue,arrjsvalue,arrjsvalue);');
+  ConvertProgram;
+  CheckSource('TestArray_Concat',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "big",',
+    '  big: 0,',
+    '  "1": "small",',
+    '  small: 1',
+    '};',
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.ArrInt = [];',
+    'this.ArrRec = [];',
+    'this.ArrSet = [];',
+    'this.ArrJSValue = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ArrInt = $mod.ArrInt;',
+    '$mod.ArrInt = $mod.ArrInt.concat($mod.ArrInt);',
+    '$mod.ArrInt = $mod.ArrInt.concat($mod.ArrInt,$mod.ArrInt);',
+    '$mod.ArrRec = $mod.ArrRec;',
+    '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec);',
+    '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec);',
+    '$mod.ArrSet = $mod.ArrSet;',
+    '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet);',
+    '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet);',
+    '$mod.ArrJSValue = $mod.ArrJSValue;',
+    '$mod.ArrJSValue = $mod.ArrJSValue.concat($mod.ArrJSValue);',
+    '$mod.ArrJSValue = $mod.ArrJSValue.concat($mod.ArrJSValue, $mod.ArrJSValue);',
+    '']));
+end;
+
+procedure TTestModule.TestArray_Copy;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TFlag = (big,small);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TRec = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('  TArrInt = array of integer;');
+  Add('  TArrRec = array of TRec;');
+  Add('  TArrSet = array of TFlags;');
+  Add('  TArrJSValue = array of jsvalue;');
+  Add('var');
+  Add('  ArrInt: tarrint;');
+  Add('  ArrRec: tarrrec;');
+  Add('  ArrSet: tarrset;');
+  Add('  ArrJSValue: tarrjsvalue;');
+  Add('begin');
+  Add('  arrint:=copy(arrint);');
+  Add('  arrint:=copy(arrint,2);');
+  Add('  arrint:=copy(arrint,3,4);');
+  Add('  arrrec:=copy(arrrec);');
+  Add('  arrrec:=copy(arrrec,5);');
+  Add('  arrrec:=copy(arrrec,6,7);');
+  Add('  arrset:=copy(arrset);');
+  Add('  arrset:=copy(arrset,8);');
+  Add('  arrset:=copy(arrset,9,10);');
+  Add('  arrjsvalue:=copy(arrjsvalue);');
+  Add('  arrjsvalue:=copy(arrjsvalue,11);');
+  Add('  arrjsvalue:=copy(arrjsvalue,12,13);');
+  ConvertProgram;
+  CheckSource('TestArray_Copy',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "big",',
+    '  big: 0,',
+    '  "1": "small",',
+    '  small: 1',
+    '};',
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.ArrInt = [];',
+    'this.ArrRec = [];',
+    'this.ArrSet = [];',
+    'this.ArrJSValue = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 0);',
+    '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 2);',
+    '$mod.ArrInt = rtl.arrayCopy(0, $mod.ArrInt, 3, 4);',
+    '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 0);',
+    '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 5);',
+    '$mod.ArrRec = rtl.arrayCopy($mod.TRec, $mod.ArrRec, 6, 7);',
+    '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 0);',
+    '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 8);',
+    '$mod.ArrSet = rtl.arrayCopy("refSet", $mod.ArrSet, 9, 10);',
+    '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 0);',
+    '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 11);',
+    '$mod.ArrJSValue = rtl.arrayCopy(0, $mod.ArrJSValue, 12, 13);',
+    '']));
+end;
+
+procedure TTestModule.TestArray_InsertDelete;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TFlag = (big,small);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TRec = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('  TArrInt = array of integer;');
+  Add('  TArrRec = array of TRec;');
+  Add('  TArrSet = array of TFlags;');
+  Add('  TArrJSValue = array of jsvalue;');
+  Add('var');
+  Add('  ArrInt: tarrint;');
+  Add('  ArrRec: tarrrec;');
+  Add('  ArrSet: tarrset;');
+  Add('  ArrJSValue: tarrjsvalue;');
+  Add('begin');
+  Add('  Insert(1,arrint,2);');
+  Add('  Insert(arrint[3],arrint,4);');
+  Add('  Insert(arrrec[5],arrrec,6);');
+  Add('  Insert(arrset[7],arrset,7);');
+  Add('  Insert(arrjsvalue[8],arrjsvalue,9);');
+  Add('  Insert(10,arrjsvalue,11);');
+  Add('  Delete(arrint,12,13);');
+  Add('  Delete(arrrec,14,15);');
+  Add('  Delete(arrset,17,18);');
+  Add('  Delete(arrjsvalue,19,10);');
+  ConvertProgram;
+  CheckSource('TestArray_InsertDelete',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "big",',
+    '  big: 0,',
+    '  "1": "small",',
+    '  small: 1',
+    '};',
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.ArrInt = [];',
+    'this.ArrRec = [];',
+    'this.ArrSet = [];',
+    'this.ArrJSValue = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ArrInt.splice(2, 1, 1);',
+    '$mod.ArrInt.splice(4, 1, $mod.ArrInt[3]);',
+    '$mod.ArrRec.splice(6, 1, $mod.ArrRec[5]);',
+    '$mod.ArrSet.splice(7, 1, $mod.ArrSet[7]);',
+    '$mod.ArrJSValue.splice(9, 1, $mod.ArrJSValue[8]);',
+    '$mod.ArrJSValue.splice(11, 1, 10);',
+    '$mod.ArrInt.splice(12, 13);',
+    '$mod.ArrRec.splice(14, 15);',
+    '$mod.ArrSet.splice(17, 18);',
+    '$mod.ArrJSValue.splice(19, 10);',
+    '']));
+end;
+
+procedure TTestModule.TestArray_DynArrayConst;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TArrInt = array of integer;',
+  '  TArrStr = array of string;',
+  'const',
+  '  Ints: TArrInt = (1,2,3);',
+  '  Names: array of string = (''a'',''foo'');',
+  '  Aliases: TarrStr = (''foo'',''b'');',
+  '  OneInt: TArrInt = (7);',
+  '  OneStr: array of integer = (7);',
+  //'  Chars: array of char = ''aoc'';',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_DynArrayConst',
+    LinesToStr([ // statements
+    'this.Ints = [1, 2, 3];',
+    'this.Names = ["a", "foo"];',
+    'this.Aliases = ["foo", "b"];',
+    'this.OneInt = [7];',
+    'this.OneStr = [7];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_TypeCastArrayToExternalArray;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array''');
+  Add('    class function isArray(Value: JSValue) : boolean;');
+  Add('    function concat() : TJSArray; varargs;');
+  Add('  end;');
+  Add('var');
+  Add('  aObj: TJSArray;');
+  Add('  a: array of longint;');
+  Add('begin');
+  Add('  if TJSArray.isArray(65) then ;');
+  Add('  aObj:=TJSArray(a).concat(a);');
+  ConvertProgram;
+  CheckSource('TestExternalClass_TypeCastArrayToExternalArray',
+    LinesToStr([ // statements
+    'this.aObj = null;',
+    'this.a = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if (Array.isArray(65)) ;',
+    '$mod.aObj = $mod.a.concat($mod.a);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_TypeCastArrayFromExternalArray;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TArrStr = array of string;');
+  Add('  TJSArray = class external name ''Array''');
+  Add('  end;');
+  Add('var');
+  Add('  aObj: TJSArray;');
+  Add('  a: TArrStr;');
+  Add('begin');
+  Add('  a:=TArrStr(aObj);');
+  Add('  TArrStr(aObj)[1]:=TArrStr(aObj)[2];');
+  ConvertProgram;
+  CheckSource('TestExternalClass_TypeCastArrayFromExternalArray',
+    LinesToStr([ // statements
+    'this.aObj = null;',
+    'this.a = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.a = $mod.aObj;',
+    '$mod.aObj[1] = $mod.aObj[2];',
+    '']));
+end;
+
+procedure TTestModule.TestRecord_Var;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRecA = record');
+  Add('    Bold: longint;');
+  Add('  end;');
+  Add('var Rec: TRecA;');
+  Add('begin');
+  Add('  rec.bold:=123');
+  ConvertProgram;
+  CheckSource('TestRecord_Var',
+    LinesToStr([ // statements
+    'this.TRecA = function (s) {',
+    '  if (s) {',
+    '    this.Bold = s.Bold;',
+    '  } else {',
+    '    this.Bold = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.Bold == b.Bold;',
+    '  };',
+    '};',
+    'this.Rec = new $mod.TRecA();'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Rec.Bold = 123;'
+    ]));
+end;
+
+procedure TTestModule.TestWithRecordDo;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record');
+  Add('    vI: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  Int: longint;');
+  Add('  r: TRec;');
+  Add('begin');
+  Add('  with r do');
+  Add('    int:=vi;');
+  Add('  with r do begin');
+  Add('    int:=vi;');
+  Add('    vi:=int;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestWithRecordDo',
+    LinesToStr([ // statements
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.vI = s.vI;',
+    '  } else {',
+    '    this.vI = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.vI == b.vI;',
+    '  };',
+    '};',
+    'this.Int = 0;',
+    'this.r = new $mod.TRec();'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $with1 = $mod.r;',
+    '$mod.Int = $with1.vI;',
+    'var $with2 = $mod.r;',
+    '$mod.Int = $with2.vI;',
+    '$with2.vI = $mod.Int;'
+    ]));
+end;
+
+procedure TTestModule.TestRecord_Assign;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TEnum = (red,green);');
+  Add('  TEnums = set of TEnum;');
+  Add('  TSmallRec = record');
+  Add('    N: longint;');
+  Add('  end;');
+  Add('  TBigRec = record');
+  Add('    Int: longint;');
+  Add('    D: double;');
+  Add('    Arr: array of longint;');
+  Add('    Small: TSmallRec;');
+  Add('    Enums: TEnums;');
+  Add('  end;');
+  Add('var');
+  Add('  r, s: TBigRec;');
+  Add('begin');
+  Add('  r:=s;');
+  ConvertProgram;
+  CheckSource('TestRecord_Assign',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "green",',
+    '  green: 1',
+    '};',
+    'this.TSmallRec = function (s) {',
+    '  if(s){',
+    '    this.N = s.N;',
+    '  } else {',
+    '    this.N = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.N == b.N;',
+    '  };',
+    '};',
+    'this.TBigRec = function (s) {',
+    '  if(s){',
+    '    this.Int = s.Int;',
+    '    this.D = s.D;',
+    '    this.Arr = s.Arr;',
+    '    this.Small = new $mod.TSmallRec(s.Small);',
+    '    this.Enums = rtl.refSet(s.Enums);',
+    '  } else {',
+    '    this.Int = 0;',
+    '    this.D = 0.0;',
+    '    this.Arr = [];',
+    '    this.Small = new $mod.TSmallRec();',
+    '    this.Enums = {};',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return (this.Int == b.Int) && ((this.D == b.D) && ((this.Arr == b.Arr)',
+    ' && (this.Small.$equal(b.Small) && rtl.eqSet(this.Enums, b.Enums))));',
+    '  };',
+    '};',
+    'this.r = new $mod.TBigRec();',
+    'this.s = new $mod.TBigRec();'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.r = new $mod.TBigRec($mod.s);',
+    '']));
+end;
+
+procedure TTestModule.TestRecord_PassAsArgClone;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRecA = record');
+  Add('    Bold: longint;');
+  Add('  end;');
+  Add('procedure DoDefault(r: treca); begin end;');
+  Add('procedure DoConst(const r: treca); begin end;');
+  Add('var Rec: treca;');
+  Add('begin');
+  Add('  dodefault(rec);');
+  Add('  doconst(rec);');
+  ConvertProgram;
+  CheckSource('TestRecord_PassAsArgClone',
+    LinesToStr([ // statements
+    'this.TRecA = function (s) {',
+    '  if (s) {',
+    '    this.Bold = s.Bold;',
+    '  } else {',
+    '    this.Bold = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.Bold == b.Bold;',
+    '  };',
+    '};',
+    'this.DoDefault = function (r) {',
+    '};',
+    'this.DoConst = function (r) {',
+    '};',
+    'this.Rec = new $mod.TRecA();'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.DoDefault(new $mod.TRecA($mod.Rec));',
+    '$mod.DoConst($mod.Rec);',
+    '']));
+end;
+
+procedure TTestModule.TestRecord_AsParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TRecord = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('procedure DoIt(vG: TRecord; const vH: TRecord; var vI: TRecord);');
+  Add('var vJ: TRecord;');
+  Add('begin');
+  Add('  vg:=vg;');
+  Add('  vj:=vh;');
+  Add('  vi:=vi;');
+  Add('  doit(vg,vg,vg);');
+  Add('  doit(vh,vh,vj);');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj,vj,vj);');
+  Add('end;');
+  Add('var i: TRecord;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestRecord_AsParams',
+    LinesToStr([ // statements
+    'this.TRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = new $mod.TRecord();',
+    '  vG = new $mod.TRecord(vG);',
+    '  vJ = new $mod.TRecord(vH);',
+    '  vI.set(new $mod.TRecord(vI.get()));',
+    '  $mod.DoIt(new $mod.TRecord(vG), vG, {',
+    '    get: function () {',
+    '      return vG;',
+    '    },',
+    '    set: function (v) {',
+    '      vG = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(new $mod.TRecord(vH), vH, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(new $mod.TRecord(vI.get()), vI.get(), vI);',
+    '  $mod.DoIt(new $mod.TRecord(vJ), vJ, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.i = new $mod.TRecord();'
+    ]),
+    LinesToStr([
+    '$mod.DoIt(new $mod.TRecord($mod.i),$mod.i,{',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestRecordElement_AsParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TRecord = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
+  Add('var vJ: TRecord;');
+  Add('begin');
+  Add('  doit(vj.i,vj.i,vj.i);');
+  Add('end;');
+  Add('var r: TRecord;');
+  Add('begin');
+  Add('  doit(r.i,r.i,r.i);');
+  ConvertProgram;
+  CheckSource('TestRecordElement_AsParams',
+    LinesToStr([ // statements
+    'this.TRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = new $mod.TRecord();',
+    '  $mod.DoIt(vJ.i, vJ.i, {',
+    '    p: vJ,',
+    '    get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '    set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.r = new $mod.TRecord();'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.r.i,$mod.r.i,{',
+    '  p: $mod.r,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestRecordElementFromFuncResult_AsParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TRecord = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('function GetRec(vB: integer = 0): TRecord;');
+  Add('begin');
+  Add('end;');
+  Add('procedure DoIt(vG: integer; const vH: integer);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  Add('  doit(getrec.i,getrec.i);');
+  Add('  doit(getrec().i,getrec().i);');
+  Add('  doit(getrec(1).i,getrec(2).i);');
+  ConvertProgram;
+  CheckSource('TestRecordElementFromFuncResult_AsParams',
+    LinesToStr([ // statements
+    'this.TRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.GetRec = function (vB) {',
+    '  var Result = new $mod.TRecord();',
+    '  return Result;',
+    '};',
+    'this.DoIt = function (vG,vH) {',
+    '};'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
+    '$mod.DoIt($mod.GetRec(0).i,$mod.GetRec(0).i);',
+    '$mod.DoIt($mod.GetRec(1).i,$mod.GetRec(2).i);',
+    '']));
+end;
+
+procedure TTestModule.TestRecordElementFromWith_AsParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TRecord = record');
+  Add('    i: integer;');
+  Add('  end;');
+  Add('procedure DoIt(vG: integer; const vH: integer; var vI: integer);');
+  Add('begin');
+  Add('end;');
+  Add('var r: trecord;');
+  Add('begin');
+  Add('  with r do ');
+  Add('    doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestRecordElementFromWith_AsParams',
+    LinesToStr([ // statements
+    'this.TRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.DoIt = function (vG,vH,vI) {',
+    '};',
+    'this.r = new $mod.TRecord();'
+    ]),
+    LinesToStr([
+    'var $with1 = $mod.r;',
+    '$mod.DoIt($with1.i,$with1.i,{',
+    '  p: $with1,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestRecord_Equal;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TFlag = (red,blue);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TProc = procedure;');
+  Add('  TRecord = record');
+  Add('    i: integer;');
+  Add('    Event: TProc;');
+  Add('    f: TFlags;');
+  Add('  end;');
+  Add('  TNested = record');
+  Add('    r: TRecord;');
+  Add('  end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  r,s: trecord;');
+  Add('begin');
+  Add('  b:=r=s;');
+  Add('  b:=r<>s;');
+  ConvertProgram;
+  CheckSource('TestRecord_Equal',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1',
+    '};',
+    'this.TRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '    this.Event = s.Event;',
+    '    this.f = rtl.refSet(s.f);',
+    '  } else {',
+    '    this.i = 0;',
+    '    this.Event = null;',
+    '    this.f = {};',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return (this.i == b.i) && (rtl.eqCallback(this.Event, b.Event) && rtl.eqSet(this.f, b.f));',
+    '  };',
+    '};',
+    'this.TNested = function (s) {',
+    '  if (s) {',
+    '    this.r = new $mod.TRecord(s.r);',
+    '  } else {',
+    '    this.r = new $mod.TRecord();',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.r.$equal(b.r);',
+    '  };',
+    '};',
+    'this.b = false;',
+    'this.r = new $mod.TRecord();',
+    'this.s = new $mod.TRecord();'
+    ]),
+    LinesToStr([
+    '$mod.b = $mod.r.$equal($mod.s);',
+    '$mod.b = !$mod.r.$equal($mod.s);',
+    '']));
+end;
+
+procedure TTestModule.TestRecord_TypeCastJSValueToRecord;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRecord = record');
+  Add('    i: longint;');
+  Add('  end;');
+  Add('var');
+  Add('  Jv: jsvalue;');
+  Add('  Rec: trecord;');
+  Add('begin');
+  Add('  rec:=trecord(jv);');
+  ConvertProgram;
+  CheckSource('TestRecord_TypeCastJSValueToRecord',
+    LinesToStr([ // statements
+    'this.TRecord = function (s) {',
+    '  if (s) {',
+    '    this.i = s.i;',
+    '  } else {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.i == b.i;',
+    '  };',
+    '};',
+    'this.Jv = undefined;',
+    'this.Rec = new $mod.TRecord();'
+    ]),
+    LinesToStr([
+    '$mod.Rec = new $mod.TRecord(rtl.getObject($mod.Jv));',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TObjectDefaultConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('    destructor Destroy;');
+  Add('  end;');
+  Add('constructor tobject.create;');
+  Add('begin end;');
+  Add('destructor tobject.destroy;');
+  Add('begin end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tobject.create;');
+  Add('  obj.destroy;');
+  ConvertProgram;
+  CheckSource('TestClass_TObjectDefaultConstructor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function(){',
+    '  };',
+    '  this.Destroy = function(){',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.Obj.$destroy("Destroy");',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TObjectConstructorWithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create(Par: longint);');
+  Add('  end;');
+  Add('constructor tobject.create(par: longint);');
+  Add('begin end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tobject.create(3);');
+  ConvertProgram;
+  CheckSource('TestClass_TObjectConstructorWithParams',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function(Par){',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.TObject.$create("Create",[3]);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Var;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    vI: longint;');
+  Add('    constructor Create(Par: longint);');
+  Add('  end;');
+  Add('constructor tobject.create(par: longint);');
+  Add('begin');
+  Add('  vi:=par+3');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tobject.create(4);');
+  Add('  obj.vi:=obj.VI+5;');
+  ConvertProgram;
+  CheckSource('TestClass_Var',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '    this.vI = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function(Par){',
+    '    this.vI = Par+3;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.TObject.$create("Create",[4]);',
+    '$mod.Obj.vI = $mod.Obj.vI + 5;'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Method;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    vI: longint;');
+  Add('    Sub: TObject;');
+  Add('    constructor Create;');
+  Add('    function GetIt(Par: longint): tobject;');
+  Add('  end;');
+  Add('constructor tobject.create; begin end;');
+  Add('function tobject.getit(par: longint): tobject;');
+  Add('begin');
+  Add('  Self.vi:=par+3;');
+  Add('  Result:=self.sub;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tobject.create;');
+  Add('  obj.getit(4);');
+  Add('  obj.sub.sub:=nil;');
+  Add('  obj.sub.getit(5);');
+  Add('  obj.sub.getit(6).SUB:=nil;');
+  Add('  obj.sub.getit(7).GETIT(8);');
+  Add('  obj.sub.getit(9).SuB.getit(10);');
+  ConvertProgram;
+  CheckSource('TestClass_Method',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '    this.vI = 0;',
+    '    this.Sub = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Sub = undefined;',
+    '  };',
+    '  this.Create = function(){',
+    '  };',
+    '  this.GetIt = function(Par){',
+    '    var Result = null;',
+    '    this.vI = Par + 3;',
+    '    Result = this.Sub;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.Obj.GetIt(4);',
+    '$mod.Obj.Sub.Sub=null;',
+    '$mod.Obj.Sub.GetIt(5);',
+    '$mod.Obj.Sub.GetIt(6).Sub=null;',
+    '$mod.Obj.Sub.GetIt(7).GetIt(8);',
+    '$mod.Obj.Sub.GetIt(9).Sub.GetIt(10);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Implementation;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'implementation',
+  'type',
+  '  TIntClass = class',
+  '    constructor Create; reintroduce;',
+  '    class procedure DoGlob;',
+  '  end;',
+  'constructor tintclass.create;',
+  'begin',
+  '  inherited;',
+  '  inherited create;',
+  '  doglob;',
+  'end;',
+  'class procedure tintclass.doglob;',
+  'begin',
+  'end;',
+  'constructor tobject.create;',
+  'var',
+  '  iC: tintclass;',
+  'begin',
+  '  ic:=tintclass.create;',
+  '  tintclass.doglob;',
+  '  ic.doglob;',
+  'end;',
+  'initialization',
+  '  tintclass.doglob;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestClass_Implementation',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '    var iC = null;',
+    '    iC = $impl.TIntClass.$create("Create$1");',
+    '    $impl.TIntClass.DoGlob();',
+    '    iC.$class.DoGlob();',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$impl.TIntClass.DoGlob();',
+    '']),
+    LinesToStr([
+    'rtl.createClass($impl, "TIntClass", $mod.TObject, function () {',
+    '  this.Create$1 = function () {',
+    '    $mod.TObject.Create.apply(this, arguments);',
+    '    $mod.TObject.Create.call(this);',
+    '    this.$class.DoGlob();',
+    '  };',
+    '  this.DoGlob = function () {',
+    '  };',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestClass_Inheritance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('  end;');
+  Add('  TClassB = class(TObject)');
+  Add('    procedure ProcB;');
+  Add('  end;');
+  Add('constructor tobject.create; begin end;');
+  Add('procedure tclassb.procb; begin end;');
+  Add('var');
+  Add('  oO: TObject;');
+  Add('  oA: TClassA;');
+  Add('  oB: TClassB;');
+  Add('begin');
+  Add('  oO:=tobject.Create;');
+  Add('  oA:=tclassa.Create;');
+  Add('  ob:=tclassb.Create;');
+  Add('  if oo is tclassa then ;');
+  Add('  ob:=oo as tclassb;');
+  Add('  (oo as tclassb).procb;');
+  ConvertProgram;
+  CheckSource('TestClass_Inheritance',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod,"TClassA",$mod.TObject,function(){',
+    '});',
+    'rtl.createClass($mod,"TClassB",$mod.TObject,function(){',
+    '  this.ProcB = function () {',
+    '  };',
+    '});',
+    'this.oO = null;',
+    'this.oA = null;',
+    'this.oB = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.oO = $mod.TObject.$create("Create");',
+    '$mod.oA = $mod.TClassA.$create("Create");',
+    '$mod.oB = $mod.TClassB.$create("Create");',
+    'if ($mod.TClassA.isPrototypeOf($mod.oO));',
+    '$mod.oB = rtl.as($mod.oO, $mod.TClassB);',
+    'rtl.as($mod.oO, $mod.TClassB).ProcB();'
+    ]));
+end;
+
+procedure TTestModule.TestClass_AbstractMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    procedure DoIt; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_AbstractMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestClass_CallInherited_NoParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoAbstract; virtual; abstract;');
+  Add('    procedure DoVirtual; virtual;');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('  TA = class');
+  Add('    procedure doabstract; override;');
+  Add('    procedure dovirtual; override;');
+  Add('    procedure DoSome;');
+  Add('  end;');
+  Add('procedure tobject.dovirtual;');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor -> ignore silently');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('end;');
+  Add('procedure ta.doabstract;');
+  Add('begin');
+  Add('  inherited dovirtual; // call TObject.DoVirtual');
+  Add('end;');
+  Add('procedure ta.dovirtual;');
+  Add('begin');
+  Add('  inherited; // call TObject.DoVirtual');
+  Add('  inherited dovirtual; // call TObject.DoVirtual');
+  Add('  inherited dovirtual(); // call TObject.DoVirtual');
+  Add('  doit;');
+  Add('  doit();');
+  Add('end;');
+  Add('procedure ta.dosome;');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor method -> silently ignore');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_CallInherited_NoParams',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoVirtual = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TA", $mod.TObject, function () {',
+    '  this.DoAbstract = function () {',
+    '    $mod.TObject.DoVirtual.call(this);',
+    '  };',
+    '  this.DoVirtual = function () {',
+    '    $mod.TObject.DoVirtual.apply(this, arguments);',
+    '    $mod.TObject.DoVirtual.call(this);',
+    '    $mod.TObject.DoVirtual.call(this);',
+    '    this.DoIt();',
+    '    this.DoIt();',
+    '  };',
+    '  this.DoSome = function () {',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestClass_CallInherited_WithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoAbstract(pA: longint; pB: longint = 0); virtual; abstract;');
+  Add('    procedure DoVirtual(pA: longint; pB: longint = 0); virtual;');
+  Add('    procedure DoIt(pA: longint; pB: longint = 0);');
+  Add('    procedure DoIt2(pA: longint = 1; pB: longint = 2);');
+  Add('  end;');
+  Add('  TClassA = class');
+  Add('    procedure DoAbstract(pA: longint; pB: longint = 0); override;');
+  Add('    procedure DoVirtual(pA: longint; pB: longint = 0); override;');
+  Add('  end;');
+  Add('procedure tobject.dovirtual(pa: longint; pb: longint = 0);');
+  Add('begin');
+  Add('end;');
+  Add('procedure tobject.doit(pa: longint; pb: longint = 0);');
+  Add('begin');
+  Add('end;');
+  Add('procedure tobject.doit2(pa: longint; pb: longint = 0);');
+  Add('begin');
+  Add('end;');
+  Add('procedure tclassa.doabstract(pa: longint; pb: longint = 0);');
+  Add('begin');
+  Add('  inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)');
+  Add('  inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)');
+  Add('end;');
+  Add('procedure tclassa.dovirtual(pa: longint; pb: longint = 0);');
+  Add('begin');
+  Add('  inherited; // call TObject.DoVirtual(pA,pB)');
+  Add('  inherited dovirtual(pa,pb); // call TObject.DoVirtual(pA,pB)');
+  Add('  inherited dovirtual(pa); // call TObject.DoVirtual(pA,0)');
+  Add('  doit(pa,pb);');
+  Add('  doit(pa);');
+  Add('  doit2(pa);');
+  Add('  doit2;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_CallInherited_WithParams',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoVirtual = function (pA,pB) {',
+    '  };',
+    '  this.DoIt = function (pA,pB) {',
+    '  };',
+    '  this.DoIt2 = function (pA,pB) {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TClassA", $mod.TObject, function () {',
+    '  this.DoAbstract = function (pA,pB) {',
+    '    $mod.TObject.DoVirtual.call(this,pA,pB);',
+    '    $mod.TObject.DoVirtual.call(this,pA,0);',
+    '  };',
+    '  this.DoVirtual = function (pA,pB) {',
+    '    $mod.TObject.DoVirtual.apply(this, arguments);',
+    '    $mod.TObject.DoVirtual.call(this,pA,pB);',
+    '    $mod.TObject.DoVirtual.call(this,pA,0);',
+    '    this.DoIt(pA,pB);',
+    '    this.DoIt(pA,0);',
+    '    this.DoIt2(pA,2);',
+    '    this.DoIt2(1,2);',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestClasS_CallInheritedConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create; virtual;');
+  Add('    constructor CreateWithB(b: boolean);');
+  Add('  end;');
+  Add('  TA = class');
+  Add('    constructor Create; override;');
+  Add('    constructor CreateWithC(c: char);');
+  Add('    procedure DoIt;');
+  Add('    class function DoSome: TObject;');
+  Add('  end;');
+  Add('constructor tobject.create;');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor -> ignore silently');
+  Add('end;');
+  Add('constructor tobject.createwithb(b: boolean);');
+  Add('begin');
+  Add('  inherited; // call non existing ancestor -> ignore silently');
+  Add('  create; // normal call');
+  Add('end;');
+  Add('constructor ta.create;');
+  Add('begin');
+  Add('  inherited; // normal call TObject.Create');
+  Add('  inherited create; // normal call TObject.Create');
+  Add('  inherited createwithb(false); // normal call TObject.CreateWithB');
+  Add('end;');
+  Add('constructor ta.createwithc(c: char);');
+  Add('begin');
+  Add('  inherited create; // call TObject.Create');
+  Add('  inherited createwithb(true); // call TObject.CreateWithB');
+  Add('  doit;');
+  Add('  doit();');
+  Add('  dosome;');
+  Add('end;');
+  Add('procedure ta.doit;');
+  Add('begin');
+  Add('  create; // normal call');
+  Add('  createwithb(false); // normal call');
+  Add('  createwithc(''c''); // normal call');
+  Add('end;');
+  Add('class function ta.dosome: TObject;');
+  Add('begin');
+  Add('  Result:=create; // constructor');
+  Add('  Result:=createwithb(true); // constructor');
+  Add('  Result:=createwithc(''c''); // constructor');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_CallInheritedConstructor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.CreateWithB = function (b) {',
+    '    this.Create();',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TA", $mod.TObject, function () {',
+    '  this.Create = function () {',
+    '    $mod.TObject.Create.apply(this, arguments);',
+    '    $mod.TObject.Create.call(this);',
+    '    $mod.TObject.CreateWithB.call(this, false);',
+    '  };',
+    '  this.CreateWithC = function (c) {',
+    '    $mod.TObject.Create.call(this);',
+    '    $mod.TObject.CreateWithB.call(this, true);',
+    '    this.DoIt();',
+    '    this.DoIt();',
+    '    this.$class.DoSome();',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.Create();',
+    '    this.CreateWithB(false);',
+    '    this.CreateWithC("c");',
+    '  };',
+    '  this.DoSome = function () {',
+    '    var Result = null;',
+    '    Result = this.$create("Create");',
+    '    Result = this.$create("CreateWithB", [true]);',
+    '    Result = this.$create("CreateWithC", ["c"]);',
+    '    return Result;',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // this.$main
+    ''
+    ]));
+end;
+
+procedure TTestModule.TestClass_ClassVar;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    class var vI: longint;');
+  Add('    class var Sub: TObject;');
+  Add('    constructor Create;');
+  Add('    class function GetIt(Par: longint): tobject;');
+  Add('  end;');
+  Add('constructor tobject.create;');
+  Add('begin');
+  Add('  vi:=vi+1;');
+  Add('  Self.vi:=Self.vi+1;');
+  Add('end;');
+  Add('class function tobject.getit(par: longint): tobject;');
+  Add('begin');
+  Add('  vi:=vi+par;');
+  Add('  Self.vi:=Self.vi+par;');
+  Add('  Result:=self.sub;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tobject.create;');
+  Add('  tobject.vi:=3;');
+  Add('  if tobject.vi=4 then ;');
+  Add('  tobject.sub:=nil;');
+  Add('  obj.sub:=nil;');
+  Add('  obj.sub.sub:=nil;');
+  ConvertProgram;
+  CheckSource('TestClass_ClassVar',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.vI = 0;',
+    '  this.Sub = null;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function(){',
+    '    this.$class.vI = this.vI+1;',
+    '    this.$class.vI = this.vI+1;',
+    '  };',
+    '  this.GetIt = function(Par){',
+    '    var Result = null;',
+    '    this.vI = this.vI + Par;',
+    '    this.vI = this.vI + Par;',
+    '    Result = this.Sub;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.TObject.vI = 3;',
+    'if ($mod.TObject.vI == 4);',
+    '$mod.TObject.Sub=null;',
+    '$mod.Obj.$class.Sub=null;',
+    '$mod.Obj.Sub.$class.Sub=null;',
+    '']));
+end;
+
+procedure TTestModule.TestClass_CallClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    class var vI: longint;');
+  Add('    class var Sub: TObject;');
+  Add('    constructor Create;');
+  Add('    function GetMore(Par: longint): longint;');
+  Add('    class function GetIt(Par: longint): tobject;');
+  Add('  end;');
+  Add('constructor tobject.create;');
+  Add('begin');
+  Add('  sub:=getit(3);');
+  Add('  vi:=getmore(4);');
+  Add('  sub:=Self.getit(5);');
+  Add('  vi:=Self.getmore(6);');
+  Add('end;');
+  Add('function tobject.getmore(par: longint): longint;');
+  Add('begin');
+  Add('  sub:=getit(11);');
+  Add('  vi:=getmore(12);');
+  Add('  sub:=self.getit(13);');
+  Add('  vi:=self.getmore(14);');
+  Add('end;');
+  Add('class function tobject.getit(par: longint): tobject;');
+  Add('begin');
+  Add('  sub:=getit(21);');
+  Add('  vi:=sub.getmore(22);');
+  Add('  sub:=self.getit(23);');
+  Add('  vi:=self.sub.getmore(24);');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tobject.create;');
+  Add('  tobject.getit(5);');
+  Add('  obj.getit(6);');
+  Add('  obj.sub.getit(7);');
+  Add('  obj.sub.getit(8).SUB:=nil;');
+  Add('  obj.sub.getit(9).GETIT(10);');
+  Add('  obj.sub.getit(11).SuB.getit(12);');
+  ConvertProgram;
+  CheckSource('TestClass_CallClassMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.vI = 0;',
+    '  this.Sub = null;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function(){',
+    '    this.$class.Sub = this.$class.GetIt(3);',
+    '    this.$class.vI = this.GetMore(4);',
+    '    this.$class.Sub = this.$class.GetIt(5);',
+    '    this.$class.vI = this.GetMore(6);',
+    '  };',
+    '  this.GetMore = function(Par){',
+    '    var Result = 0;',
+    '    this.$class.Sub = this.$class.GetIt(11);',
+    '    this.$class.vI = this.GetMore(12);',
+    '    this.$class.Sub = this.$class.GetIt(13);',
+    '    this.$class.vI = this.GetMore(14);',
+    '    return Result;',
+    '  };',
+    '  this.GetIt = function(Par){',
+    '    var Result = null;',
+    '    this.Sub = this.GetIt(21);',
+    '    this.vI = this.Sub.GetMore(22);',
+    '    this.Sub = this.GetIt(23);',
+    '    this.vI = this.Sub.GetMore(24);',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.TObject.GetIt(5);',
+    '$mod.Obj.$class.GetIt(6);',
+    '$mod.Obj.Sub.$class.GetIt(7);',
+    '$mod.Obj.Sub.$class.GetIt(8).$class.Sub=null;',
+    '$mod.Obj.Sub.$class.GetIt(9).$class.GetIt(10);',
+    '$mod.Obj.Sub.$class.GetIt(11).Sub.$class.GetIt(12);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_Property;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    Fx: longint;');
+  Add('    Fy: longint;');
+  Add('    function GetInt: longint;');
+  Add('    procedure SetInt(Value: longint);');
+  Add('    procedure DoIt;');
+  Add('    property IntA: longint read Fx write Fy;');
+  Add('    property IntB: longint read GetInt write SetInt;');
+  Add('  end;');
+  Add('function tobject.getint: longint;');
+  Add('begin');
+  Add('  result:=fx;');
+  Add('end;');
+  Add('procedure tobject.setint(value: longint);');
+  Add('begin');
+  Add('  if value=fy then exit;');
+  Add('  fy:=value;');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  IntA:=IntA+1;');
+  Add('  Self.IntA:=Self.IntA+1;');
+  Add('  IntB:=IntB+1;');
+  Add('  Self.IntB:=Self.IntB+1;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.inta:=obj.inta+1;');
+  Add('  if obj.intb=2 then;');
+  Add('  obj.intb:=obj.intb+2;');
+  Add('  obj.setint(obj.inta);');
+  ConvertProgram;
+  CheckSource('TestClass_Property',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Fx = 0;',
+    '    this.Fy = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetInt = function () {',
+    '    var Result = 0;',
+    '    Result = this.Fx;',
+    '    return Result;',
+    '  };',
+    '  this.SetInt = function (Value) {',
+    '    if (Value == this.Fy) return;',
+    '    this.Fy = Value;',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.Fy = this.Fx + 1;',
+    '    this.Fy = this.Fx + 1;',
+    '    this.SetInt(this.GetInt() + 1);',
+    '    this.SetInt(this.GetInt() + 1);',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.Fy = $mod.Obj.Fx + 1;',
+    'if ($mod.Obj.GetInt() == 2);',
+    '$mod.Obj.SetInt($mod.Obj.GetInt() + 2);',
+    '$mod.Obj.SetInt($mod.Obj.Fx);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Property_ClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var Fx: longint;');
+  Add('    class var Fy: longint;');
+  Add('    class function GetInt: longint;');
+  Add('    class procedure SetInt(Value: longint);');
+  Add('    class procedure DoIt;');
+  Add('    class property IntA: longint read Fx write Fy;');
+  Add('    class property IntB: longint read GetInt write SetInt;');
+  Add('  end;');
+  Add('class function tobject.getint: longint;');
+  Add('begin');
+  Add('  result:=fx;');
+  Add('end;');
+  Add('class procedure tobject.setint(value: longint);');
+  Add('begin');
+  Add('end;');
+  Add('class procedure tobject.doit;');
+  Add('begin');
+  Add('  IntA:=IntA+1;');
+  Add('  Self.IntA:=Self.IntA+1;');
+  Add('  IntB:=IntB+1;');
+  Add('  Self.IntB:=Self.IntB+1;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  tobject.inta:=tobject.inta+1;');
+  Add('  if tobject.intb=2 then;');
+  Add('  tobject.intb:=tobject.intb+2;');
+  Add('  tobject.setint(tobject.inta);');
+  Add('  obj.inta:=obj.inta+1;');
+  Add('  if obj.intb=2 then;');
+  Add('  obj.intb:=obj.intb+2;');
+  Add('  obj.setint(obj.inta);');
+  ConvertProgram;
+  CheckSource('TestClass_Property_ClassMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.Fx = 0;',
+    '  this.Fy = 0;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetInt = function () {',
+    '    var Result = 0;',
+    '    Result = this.Fx;',
+    '    return Result;',
+    '  };',
+    '  this.SetInt = function (Value) {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.Fy = this.Fx + 1;',
+    '    this.Fy = this.Fx + 1;',
+    '    this.SetInt(this.GetInt() + 1);',
+    '    this.SetInt(this.GetInt() + 1);',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.TObject.Fy = $mod.TObject.Fx + 1;',
+    'if ($mod.TObject.GetInt() == 2);',
+    '$mod.TObject.SetInt($mod.TObject.GetInt() + 2);',
+    '$mod.TObject.SetInt($mod.TObject.Fx);',
+    '$mod.Obj.$class.Fy = $mod.Obj.Fx + 1;',
+    'if ($mod.Obj.$class.GetInt() == 2);',
+    '$mod.Obj.$class.SetInt($mod.Obj.$class.GetInt() + 2);',
+    '$mod.Obj.$class.SetInt($mod.Obj.Fx);'
+    ]));
+end;
+
+procedure TTestModule.TestClass_Property_Index;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FItems: array of longint;');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index: longint; Value: longint);');
+  Add('    procedure DoIt;');
+  Add('    property Items[Index: longint]: longint read getitems write setitems;');
+  Add('  end;');
+  Add('function tobject.getitems(index: longint): longint;');
+  Add('begin');
+  Add('  Result:=fitems[index];');
+  Add('end;');
+  Add('procedure tobject.setitems(index: longint; value: longint);');
+  Add('begin');
+  Add('  fitems[index]:=value;');
+  Add('end;');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  items[1]:=2;');
+  Add('  items[3]:=items[4];');
+  Add('  self.items[5]:=self.items[6];');
+  Add('  items[items[7]]:=items[items[8]];');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.Items[11]:=obj.Items[12];');
+  ConvertProgram;
+  CheckSource('TestClass_Property_Index',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItems = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FItems = undefined;',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    Result = this.FItems[Index];',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '    this.FItems[Index] = Value;',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.SetItems(1, 2);',
+    '    this.SetItems(3,this.GetItems(4));',
+    '    this.SetItems(5,this.GetItems(6));',
+    '    this.SetItems(this.GetItems(7), this.GetItems(this.GetItems(8)));',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.SetItems(11,$mod.Obj.GetItems(12));'
+    ]));
+end;
+
+procedure TTestModule.TestClass_PropertyOfTypeArray;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArray = array of longint;');
+  Add('  TObject = class');
+  Add('    FItems: TArray;');
+  Add('    function GetItems: tarray;');
+  Add('    procedure SetItems(Value: tarray);');
+  Add('    property Items: tarray read getitems write setitems;');
+  Add('  end;');
+  Add('function tobject.getitems: tarray;');
+  Add('begin');
+  Add('  Result:=fitems;');
+  Add('end;');
+  Add('procedure tobject.setitems(value: tarray);');
+  Add('begin');
+  Add('  fitems:=value;');
+  Add('  fitems:=nil;');
+  Add('  Items:=nil;');
+  Add('  Items:=Items;');
+  Add('  Items[1]:=2;');
+  Add('  fitems[3]:=Items[4];');
+  Add('  Items[5]:=Items[6];');
+  Add('  Self.Items[7]:=8;');
+  Add('  Self.Items[9]:=Self.Items[10];');
+  Add('  Items[Items[11]]:=Items[Items[12]];');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj.items:=nil;');
+  Add('  obj.items:=obj.items;');
+  Add('  obj.items[11]:=obj.items[12];');
+  ConvertProgram;
+  CheckSource('TestClass_PropertyOfTypeArray',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItems = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FItems = undefined;',
+    '  };',
+    '  this.GetItems = function () {',
+    '    var Result = [];',
+    '    Result = this.FItems;',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Value) {',
+    '    this.FItems = Value;',
+    '    this.FItems = [];',
+    '    this.SetItems([]);',
+    '    this.SetItems(this.GetItems());',
+    '    this.GetItems()[1] = 2;',
+    '    this.FItems[3] = this.GetItems()[4];',
+    '    this.GetItems()[5] = this.GetItems()[6];',
+    '    this.GetItems()[7] = 8;',
+    '    this.GetItems()[9] = this.GetItems()[10];',
+    '    this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.SetItems([]);',
+    '$mod.Obj.SetItems($mod.Obj.GetItems());',
+    '$mod.Obj.GetItems()[11] = $mod.Obj.GetItems()[12];'
+    ]));
+end;
+
+procedure TTestModule.TestClass_PropertyDefault;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArray = array of longint;');
+  Add('  TObject = class');
+  Add('    FItems: TArray;');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index, Value: longint);');
+  Add('    property Items[Index: longint]: longint read getitems write setitems; default;');
+  Add('  end;');
+  Add('function tobject.getitems(index: longint): longint;');
+  Add('begin');
+  Add('end;');
+  Add('procedure tobject.setitems(index, value: longint);');
+  Add('begin');
+  Add('  Self[1]:=2;');
+  Add('  Self[3]:=Self[index];');
+  Add('  Self[index]:=Self[Self[value]];');
+  Add('  Self[Self[4]]:=value;');
+  Add('end;');
+  Add('var Obj: tobject;');
+  Add('begin');
+  Add('  obj[11]:=12;');
+  Add('  obj[13]:=obj[14];');
+  Add('  obj[obj[15]]:=obj[obj[15]];');
+  ConvertProgram;
+  CheckSource('TestClass_PropertyDefault',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItems = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FItems = undefined;',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '    this.SetItems(1, 2);',
+    '    this.SetItems(3, this.GetItems(Index));',
+    '    this.SetItems(Index, this.GetItems(this.GetItems(Value)));',
+    '    this.SetItems(this.GetItems(4), Value);',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.SetItems(11, 12);',
+    '$mod.Obj.SetItems(13, $mod.Obj.GetItems(14));',
+    '$mod.Obj.SetItems($mod.Obj.GetItems(15), $mod.Obj.GetItems($mod.Obj.GetItems(15)));'
+    ]));
+end;
+
+procedure TTestModule.TestClass_PropertyOverride;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TObject = class');
+  Add('    FItem: integer;');
+  Add('    function GetItem: integer; external name ''GetItem'';');
+  Add('    procedure SetItem(Value: integer); external name ''SetItem'';');
+  Add('    property Item: integer read getitem write setitem;');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('    FBag: integer;');
+  Add('    function GetBag: integer; external name ''GetBag'';');
+  Add('    property Item read getbag;');
+  Add('  end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  Car: tcar;');
+  Add('begin');
+  Add('  Obj.Item:=Obj.Item;');
+  Add('  Car.Item:=Car.Item;');
+  ConvertProgram;
+  CheckSource('TestClass_PropertyOverride',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FItem = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FBag = 0;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.Car = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.SetItem($mod.Obj.GetItem());',
+    '$mod.Car.SetItem($mod.Car.GetBag());',
+    '']));
+end;
+
+procedure TTestModule.TestClass_Assigned;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  if Assigned(obj) then ;');
+  Add('  b:=Assigned(obj) or false;');
+  ConvertProgram;
+  CheckSource('TestClass_Assigned',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'if ($mod.Obj != null);',
+    '$mod.b = ($mod.Obj != null) || false;'
+    ]));
+end;
+
+procedure TTestModule.TestClass_WithClassDoCreate;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    aBool: boolean;');
+  Add('    Arr: array of boolean;');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  with tobject.create do begin');
+  Add('    b:=abool;');
+  Add('    abool:=b;');
+  Add('    b:=arr[1];');
+  Add('    arr[2]:=b;');
+  Add('  end;');
+  Add('  with tobject do');
+  Add('    obj:=create;');
+  Add('  with obj do begin');
+  Add('    create;');
+  Add('    b:=abool;');
+  Add('    abool:=b;');
+  Add('    b:=arr[3];');
+  Add('    arr[4]:=b;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassDoCreate',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.aBool = false;',
+    '    this.Arr = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Arr = undefined;',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $with1 = $mod.TObject.$create("Create");',
+    '$mod.b = $with1.aBool;',
+    '$with1.aBool = $mod.b;',
+    '$mod.b = $with1.Arr[1];',
+    '$with1.Arr[2] = $mod.b;',
+    'var $with2 = $mod.TObject;',
+    '$mod.Obj = $with2.$create("Create");',
+    'var $with3 = $mod.Obj;',
+    '$with3.Create();',
+    '$mod.b = $with3.aBool;',
+    '$with3.aBool = $mod.b;',
+    '$mod.b = $with3.Arr[3];',
+    '$with3.Arr[4] = $mod.b;',
+    '']));
+end;
+
+procedure TTestModule.TestClass_WithClassInstDoProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FInt: longint;');
+  Add('    constructor Create;');
+  Add('    function GetSize: longint;');
+  Add('    procedure SetSize(Value: longint);');
+  Add('    property Int: longint read FInt write FInt;');
+  Add('    property Size: longint read GetSize write SetSize;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetSize: longint; begin; end;');
+  Add('procedure TObject.SetSize(Value: longint); begin; end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    i:=int;');
+  Add('    int:=i;');
+  Add('    i:=size;');
+  Add('    size:=i;');
+  Add('  end;');
+  Add('  with obj do begin');
+  Add('    i:=int;');
+  Add('    int:=i;');
+  Add('    i:=size;');
+  Add('    size:=i;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassInstDoProperty',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FInt = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.GetSize = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetSize = function (Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $with1 = $mod.TObject.$create("Create");',
+    '$mod.i = $with1.FInt;',
+    '$with1.FInt = $mod.i;',
+    '$mod.i = $with1.GetSize();',
+    '$with1.SetSize($mod.i);',
+    'var $with2 = $mod.Obj;',
+    '$mod.i = $with2.FInt;',
+    '$with2.FInt = $mod.i;',
+    '$mod.i = $with2.GetSize();',
+    '$with2.SetSize($mod.i);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_WithClassInstDoPropertyWithParams;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    function GetItems(Index: longint): longint;');
+  Add('    procedure SetItems(Index, Value: longint);');
+  Add('    property Items[Index: longint]: longint read GetItems write SetItems;');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function tobject.getitems(index: longint): longint; begin; end;');
+  Add('procedure tobject.setitems(index, value: longint); begin; end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    i:=Items[1];');
+  Add('    Items[2]:=i;');
+  Add('  end;');
+  Add('  with obj do begin');
+  Add('    i:=Items[3];');
+  Add('    Items[4]:=i;');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassInstDoPropertyWithParams',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $with1 = $mod.TObject.$create("Create");',
+    '$mod.i = $with1.GetItems(1);',
+    '$with1.SetItems(2, $mod.i);',
+    'var $with2 = $mod.Obj;',
+    '$mod.i = $with2.GetItems(3);',
+    '$with2.SetItems(4, $mod.i);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_WithClassInstDoFunc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('    function GetSize: longint;');
+  Add('    procedure SetSize(Value: longint);');
+  Add('  end;');
+  Add('constructor TObject.Create; begin end;');
+  Add('function TObject.GetSize: longint; begin; end;');
+  Add('procedure TObject.SetSize(Value: longint); begin; end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  with TObject.Create do begin');
+  Add('    i:=GetSize;');
+  Add('    i:=GetSize();');
+  Add('    SetSize(i);');
+  Add('  end;');
+  Add('  with obj do begin');
+  Add('    i:=GetSize;');
+  Add('    i:=GetSize();');
+  Add('    SetSize(i);');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestClass_WithClassInstDoFunc',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.GetSize = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetSize = function (Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.i = 0;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $with1 = $mod.TObject.$create("Create");',
+    '$mod.i = $with1.GetSize();',
+    '$mod.i = $with1.GetSize();',
+    '$with1.SetSize($mod.i);',
+    'var $with2 = $mod.Obj;',
+    '$mod.i = $with2.GetSize();',
+    '$mod.i = $with2.GetSize();',
+    '$with2.SetSize($mod.i);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    Next: TObject;');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('  TControl = class(TObject)');
+  Add('    Arr: array of TObject;');
+  Add('    function GetIt(vI: longint = 0): TObject;');
+  Add('  end;');
+  Add('constructor tobject.create; begin end;');
+  Add('function tcontrol.getit(vi: longint = 0): tobject; begin end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('begin');
+  Add('  obj:=tcontrol(obj).next;');
+  Add('  tcontrol(obj):=nil;');
+  Add('  obj:=tcontrol(obj);');
+  Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit);');
+  Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
+  Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
+  Add('  tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
+  ConvertProgram;
+  CheckSource('TestClass_TypeCast',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Next = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Next = undefined;',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TControl", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.Arr = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Arr = undefined;',
+    '    $mod.TObject.$final.call(this);',
+    '  };',
+    '  this.GetIt = function (vI) {',
+    '    var Result = null;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.Obj.Next;',
+    '$mod.Obj = null;',
+    '$mod.Obj = $mod.Obj;',
+    '$mod.Obj = $mod.Obj.GetIt(0);',
+    '$mod.Obj = $mod.Obj.GetIt(0);',
+    '$mod.Obj = $mod.Obj.GetIt(1);',
+    '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TypeCastUntypedParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('procedure ProcA(var A);');
+  Add('begin');
+  Add('  TObject(A):=nil;');
+  Add('  TObject(A):=TObject(A);');
+  Add('  if TObject(A)=nil then ;');
+  Add('  if nil=TObject(A) then ;');
+  Add('end;');
+  Add('procedure ProcB(out A);');
+  Add('begin');
+  Add('  TObject(A):=nil;');
+  Add('  TObject(A):=TObject(A);');
+  Add('  if TObject(A)=nil then ;');
+  Add('  if nil=TObject(A) then ;');
+  Add('end;');
+  Add('procedure ProcC(const A);');
+  Add('begin');
+  Add('  if TObject(A)=nil then ;');
+  Add('  if nil=TObject(A) then ;');
+  Add('end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  ProcA(o);');
+  Add('  ProcB(o);');
+  Add('  ProcC(o);');
+  ConvertProgram;
+  CheckSource('TestClass_TypeCastUntypedParam',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.ProcA = function (A) {',
+    '  A.set(null);',
+    '  A.set(A.get());',
+    '  if (A.get() == null);',
+    '  if (null == A.get());',
+    '};',
+    'this.ProcB = function (A) {',
+    '  A.set(null);',
+    '  A.set(A.get());',
+    '  if (A.get() == null);',
+    '  if (null == A.get());',
+    '};',
+    'this.ProcC = function (A) {',
+    '  if (A == null);',
+    '  if (null == A);',
+    '};',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ProcA({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.o;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.o = v;',
+    '    }',
+    '});',
+    '$mod.ProcB({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.o;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.o = v;',
+    '    }',
+    '});',
+    '$mod.ProcC($mod.o);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_Overloads;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt;');
+  Add('    procedure DoIt(vI: longint);');
+  Add('  end;');
+  Add('procedure TObject.DoIt;');
+  Add('begin');
+  Add('  DoIt;');
+  Add('  DoIt(1);');
+  Add('end;');
+  Add('procedure TObject.DoIt(vI: longint); begin end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_Overloads',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.DoIt();',
+    '    this.DoIt$1(1);',
+    '  };',
+    '  this.DoIt$1 = function (vI) {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClass_OverloadsAncestor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class;');
+  Add('  TObject = class');
+  Add('    procedure DoIt(vA: longint);');
+  Add('    procedure DoIt(vA, vB: longint);');
+  Add('  end;');
+  Add('  TCar = class;');
+  Add('  TCar = class');
+  Add('    procedure DoIt(vA: longint);');
+  Add('    procedure DoIt(vA, vB: longint);');
+  Add('  end;');
+  Add('procedure tobject.doit(va: longint);');
+  Add('begin');
+  Add('  doit(1);');
+  Add('  doit(1,2);');
+  Add('end;');
+  Add('procedure tobject.doit(va, vb: longint); begin end;');
+  Add('procedure tcar.doit(va: longint);');
+  Add('begin');
+  Add('  doit(1);');
+  Add('  doit(1,2);');
+  Add('  inherited doit(1);');
+  Add('  inherited doit(1,2);');
+  Add('end;');
+  Add('procedure tcar.doit(va, vb: longint); begin end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_OverloadsAncestor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (vA) {',
+    '    this.DoIt(1);',
+    '    this.DoIt$1(1,2);',
+    '  };',
+    '  this.DoIt$1 = function (vA, vB) {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
+    '  this.DoIt$2 = function (vA) {',
+    '    this.DoIt$2(1);',
+    '    this.DoIt$3(1, 2);',
+    '    $mod.TObject.DoIt.call(this, 1);',
+    '    $mod.TObject.DoIt$1.call(this, 1, 2);',
+    '  };',
+    '  this.DoIt$3 = function (vA, vB) {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClass_OverloadConstructor;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create(vA: longint);');
+  Add('    constructor Create(vA, vB: longint);');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('    constructor Create(vA: longint);');
+  Add('    constructor Create(vA, vB: longint);');
+  Add('  end;');
+  Add('constructor tobject.create(va: longint);');
+  Add('begin');
+  Add('  create(1);');
+  Add('  create(1,2);');
+  Add('end;');
+  Add('constructor tobject.create(va, vb: longint); begin end;');
+  Add('constructor tcar.create(va: longint);');
+  Add('begin');
+  Add('  create(1);');
+  Add('  create(1,2);');
+  Add('  inherited create(1);');
+  Add('  inherited create(1,2);');
+  Add('end;');
+  Add('constructor tcar.create(va, vb: longint); begin end;');
+  Add('begin');
+  Add('  tobject.create(1);');
+  Add('  tobject.create(1,2);');
+  Add('  tcar.create(1);');
+  Add('  tcar.create(1,2);');
+  ConvertProgram;
+  CheckSource('TestClass_OverloadConstructor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function (vA) {',
+    '    this.Create(1);',
+    '    this.Create$1(1,2);',
+    '  };',
+    '  this.Create$1 = function (vA, vB) {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
+    '  this.Create$2 = function (vA) {',
+    '    this.Create$2(1);',
+    '    this.Create$3(1, 2);',
+    '    $mod.TObject.Create.call(this, 1);',
+    '    $mod.TObject.Create$1.call(this, 1, 2);',
+    '  };',
+    '  this.Create$3 = function (vA, vB) {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TObject.$create("Create", [1]);',
+    '$mod.TObject.$create("Create$1", [1, 2]);',
+    '$mod.TCar.$create("Create$2", [1]);',
+    '$mod.TCar.$create("Create$3", [1, 2]);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_ReintroducedVar;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  strict private');
+  Add('    Some: longint;');
+  Add('  end;');
+  Add('  TMobile = class');
+  Add('  strict private');
+  Add('    Some: string;');
+  Add('  end;');
+  Add('  TCar = class(tmobile)');
+  Add('    procedure Some;');
+  Add('    procedure Some(vA: longint);');
+  Add('  end;');
+  Add('procedure tcar.some;');
+  Add('begin');
+  Add('  Some;');
+  Add('  Some(1);');
+  Add('end;');
+  Add('procedure tcar.some(va: longint); begin end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClass_ReintroducedVar',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Some = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.Some$1 = "";',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
+    '  this.Some$2 = function () {',
+    '    this.Some$2();',
+    '    this.Some$3(1);',
+    '  };',
+    '  this.Some$3 = function (vA) {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClass_RaiseDescendant;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create(Msg: string);');
+  Add('  end;');
+  Add('  Exception = class');
+  Add('  end;');
+  Add('  EConvertError = class(Exception)');
+  Add('  end;');
+  Add('constructor TObject.Create(Msg: string); begin end;');
+  Add('begin');
+  Add('  raise Exception.Create(''Bar1'');');
+  Add('  raise EConvertError.Create(''Bar2'');');
+  ConvertProgram;
+  CheckSource('TestClass_RaiseDescendant',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function (Msg) {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "Exception", $mod.TObject, function () {',
+    '});',
+    'rtl.createClass($mod, "EConvertError", $mod.Exception, function () {',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    'throw $mod.Exception.$create("Create",["Bar1"]);',
+    'throw $mod.EConvertError.$create("Create",["Bar2"]);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_ExternalMethod;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    procedure Intern; external name ''$DoIntern'';',
+    '  end;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('type');
+  Add('  TCar = class(TObject)');
+  Add('  public');
+  Add('    procedure Intern2; external name ''$DoIntern2'';');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('implementation');
+  Add('procedure tcar.doit;');
+  Add('begin');
+  Add('  Intern;');
+  Add('  Intern();');
+  Add('  Intern2;');
+  Add('  Intern2();');
+  Add('end;');
+  Add('var Obj: TCar;');
+  Add('begin');
+  Add('  obj.intern;');
+  Add('  obj.intern();');
+  Add('  obj.intern2;');
+  Add('  obj.intern2();');
+  Add('  obj.doit;');
+  Add('  obj.doit();');
+  Add('  with obj do begin');
+  Add('    Intern;');
+  Add('    Intern();');
+  Add('    Intern2;');
+  Add('    Intern2();');
+  Add('  end;');
+  ConvertUnit;
+  CheckSource('TestClass_ExternalMethod',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
+    '    this.DoIt = function () {',
+    '      this.$DoIntern();',
+    '      this.$DoIntern();',
+    '      this.$DoIntern2();',
+    '      this.$DoIntern2();',
+    '    };',
+    '  });',
+    '']),
+    LinesToStr([ // this.$init
+    '$impl.Obj.$DoIntern();',
+    '$impl.Obj.$DoIntern();',
+    '$impl.Obj.$DoIntern2();',
+    '$impl.Obj.$DoIntern2();',
+    '$impl.Obj.DoIt();',
+    '$impl.Obj.DoIt();',
+    'var $with1 = $impl.Obj;',
+    '$with1.$DoIntern();',
+    '$with1.$DoIntern();',
+    '$with1.$DoIntern2();',
+    '$with1.$DoIntern2();',
+    '']),
+    LinesToStr([ // implementation
+    '$impl.Obj = null;',
+    '']) );
+end;
+
+procedure TTestModule.TestClass_ExternalVirtualNameMismatchFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt; virtual; external name ''Foo'';');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError('Virtual method name must match external',
+    nVirtualMethodNameMustMatchExternal);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestClass_ExternalOverrideFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt; virtual; external name ''DoIt'';');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('    procedure DoIt; override; external name ''DoIt'';');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError('Invalid procedure modifier override,external',
+    nInvalidXModifierY);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestClass_ExternalVar;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    '{$modeswitch externalclass}',
+    'type',
+    '  TObject = class',
+    '  public',
+    '    Intern: longint external name ''$Intern'';',
+    '  end;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TCar = class(tobject)');
+  Add('  public');
+  Add('    Intern2: longint external name ''$Intern2'';');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('implementation');
+  Add('procedure tcar.doit;');
+  Add('begin');
+  Add('  Intern:=Intern+1;');
+  Add('  Intern2:=Intern2+2;');
+  Add('end;');
+  Add('var Obj: TCar;');
+  Add('begin');
+  Add('  obj.intern:=obj.intern+1;');
+  Add('  obj.intern2:=obj.intern2+2;');
+  Add('  with obj do begin');
+  Add('    intern:=intern+1;');
+  Add('    intern2:=intern2+2;');
+  Add('  end;');
+  ConvertUnit;
+  CheckSource('TestClass_ExternalVar',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'rtl.createClass($mod, "TCar", pas.unit2.TObject, function () {',
+    '    this.DoIt = function () {',
+    '      this.$Intern = this.$Intern + 1;',
+    '      this.$Intern2 = this.$Intern2 + 2;',
+    '    };',
+    '  });',
+    '']),
+    LinesToStr([
+    '$impl.Obj.$Intern = $impl.Obj.$Intern + 1;',
+    '$impl.Obj.$Intern2 = $impl.Obj.$Intern2 + 2;',
+    'var $with1 = $impl.Obj;',
+    '$with1.$Intern = $with1.$Intern + 1;',
+    '$with1.$Intern2 = $with1.$Intern2 + 2;',
+    '']),
+    LinesToStr([ // implementation
+    '$impl.Obj = null;',
+    '']));
+end;
+
+procedure TTestModule.TestClass_Const;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    const cI: integer = 3;');
+  Add('    procedure DoIt;');
+  Add('    class procedure DoMore;');
+  Add('  end;');
+  Add('implementation');
+  Add('procedure tobject.doit;');
+  Add('begin');
+  Add('  if cI=4 then;');
+  Add('  if 5=cI then;');
+  Add('  if Self.cI=6 then;');
+  Add('  if 7=Self.cI then;');
+  Add('  with Self do begin');
+  Add('    if cI=11 then;');
+  Add('    if 12=cI then;');
+  Add('  end;');
+  Add('end;');
+  Add('class procedure tobject.domore;');
+  Add('begin');
+  Add('  if cI=8 then;');
+  Add('  if Self.cI=9 then;');
+  Add('  if 10=cI then;');
+  Add('  if 11=Self.cI then;');
+  Add('  with Self do begin');
+  Add('    if cI=13 then;');
+  Add('    if 14=cI then;');
+  Add('  end;');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  Cla: TClass;');
+  Add('begin');
+  Add('  if TObject.cI=21 then ;');
+  Add('  if Obj.cI=22 then ;');
+  Add('  if Cla.cI=23 then ;');
+  Add('  with obj do if ci=24 then;');
+  Add('  with TObject do if ci=25 then;');
+  Add('  with Cla do if ci=26 then;');
+  ConvertProgram;
+  CheckSource('TestClass_Const',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.cI = 3;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    if (this.cI == 4) ;',
+    '    if (5 == this.cI) ;',
+    '    if (this.cI == 6) ;',
+    '    if (7 == this.cI) ;',
+    '    if (this.cI == 11) ;',
+    '    if (12 == this.cI) ;',
+    '  };',
+    '  this.DoMore = function () {',
+    '    if (this.cI == 8) ;',
+    '    if (this.cI == 9) ;',
+    '    if (10 == this.cI) ;',
+    '    if (11 == this.cI) ;',
+    '    if (this.cI == 13) ;',
+    '    if (14 == this.cI) ;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.Cla = null;',
+    '']),
+    LinesToStr([
+    'if ($mod.TObject.cI == 21) ;',
+    'if ($mod.Obj.cI == 22) ;',
+    'if ($mod.Cla.cI == 23) ;',
+    'var $with1 = $mod.Obj;',
+    'if ($with1.cI == 24) ;',
+    'var $with2 = $mod.TObject;',
+    'if ($with2.cI == 25) ;',
+    'var $with3 = $mod.Cla;',
+    'if ($with3.cI == 26) ;',
+    '']));
+end;
+
+procedure TTestModule.TestClass_LocalVarSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  'constructor tobject.create;',
+  'var self: longint;',
+  'begin',
+  'end',
+  'begin',
+  '']);
+  SetExpectedPasResolverError('Duplicate identifier "self" at (0)',nDuplicateIdentifier);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestClass_ArgSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure DoIt(Self: longint);',
+  '  end;',
+  'procedure tobject.doit(self: longint);',
+  'begin',
+  'end',
+  'begin',
+  '']);
+  SetExpectedPasResolverError('Duplicate identifier "Self" at test1.pp(5,23)',nDuplicateIdentifier);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestClass_NestedSelf;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    Key: longint;',
+  '    class var State: longint;',
+  '    procedure DoIt;',
+  '    function GetSize: longint; virtual; abstract;',
+  '    procedure SetSize(Value: longint); virtual; abstract;',
+  '    property Size: longint read GetSize write SetSize;',
+  '  end;',
+  'procedure tobject.doit;',
+  '  procedure Sub;',
+  '  begin',
+  '    key:=key+2;',
+  '    self.key:=self.key+3;',
+  '    state:=state+4;',
+  '    self.state:=self.state+5;',
+  '    tobject.state:=tobject.state+6;',
+  '    size:=size+7;',
+  '    self.size:=self.size+8;',
+  '  end;',
+  'begin',
+  '  sub;',
+  '  key:=key+12;',
+  '  self.key:=self.key+13;',
+  '  state:=state+14;',
+  '  self.state:=self.state+15;',
+  '  tobject.state:=tobject.state+16;',
+  '  size:=size+17;',
+  '  self.size:=self.size+18;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_NestedSelf',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.State = 0;',
+    '  this.$init = function () {',
+    '    this.Key = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    var Self = this;',
+    '    function Sub() {',
+    '      Self.Key = Self.Key + 2;',
+    '      Self.Key = Self.Key + 3;',
+    '      Self.$class.State = Self.State + 4;',
+    '      Self.$class.State = Self.State + 5;',
+    '      $mod.TObject.State = $mod.TObject.State + 6;',
+    '      Self.SetSize(Self.GetSize() + 7);',
+    '      Self.SetSize(Self.GetSize() + 8);',
+    '    };',
+    '    Sub();',
+    '    Self.Key = Self.Key + 12;',
+    '    Self.Key = Self.Key + 13;',
+    '    Self.$class.State = Self.State + 14;',
+    '    Self.$class.State = Self.State + 15;',
+    '    $mod.TObject.State = $mod.TObject.State + 16;',
+    '    Self.SetSize(Self.GetSize() + 17);',
+    '    Self.SetSize(Self.GetSize() + 18);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClass_NestedClassSelf;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    class var State: longint;',
+  '    class procedure DoIt;',
+  '    class function GetSize: longint; virtual; abstract;',
+  '    class procedure SetSize(Value: longint); virtual; abstract;',
+  '    class property Size: longint read GetSize write SetSize;',
+  '  end;',
+  'class procedure tobject.doit;',
+  '  procedure Sub;',
+  '  begin',
+  '    state:=state+2;',
+  '    self.state:=self.state+3;',
+  '    tobject.state:=tobject.state+4;',
+  '    size:=size+5;',
+  '    self.size:=self.size+6;',
+  '    tobject.size:=tobject.size+7;',
+  '  end;',
+  'begin',
+  '  sub;',
+  '  state:=state+12;',
+  '  self.state:=self.state+13;',
+  '  tobject.state:=tobject.state+14;',
+  '  size:=size+15;',
+  '  self.size:=self.size+16;',
+  '  tobject.size:=tobject.size+17;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_NestedClassSelf',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.State = 0;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    var Self = this;',
+    '    function Sub() {',
+    '      Self.State = Self.State + 2;',
+    '      Self.State = Self.State + 3;',
+    '      $mod.TObject.State = $mod.TObject.State + 4;',
+    '      Self.SetSize(Self.GetSize() + 5);',
+    '      Self.SetSize(Self.GetSize() + 6);',
+    '      $mod.TObject.SetSize($mod.TObject.GetSize() + 7);',
+    '    };',
+    '    Sub();',
+    '    Self.State = Self.State + 12;',
+    '    Self.State = Self.State + 13;',
+    '    $mod.TObject.State = $mod.TObject.State + 14;',
+    '    Self.SetSize(Self.GetSize() + 15);',
+    '    Self.SetSize(Self.GetSize() + 16);',
+    '    $mod.TObject.SetSize($mod.TObject.GetSize() + 17);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClass_NestedCallInherited;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function DoIt(k: boolean): longint; virtual;',
+  '  end;',
+  '  TBird = class',
+  '    function DoIt(k: boolean): longint; override;',
+  '  end;',
+  'function tobject.doit(k: boolean): longint;',
+  'begin',
+  'end;',
+  'function tbird.doit(k: boolean): longint;',
+  '  procedure Sub;',
+  '  begin',
+  '    inherited DoIt(true);',
+  //'    if inherited DoIt(false)=4 then ;',
+  '  end;',
+  'begin',
+  '  Sub;',
+  '  inherited;',
+  '  inherited DoIt(true);',
+  //'  if inherited DoIt(false)=14 then ;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_NestedCallInherited',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (k) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.DoIt = function (k) {',
+    '    var Self = this;',
+    '    var Result = 0;',
+    '    function Sub() {',
+    '      $mod.TObject.DoIt.call(Self, true);',
+    '    };',
+    '    Sub();',
+    '    $mod.TObject.DoIt.apply(Self, arguments);',
+    '    $mod.TObject.DoIt.call(Self, true);',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClass_TObjectFree;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    Obj: tobject;',
+  '    procedure Free;',
+  '  end;',
+  'procedure tobject.free;',
+  'begin',
+  'end;',
+  'function DoIt(o: tobject): tobject;',
+  'var l: tobject;',
+  'begin',
+  '  o.free;',
+  '  o.free();',
+  '  l.free;',
+  '  l.free();',
+  '  o.obj.free;',
+  '  o.obj.free();',
+  '  with o do obj.free;',
+  '  with o do obj.free();',
+  '  result.Free;',
+  '  result.Free();',
+  'end;',
+  'var o: tobject;',
+  '  a: array of tobject;',
+  'begin',
+  '  o.free;',
+  '  o.obj.free;',
+  '  a[1+2].free;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_TObjectFree',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.Obj = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Obj = undefined;',
+    '  };',
+    '  this.Free = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function (o) {',
+    '  var Result = null;',
+    '  var l = null;',
+    '  o = rtl.freeLoc(o);',
+    '  o = rtl.freeLoc(o);',
+    '  l = rtl.freeLoc(l);',
+    '  l = rtl.freeLoc(l);',
+    '  rtl.free(o, "Obj");',
+    '  rtl.free(o, "Obj");',
+    '  rtl.free(o, "Obj");',
+    '  rtl.free(o, "Obj");',
+    '  Result = rtl.freeLoc(Result);',
+    '  Result = rtl.freeLoc(Result);',
+    '  return Result;',
+    '};',
+    'this.o = null;',
+    'this.a = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    'rtl.free($mod, "o");',
+    'rtl.free($mod.o, "Obj");',
+    'rtl.free($mod.a, 1 + 2);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TObjectFreeNewInstance;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '    procedure Free;',
+  '  end;',
+  'constructor TObject.Create; begin end;',
+  'procedure tobject.free; begin end;',
+  'begin',
+  '  with tobject.create do free;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_TObjectFreeNewInstance',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '  this.Free = function () {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    'var $with1 = $mod.TObject.$create("Create");',
+    '$with1=rtl.freeLoc($with1);',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TObjectFreeLowerCase;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    destructor Destroy;',
+  '    procedure Free;',
+  '  end;',
+  'destructor TObject.Destroy; begin end;',
+  'procedure tobject.free; begin end;',
+  'var o: tobject;',
+  'begin',
+  '  o.free;',
+  '']);
+  Converter.UseLowerCase:=true;
+  ConvertProgram;
+  CheckSource('TestClass_TObjectFreeLowerCase',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "tobject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  rtl.tObjectDestroy = "destroy";',
+    '  this.destroy = function () {',
+    '  };',
+    '  this.free = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'rtl.free($mod, "o");',
+    '']));
+end;
+
+procedure TTestModule.TestClass_TObjectFreeFunctionFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure Free;',
+  '    function GetObj: tobject; virtual; abstract;',
+  '  end;',
+  'procedure tobject.free;',
+  'begin',
+  'end;',
+  'var o: tobject;',
+  'begin',
+  '  o.getobj.free;',
+  '']);
+  SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestClass_TObjectFreePropertyFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure Free;',
+  '    FObj: TObject;',
+  '    property Obj: tobject read FObj write FObj;',
+  '  end;',
+  'procedure tobject.free;',
+  'begin',
+  'end;',
+  'var o: tobject;',
+  'begin',
+  '  o.obj.free;',
+  '']);
+  SetExpectedPasResolverError(sFreeNeedsVar,nFreeNeedsVar);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestClassOf_Create;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('constructor tobject.create; begin end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  C: tclass;');
+  Add('begin');
+  Add('  obj:=C.create;');
+  Add('  with c do obj:=create;');
+  ConvertProgram;
+  CheckSource('TestClassOf_Create',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.C = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.C.$create("Create");',
+    'var $with1 = $mod.C;',
+    '$mod.Obj = $with1.$create("Create");',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_Call;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure DoIt;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('class procedure tobject.doit; begin end;');
+  Add('var');
+  Add('  C: tclass;');
+  Add('begin');
+  Add('  c.doit;');
+  Add('  with c do doit;');
+  ConvertProgram;
+  CheckSource('TestClassOf_Call',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '  };',
+    '});',
+    'this.C = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.C.DoIt();',
+    'var $with1 = $mod.C;',
+    '$with1.DoIt();',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_Assign;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('    ClassType: TClass; ');
+  Add('  end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  C: tclass;');
+  Add('begin');
+  Add('  c:=nil;');
+  Add('  c:=obj.classtype;');
+  ConvertProgram;
+  CheckSource('TestClassOf_Assign',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.ClassType = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.ClassType = undefined;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.C = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.C = null;',
+    '$mod.C = $mod.Obj.ClassType;',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_Is;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TCar = class');
+  Add('  end;');
+  Add('  TCars = class of TCar;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  C: tclass;');
+  Add('  Cars: tcars;');
+  Add('begin');
+  Add('  if c is tcar then ;');
+  Add('  if c is tcars then ;');
+  ConvertProgram;
+  CheckSource('TestClassOf_Is',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCar", $mod.TObject, function () {',
+    '});',
+    'this.Obj = null;',
+    'this.C = null;',
+    'this.Cars = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'if(rtl.is($mod.C,$mod.TCar));',
+    'if(rtl.is($mod.C,$mod.TCar));',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_Compare;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('    ClassType: TClass; ');
+  Add('  end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  Obj: tobject;');
+  Add('  C: tclass;');
+  Add('begin');
+  Add('  b:=c=nil;');
+  Add('  b:=nil=c;');
+  Add('  b:=c=obj.classtype;');
+  Add('  b:=obj.classtype=c;');
+  Add('  b:=c=TObject;');
+  Add('  b:=TObject=c;');
+  Add('  b:=c<>nil;');
+  Add('  b:=nil<>c;');
+  Add('  b:=c<>obj.classtype;');
+  Add('  b:=obj.classtype<>c;');
+  Add('  b:=c<>TObject;');
+  Add('  b:=TObject<>c;');
+  ConvertProgram;
+  CheckSource('TestClassOf_Compare',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.ClassType = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.ClassType = undefined;',
+    '  };',
+    '});',
+    'this.b = false;',
+    'this.Obj = null;',
+    'this.C = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.b = $mod.C == null;',
+    '$mod.b = null == $mod.C;',
+    '$mod.b = $mod.C == $mod.Obj.ClassType;',
+    '$mod.b = $mod.Obj.ClassType == $mod.C;',
+    '$mod.b = $mod.C == $mod.TObject;',
+    '$mod.b = $mod.TObject == $mod.C;',
+    '$mod.b = $mod.C != null;',
+    '$mod.b = null != $mod.C;',
+    '$mod.b = $mod.C != $mod.Obj.ClassType;',
+    '$mod.b = $mod.Obj.ClassType != $mod.C;',
+    '$mod.b = $mod.C != $mod.TObject;',
+    '$mod.b = $mod.TObject != $mod.C;',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_ClassVar;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var id: longint;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('var');
+  Add('  C: tclass;');
+  Add('begin');
+  Add('  C.id:=C.id;');
+  ConvertProgram;
+  CheckSource('TestClassOf_ClassVar',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.id = 0;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.C = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.C.id = $mod.C.id;',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_ClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class function DoIt(i: longint = 0): longint;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('class function tobject.doit(i: longint = 0): longint; begin end;');
+  Add('var');
+  Add('  i: longint;');
+  Add('  C: tclass;');
+  Add('begin');
+  Add('  C.DoIt;');
+  Add('  C.DoIt();');
+  Add('  i:=C.DoIt;');
+  Add('  i:=C.DoIt();');
+  ConvertProgram;
+  CheckSource('TestClassOf_ClassMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (i) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.i = 0;',
+    'this.C = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.C.DoIt(0);',
+    '$mod.C.DoIt(0);',
+    '$mod.i = $mod.C.DoIt(0);',
+    '$mod.i = $mod.C.DoIt(0);',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_ClassProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var FA: longint;');
+  Add('    class function GetA: longint;');
+  Add('    class procedure SetA(Value: longint);');
+  Add('    class property pA: longint read fa write fa;');
+  Add('    class property pB: longint read geta write seta;');
+  Add('  end;');
+  Add('  TObjectClass = class of tobject;');
+  Add('class function tobject.geta: longint; begin end;');
+  Add('class procedure tobject.seta(value: longint); begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  Obj: tobject;');
+  Add('  Cla: tobjectclass;');
+  Add('begin');
+  Add('  obj.pa:=obj.pa;');
+  Add('  obj.pb:=obj.pb;');
+  Add('  b:=obj.pa=4;');
+  Add('  b:=obj.pb=obj.pb;');
+  Add('  b:=5=obj.pa;');
+  Add('  cla.pa:=6;');
+  Add('  cla.pa:=cla.pa;');
+  Add('  cla.pb:=cla.pb;');
+  Add('  b:=cla.pa=7;');
+  Add('  b:=cla.pb=cla.pb;');
+  Add('  b:=8=cla.pa;');
+  Add('  tobject.pa:=9;');
+  Add('  tobject.pb:=tobject.pb;');
+  Add('  b:=tobject.pa=10;');
+  Add('  b:=11=tobject.pa;');
+  ConvertProgram;
+  CheckSource('TestClassOf_ClassProperty',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.FA = 0;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetA = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetA = function (Value) {',
+    '  };',
+    '});',
+    'this.b = false;',
+    'this.Obj = null;',
+    'this.Cla = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.$class.FA = $mod.Obj.FA;',
+    '$mod.Obj.$class.SetA($mod.Obj.$class.GetA());',
+    '$mod.b = $mod.Obj.FA == 4;',
+    '$mod.b = $mod.Obj.$class.GetA() == $mod.Obj.$class.GetA();',
+    '$mod.b = 5 == $mod.Obj.FA;',
+    '$mod.Cla.FA = 6;',
+    '$mod.Cla.FA = $mod.Cla.FA;',
+    '$mod.Cla.SetA($mod.Cla.GetA());',
+    '$mod.b = $mod.Cla.FA == 7;',
+    '$mod.b = $mod.Cla.GetA() == $mod.Cla.GetA();',
+    '$mod.b = 8 == $mod.Cla.FA;',
+    '$mod.TObject.FA = 9;',
+    '$mod.TObject.SetA($mod.TObject.GetA());',
+    '$mod.b = $mod.TObject.FA == 10;',
+    '$mod.b = 11 == $mod.TObject.FA;',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_ClassMethodSelf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var GlobalId: longint;');
+  Add('    class procedure ProcA;');
+  Add('  end;');
+  Add('class procedure tobject.proca;');
+  Add('var b: boolean;');
+  Add('begin');
+  Add('  b:=self=nil;');
+  Add('  b:=self.globalid=3;');
+  Add('  b:=4=self.globalid;');
+  Add('  self.globalid:=5;');
+  Add('  self.proca;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestClassOf_ClassMethodSelf',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.GlobalId = 0;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcA = function () {',
+    '    var b = false;',
+    '    b = this == null;',
+    '    b = this.GlobalId == 3;',
+    '    b = 4 == this.GlobalId;',
+    '    this.GlobalId = 5;',
+    '    this.ProcA();',
+    '  };',
+    '});'
+    ]),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_TypeCast;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure {#TObject_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TClass = class of TObject;');
+  Add('  TMobile = class');
+  Add('    class procedure {#TMobile_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TMobileClass = class of TMobile;');
+  Add('  TCar = class(TMobile)');
+  Add('    class procedure {#TCar_DoIt}DoIt;');
+  Add('  end;');
+  Add('  TCarClass = class of TCar;');
+  Add('class procedure TObject.DoIt;');
+  Add('begin');
+  Add('  TClass(Self).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
+  Add('end;');
+  Add('class procedure TMobile.DoIt;');
+  Add('begin');
+  Add('  TClass(Self).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(Self).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(Self).{@TCar_DoIt}DoIt;');
+  Add('end;');
+  Add('class procedure TCar.DoIt; begin end;');
+  Add('var');
+  Add('  ObjC: TClass;');
+  Add('  MobileC: TMobileClass;');
+  Add('  CarC: TCarClass;');
+  Add('begin');
+  Add('  ObjC.{@TObject_DoIt}DoIt;');
+  Add('  MobileC.{@TMobile_DoIt}DoIt;');
+  Add('  CarC.{@TCar_DoIt}DoIt;');
+  Add('  TClass(ObjC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(ObjC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(ObjC).{@TCar_DoIt}DoIt;');
+  Add('  TClass(MobileC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(MobileC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(MobileC).{@TCar_DoIt}DoIt;');
+  Add('  TClass(CarC).{@TObject_DoIt}DoIt;');
+  Add('  TMobileClass(CarC).{@TMobile_DoIt}DoIt;');
+  Add('  TCarClass(CarC).{@TCar_DoIt}DoIt;');
+  ConvertProgram;
+  CheckSource('TestClassOf_TypeCast',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    this.DoIt();',
+    '    this.DoIt$1();',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
+    '  this.DoIt$1 = function () {',
+    '    this.DoIt();',
+    '    this.DoIt$1();',
+    '    this.DoIt$2();',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCar", $mod.TMobile, function () {',
+    '  this.DoIt$2 = function () {',
+    '  };',
+    '});',
+    'this.ObjC = null;',
+    'this.MobileC = null;',
+    'this.CarC = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ObjC.DoIt();',
+    '$mod.MobileC.DoIt$1();',
+    '$mod.CarC.DoIt$2();',
+    '$mod.ObjC.DoIt();',
+    '$mod.ObjC.DoIt$1();',
+    '$mod.ObjC.DoIt$2();',
+    '$mod.MobileC.DoIt();',
+    '$mod.MobileC.DoIt$1();',
+    '$mod.MobileC.DoIt$2();',
+    '$mod.CarC.DoIt();',
+    '$mod.CarC.DoIt$1();',
+    '$mod.CarC.DoIt$2();',
+    '']));
+end;
+
+procedure TTestModule.TestClassOf_ImplicitFunctionCall;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function CurNow: longint; ');
+  Add('    class function Now: longint; ');
+  Add('  end;');
+  Add('function TObject.CurNow: longint; begin end;');
+  Add('class function TObject.Now: longint; begin end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  vI: longint;');
+  Add('begin');
+  Add('  obj.curnow;');
+  Add('  vi:=obj.curnow;');
+  Add('  tobject.now;');
+  Add('  vi:=tobject.now;');
+  ConvertProgram;
+  CheckSource('TestClassOf_ImplicitFunctionCall',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.CurNow = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.Now = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.vI = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.CurNow();',
+    '$mod.vI = $mod.Obj.CurNow();',
+    '$mod.TObject.Now();',
+    '$mod.vI = $mod.TObject.Now();',
+    '']));
+end;
+
+procedure TTestModule.TestNestedClass_Fail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    type TNested = longint;',
+  '  end;',
+  'begin']);
+  SetExpectedPasResolverError('not yet implemented: TNested:TPasAliasType [20170608232534] nested types',
+    nNotYetImplemented);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_Var;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtObj''');
+  Add('    Id: longint external name ''$Id'';');
+  Add('    B: longint;');
+  Add('  end;');
+  Add('var Obj: TExtA;');
+  Add('begin');
+  Add('  obj.id:=obj.id+1;');
+  Add('  obj.B:=obj.B+1;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_Var',
+    LinesToStr([ // statements
+    'this.Obj = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.$Id = $mod.Obj.$Id + 1;',
+    '$mod.Obj.B = $mod.Obj.B + 1;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_Dollar;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''$''',
+  '    Id: longint external name ''$'';',
+  '    function Bla(i: longint): longint; external name ''$'';',
+  '  end;',
+  'function dollar(k: longint): longint; external name ''$'';',
+  'var Obj: TExtA;',
+  'begin',
+  '  dollar(1);',
+  '  obj.id:=obj.id+2;',
+  '  obj.Bla(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_Dollar',
+    LinesToStr([ // statements
+    'this.Obj = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$(1);',
+    '$mod.Obj.$ = $mod.Obj.$ + 2;',
+    '$mod.Obj.$(3);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_DuplicateVarFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    Id: longint external name ''$Id'';');
+  Add('  end;');
+  Add('  TExtB = class external ''lib'' name ''ExtB''(TExtA)');
+  Add('    Id: longint;');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,6)',nDuplicateIdentifier);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_Method;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtObj''');
+  Add('    procedure DoIt(Id: longint = 1); external name ''$Execute'';');
+  Add('    procedure DoSome(Id: longint = 1);');
+  Add('  end;');
+  Add('var Obj: texta;');
+  Add('begin');
+  Add('  obj.doit;');
+  Add('  obj.doit();');
+  Add('  obj.doit(2);');
+  Add('  with obj do begin');
+  Add('    doit;');
+  Add('    doit();');
+  Add('    doit(3);');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_Method',
+    LinesToStr([ // statements
+    'this.Obj = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj.$Execute(1);',
+    '$mod.Obj.$Execute(1);',
+    '$mod.Obj.$Execute(2);',
+    'var $with1 = $mod.Obj;',
+    '$with1.$Execute(1);',
+    '$with1.$Execute(1);',
+    '$with1.$Execute(3);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_NonExternalOverride;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtObjA''');
+  Add('    procedure ProcA; virtual;');
+  Add('    procedure ProcB; virtual;');
+  Add('  end;');
+  Add('  TExtB = class external name ''ExtObjB'' (TExtA)');
+  Add('  end;');
+  Add('  TExtC = class (TExtB)');
+  Add('    procedure ProcA; override;');
+  Add('  end;');
+  Add('procedure TExtC.ProcA;');
+  Add('begin');
+  Add('  ProcA;');
+  Add('  Self.ProcA;');
+  Add('  ProcB;');
+  Add('  Self.ProcB;');
+  Add('end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('  B: textb;');
+  Add('  C: textc;');
+  Add('begin');
+  Add('  a.proca;');
+  Add('  b.proca;');
+  Add('  c.proca;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_NonExternalOverride',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtC", ExtObjB, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcA = function () {',
+    '    this.ProcA();',
+    '    this.ProcA();',
+    '    this.ProcB();',
+    '    this.ProcB();',
+    '  };',
+    '});',
+    'this.A = null;',
+    'this.B = null;',
+    'this.C = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A.ProcA();',
+    '$mod.B.ProcA();',
+    '$mod.C.ProcA();',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_Property;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    function getYear: longint;');
+  Add('    procedure setYear(Value: longint);');
+  Add('    property Year: longint read getyear write setyear;');
+  Add('  end;');
+  Add('  TExtB = class (TExtA)');
+  Add('    procedure OtherSetYear(Value: longint);');
+  Add('    property year write othersetyear;');
+  Add('  end;');
+  Add('procedure textb.othersetyear(value: longint);');
+  Add('begin');
+  Add('  setYear(Value+4);');
+  Add('end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('  B: textb;');
+  Add('begin');
+  Add('  a.year:=a.year+1;');
+  Add('  b.year:=b.year+2;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_NonExternalOverride',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.OtherSetYear = function (Value) {',
+    '    this.setYear(Value+4);',
+    '  };',
+    '});',
+    'this.A = null;',
+    'this.B = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A.setYear($mod.A.getYear()+1);',
+    '$mod.B.OtherSetYear($mod.B.getYear()+2);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_ClassProperty;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    class function getYear: longint;');
+  Add('    class procedure setYear(Value: longint);');
+  Add('    class property Year: longint read getyear write setyear;');
+  Add('  end;');
+  Add('  TExtB = class (TExtA)');
+  Add('    class function GetCentury: longint;');
+  Add('    class procedure SetCentury(Value: longint);');
+  Add('    class property Century: longint read getcentury write setcentury;');
+  Add('  end;');
+  Add('class function textb.getcentury: longint;');
+  Add('begin');
+  Add('end;');
+  Add('class procedure textb.setcentury(value: longint);');
+  Add('begin');
+  Add('  setyear(value+11);');
+  Add('  texta.year:=texta.year+12;');
+  Add('  year:=year+13;');
+  Add('  textb.century:=textb.century+14;');
+  Add('  century:=century+15;');
+  Add('end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('  B: textb;');
+  Add('begin');
+  Add('  texta.year:=texta.year+1;');
+  Add('  textb.year:=textb.year+2;');
+  Add('  TextA.year:=TextA.year+3;');
+  Add('  b.year:=b.year+4;');
+  Add('  textb.century:=textb.century+5;');
+  Add('  b.century:=b.century+6;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_ClassProperty',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetCentury = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.SetCentury = function (Value) {',
+    '    this.setYear(Value + 11);',
+    '    ExtA.setYear(ExtA.getYear() + 12);',
+    '    this.setYear(this.getYear() + 13);',
+    '    $mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 14);',
+    '    this.SetCentury(this.GetCentury() + 15);',
+    '  };',
+    '});',
+    'this.A = null;',
+    'this.B = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'ExtA.setYear(ExtA.getYear() + 1);',
+    '$mod.TExtB.setYear($mod.TExtB.getYear() + 2);',
+    'ExtA.setYear(ExtA.getYear() + 3);',
+    '$mod.B.setYear($mod.B.getYear() + 4);',
+    '$mod.TExtB.SetCentury($mod.TExtB.GetCentury() + 5);',
+    '$mod.B.$class.SetCentury($mod.B.$class.GetCentury() + 6);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_ClassOf;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    procedure ProcA; virtual;');
+  Add('    procedure ProcB; virtual;');
+  Add('  end;');
+  Add('  TExtAClass = class of TExtA;');
+  Add('  TExtB = class external name ''ExtB'' (TExtA)');
+  Add('  end;');
+  Add('  TExtBClass = class of TExtB;');
+  Add('  TExtC = class (TExtB)');
+  Add('    procedure ProcA; override;');
+  Add('  end;');
+  Add('  TExtCClass = class of TExtC;');
+  Add('procedure TExtC.ProcA; begin end;');
+  Add('var');
+  Add('  A: texta; ClA: TExtAClass;');
+  Add('  B: textb; ClB: TExtBClass;');
+  Add('  C: textc; ClC: TExtCClass;');
+  Add('begin');
+  Add('  ClA:=texta;');
+  Add('  ClA:=textb;');
+  Add('  ClA:=textc;');
+  Add('  ClB:=textb;');
+  Add('  ClB:=textc;');
+  Add('  ClC:=textc;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_ClassOf',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcA = function () {',
+    '  };',
+    '});',
+    'this.A = null;',
+    'this.ClA = null;',
+    'this.B = null;',
+    'this.ClB = null;',
+    'this.C = null;',
+    'this.ClC = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ClA = ExtA;',
+    '$mod.ClA = ExtB;',
+    '$mod.ClA = $mod.TExtC;',
+    '$mod.ClB = ExtB;',
+    '$mod.ClB = $mod.TExtC;',
+    '$mod.ClC = $mod.TExtC;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_ClassOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    '{$modeswitch externalclass}',
+    'type',
+    '  TExtA = class external name ''ExtA''',
+    '    class var Id: longint;',
+    '  end;',
+    '']),
+    '');
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('implementation');
+  Add('begin');
+  Add('  unit2.texta.id:=unit2.texta.id+1;');
+  ConvertUnit;
+  CheckSource('TestExternalClass_ClassOtherUnit',
+    LinesToStr([
+    '']),
+    LinesToStr([
+    'ExtA.Id = ExtA.Id + 1;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_Is;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TExtAClass = class of TExtA;');
+  Add('  TExtB = class external name ''ExtB'' (TExtA)');
+  Add('  end;');
+  Add('  TExtBClass = class of TExtB;');
+  Add('  TExtC = class (TExtB)');
+  Add('  end;');
+  Add('  TExtCClass = class of TExtC;');
+  Add('var');
+  Add('  A: texta; ClA: TExtAClass;');
+  Add('  B: textb; ClB: TExtBClass;');
+  Add('  C: textc; ClC: TExtCClass;');
+  Add('begin');
+  Add('  if a is textb then ;');
+  Add('  if a is textc then ;');
+  Add('  if b is textc then ;');
+  Add('  if cla is textb then ;');
+  Add('  if cla is textc then ;');
+  Add('  if clb is textc then ;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_Is',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.A = null;',
+    'this.ClA = null;',
+    'this.B = null;',
+    'this.ClB = null;',
+    'this.C = null;',
+    'this.ClC = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if (rtl.isExt($mod.A, ExtB)) ;',
+    'if ($mod.TExtC.isPrototypeOf($mod.A)) ;',
+    'if ($mod.TExtC.isPrototypeOf($mod.B)) ;',
+    'if (rtl.isExt($mod.ClA, ExtB)) ;',
+    'if (rtl.is($mod.ClA, $mod.TExtC)) ;',
+    'if (rtl.is($mod.ClB, $mod.TExtC)) ;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_As;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TExtB = class external name ''ExtB'' (TExtA)');
+  Add('  end;');
+  Add('  TExtC = class (TExtB)');
+  Add('  end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('  B: textb;');
+  Add('  C: textc;');
+  Add('begin');
+  Add('  b:=a as textb;');
+  Add('  c:=a as textc;');
+  Add('  c:=b as textc;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_Is',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtC", ExtB, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.A = null;',
+    'this.B = null;',
+    'this.C = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.B = rtl.asExt($mod.A, ExtB);',
+    '$mod.C = rtl.as($mod.A, $mod.TExtC);',
+    '$mod.C = rtl.as($mod.B, $mod.TExtC);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_DestructorFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    destructor Free;');
+  Add('  end;');
+  SetExpectedPasResolverError('Pascal element not supported: destructor',
+    nPasElementNotSupported);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_New;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    constructor New;');
+  Add('    constructor New(i: longint; j: longint = 2);');
+  Add('  end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('begin');
+  Add('  a:=texta.new;');
+  Add('  a:=texta.new();');
+  Add('  a:=texta.new(1);');
+  Add('  with texta do begin');
+  Add('    a:=new;');
+  Add('    a:=new();');
+  Add('    a:=new(2);');
+  Add('  end;');
+  Add('  a:=test1.texta.new;');
+  Add('  a:=test1.texta.new();');
+  Add('  a:=test1.texta.new(3);');
+  ConvertProgram;
+  CheckSource('TestExternalClass_New',
+    LinesToStr([ // statements
+    'this.A = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = new ExtA();',
+    '$mod.A = new ExtA();',
+    '$mod.A = new ExtA(1,2);',
+    '$mod.A = new ExtA();',
+    '$mod.A = new ExtA();',
+    '$mod.A = new ExtA(2,2);',
+    '$mod.A = new ExtA();',
+    '$mod.A = new ExtA();',
+    '$mod.A = new ExtA(3,2);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_ClassOf_New;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtAClass = class of TExtA;');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    constructor New;');
+  Add('  end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('  C: textaclass;');
+  Add('begin');
+  Add('  a:=c.new;');
+  Add('  a:=c.new();');
+  Add('  with C do begin');
+  Add('    a:=new;');
+  Add('    a:=new();');
+  Add('  end;');
+  Add('  a:=test1.c.new;');
+  Add('  a:=test1.c.new();');
+  ConvertProgram;
+  CheckSource('TestExternalClass_ClassOf_New',
+    LinesToStr([ // statements
+    'this.A = null;',
+    'this.C = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = new $mod.C();',
+    '$mod.A = new $mod.C();',
+    'var $with1 = $mod.C;',
+    '$mod.A = new $with1();',
+    '$mod.A = new $with1();',
+    '$mod.A = new $mod.C();',
+    '$mod.A = new $mod.C();',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_FuncClassOf_New;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtAClass = class of TExtA;');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    constructor New;');
+  Add('  end;');
+  Add('function GetCreator: TExtAClass;');
+  Add('begin');
+  Add('  Result:=TExtA;');
+  Add('end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('begin');
+  Add('  a:=getcreator.new;');
+  Add('  a:=getcreator().new;');
+  Add('  a:=getcreator().new();');
+  Add('  a:=getcreator.new();');
+  Add('  with getcreator do begin');
+  Add('    a:=new;');
+  Add('    a:=new();');
+  Add('  end;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_FuncClassOf_New',
+    LinesToStr([ // statements
+    'this.GetCreator = function () {',
+    '  var Result = null;',
+    '  Result = ExtA;',
+    '  return Result;',
+    '};',
+    'this.A = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = new ($mod.GetCreator())();',
+    '$mod.A = new ($mod.GetCreator())();',
+    '$mod.A = new ($mod.GetCreator())();',
+    '$mod.A = new ($mod.GetCreator())();',
+    'var $with1 = $mod.GetCreator();',
+    '$mod.A = new $with1();',
+    '$mod.A = new $with1();',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_LocalConstSameName;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    constructor New;');
+  Add('  end;');
+  Add('function DoIt: longint;');
+  Add('const ExtA = 3;');
+  Add('begin');
+  Add('  Result:=ExtA;');
+  Add('end;');
+  Add('var');
+  Add('  A: texta;');
+  Add('begin');
+  Add('  a:=texta.new;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_LocalConstSameName',
+    LinesToStr([ // statements
+    'var ExtA$1 = 3;',
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  Result = ExtA$1;',
+    '  return Result;',
+    '};',
+    'this.A = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = new ExtA();',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_ReintroduceOverload;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('  TMyA = class(TExtA)');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('procedure TMyA.DoIt; begin end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestExternalClass_ReintroduceOverload',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TMyA", ExtA, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt$1 = function () {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_Inherited;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('    procedure DoIt(i: longint = 1); virtual;');
+  Add('    procedure DoSome(j: longint = 2);');
+  Add('  end;');
+  Add('  TExtB = class external name ''ExtB''(TExtA)');
+  Add('  end;');
+  Add('  TMyC = class(TExtB)');
+  Add('    procedure DoIt(i: longint = 1); override;');
+  Add('    procedure DoSome(j: longint = 2); reintroduce;');
+  Add('  end;');
+  Add('procedure TMyC.DoIt(i: longint);');
+  Add('begin');
+  Add('  inherited;');
+  Add('  inherited DoIt;');
+  Add('  inherited DoIt();');
+  Add('  inherited DoIt(3);');
+  Add('  inherited DoSome;');
+  Add('  inherited DoSome();');
+  Add('  inherited DoSome(4);');
+  Add('end;');
+  Add('procedure TMyC.DoSome(j: longint);');
+  Add('begin');
+  Add('  inherited;');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestExternalClass_ReintroduceOverload',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TMyC", ExtB, "", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (i) {',
+    '    ExtB.DoIt.apply(this, arguments);',
+    '    ExtB.DoIt.call(this, 1);',
+    '    ExtB.DoIt.call(this, 1);',
+    '    ExtB.DoIt.call(this, 3);',
+    '    ExtB.DoSome.call(this, 2);',
+    '    ExtB.DoSome.call(this, 2);',
+    '    ExtB.DoSome.call(this, 4);',
+    '  };',
+    '  this.DoSome$1 = function (j) {',
+    '    ExtB.DoSome.apply(this, arguments);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_PascalAncestorFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TExtA = class external name ''ExtA''(TObject)');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError('Ancestor "TObject" is not external',nAncestorIsNotExternal);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_NewInstance;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TMyB = class(TExtA)');
+  Add('  protected');
+  Add('    class function NewInstance(fnname: string; const paramarray): TMyB; virtual;');
+  Add('  end;');
+  Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
+  Add('begin end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestExternalClass_NewInstance',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TMyB", ExtA, "NewInstance", function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.NewInstance = function (fnname, paramarray) {',
+    '    var Result = null;',
+    '    return Result;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_NewInstance_NonVirtualFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TMyB = class(TExtA)');
+  Add('  protected');
+  Add('    class function NewInstance(fnname: string; const paramarray): TMyB;');
+  Add('  end;');
+  Add('class function TMyB.NewInstance(fnname: string; const paramarray): TMyB;');
+  Add('begin end;');
+  Add('begin');
+  SetExpectedPasResolverError(sNewInstanceFunctionMustBeVirtual,nNewInstanceFunctionMustBeVirtual);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_NewInstance_FirstParamNotString_Fail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TMyB = class(TExtA)');
+  Add('  protected');
+  Add('    class function NewInstance(fnname: longint; const paramarray): TMyB; virtual;');
+  Add('  end;');
+  Add('class function TMyB.NewInstance(fnname: longint; const paramarray): TMyB;');
+  Add('begin end;');
+  Add('begin');
+  SetExpectedPasResolverError('Incompatible type arg no. 1: Got "Longint", expected "String"',
+    nIncompatibleTypeArgNo);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_NewInstance_SecondParamTyped_Fail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TExtA = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TMyB = class(TExtA)');
+  Add('  protected');
+  Add('    class function NewInstance(fnname: string; const paramarray: string): TMyB; virtual;');
+  Add('  end;');
+  Add('class function TMyB.NewInstance(fnname: string; const paramarray: string): TMyB;');
+  Add('begin end;');
+  Add('begin');
+  SetExpectedPasResolverError('Incompatible type arg no. 2: Got "type", expected "untyped"',
+    nIncompatibleTypeArgNo);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_PascalProperty;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSElement = class;');
+  Add('  TJSNotifyEvent = procedure(Sender: TJSElement) of object;');
+  Add('  TJSElement = class external name ''ExtA''');
+  Add('  end;');
+  Add('  TControl = class(TJSElement)');
+  Add('  private');
+  Add('    FOnClick: TJSNotifyEvent;');
+  Add('    property OnClick: TJSNotifyEvent read FOnClick write FOnClick;');
+  Add('    procedure Click(Sender: TJSElement);');
+  Add('  end;');
+  Add('procedure TControl.Click(Sender: TJSElement);');
+  Add('begin');
+  Add('  OnClick(Self);');
+  Add('end;');
+  Add('var');
+  Add('  Ctrl: TControl;');
+  Add('begin');
+  Add('  Ctrl.OnClick:=@Ctrl.Click;');
+  Add('  Ctrl.OnClick(Ctrl);');
+  ConvertProgram;
+  CheckSource('TestExternalClass_PascalProperty',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TControl", ExtA, "", function () {',
+    '  this.$init = function () {',
+    '    this.FOnClick = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FOnClick = undefined;',
+    '  };',
+    '  this.Click = function (Sender) {',
+    '    this.FOnClick(this);',
+    '  };',
+    '});',
+    'this.Ctrl = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Ctrl.FOnClick = rtl.createCallback($mod.Ctrl, "Click");',
+    '$mod.Ctrl.FOnClick($mod.Ctrl);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_TypeCastToRootClass;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TChild = class');
+  Add('  end;');
+  Add('  TExtRootA = class external name ''ExtRootA''');
+  Add('  end;');
+  Add('  TExtChildA = class external name ''ExtChildA''(TExtRootA)');
+  Add('  end;');
+  Add('  TExtRootB = class external name ''ExtRootB''');
+  Add('  end;');
+  Add('  TExtChildB = class external name ''ExtChildB''(TExtRootB)');
+  Add('  end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  Child: TChild;');
+  Add('  RootA: TExtRootA;');
+  Add('  ChildA: TExtChildA;');
+  Add('  RootB: TExtRootB;');
+  Add('  ChildB: TExtChildB;');
+  Add('begin');
+  Add('  obj:=tobject(roota);');
+  Add('  obj:=tobject(childa);');
+  Add('  child:=tchild(tobject(roota));');
+  Add('  roota:=textroota(obj);');
+  Add('  roota:=textroota(child);');
+  Add('  roota:=textroota(rootb);');
+  Add('  roota:=textroota(childb);');
+  Add('  childa:=textchilda(textroota(obj));');
+  ConvertProgram;
+  CheckSource('TestExternalClass_TypeCastToRootClass',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TChild", $mod.TObject, function () {',
+    '});',
+    'this.Obj = null;',
+    'this.Child = null;',
+    'this.RootA = null;',
+    'this.ChildA = null;',
+    'this.RootB = null;',
+    'this.ChildB = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Obj = $mod.RootA;',
+    '$mod.Obj = $mod.ChildA;',
+    '$mod.Child = $mod.RootA;',
+    '$mod.RootA = $mod.Obj;',
+    '$mod.RootA = $mod.Child;',
+    '$mod.RootA = $mod.RootB;',
+    '$mod.RootA = $mod.ChildB;',
+    '$mod.ChildA = $mod.Obj;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_TypeCastStringToExternalString;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSString = class external name ''String''');
+  Add('    class function fromCharCode() : string; varargs;');
+  Add('    function anchor(const aName : string) : string;');
+  Add('  end;');
+  Add('var');
+  Add('  s: string;');
+  Add('begin');
+  Add('  s:=TJSString.fromCharCode(65,66);');
+  Add('  s:=TJSString(s).anchor(s);');
+  Add('  s:=TJSString(''foo'').anchor(s);');
+  ConvertProgram;
+  CheckSource('TestExternalClass_TypeCastStringToExternalString',
+    LinesToStr([ // statements
+    'this.s = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.s = String.fromCharCode(65, 66);',
+    '$mod.s = $mod.s.anchor($mod.s);',
+    '$mod.s = "foo".anchor($mod.s);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_CallClassFunctionOfInstanceFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSString = class external name ''String''');
+  Add('    class function fromCharCode() : string; varargs;');
+  Add('  end;');
+  Add('var');
+  Add('  s: string;');
+  Add('  sObj: TJSString;');
+  Add('begin');
+  Add('  s:=sObj.fromCharCode(65,66);');
+  SetExpectedPasResolverError('External class instance cannot access static class function fromCharCode',
+    nExternalClassInstanceCannotAccessStaticX);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    function GetItems(Index: longint): jsvalue; external name ''[]'';');
+  Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
+  Add('    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('procedure DoIt(vI: JSValue; const vJ: jsvalue; var vK: jsvalue; out vL: jsvalue);');
+  Add('begin end;');
+  Add('var');
+  Add('  Arr: tjsarray;');
+  Add('  s: string;');
+  Add('  i: longint;');
+  Add('  v: jsvalue;');
+  Add('begin');
+  Add('  v:=arr[0];');
+  Add('  v:=arr.items[1];');
+  Add('  arr[2]:=s;');
+  Add('  arr.items[3]:=s;');
+  Add('  arr[4]:=i;');
+  Add('  arr[5]:=arr[6];');
+  Add('  arr.items[7]:=arr.items[8];');
+  Add('  with arr do items[9]:=items[10];');
+  Add('  doit(arr[7],arr[8],arr[9],arr[10]);');
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor',
+    LinesToStr([ // statements
+    'this.DoIt = function (vI, vJ, vK, vL) {',
+    '};',
+    'this.Arr = null;',
+    'this.s = "";',
+    'this.i = 0;',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.Arr[0];',
+    '$mod.v = $mod.Arr[1];',
+    '$mod.Arr[2] = $mod.s;',
+    '$mod.Arr[3] = $mod.s;',
+    '$mod.Arr[4] = $mod.i;',
+    '$mod.Arr[5] = $mod.Arr[6];',
+    '$mod.Arr[7] = $mod.Arr[8];',
+    'var $with1 = $mod.Arr;',
+    '$with1[9] = $with1[10];',
+    '$mod.DoIt($mod.Arr[7], $mod.Arr[8], {',
+    '  a: 9,',
+    '  p: $mod.Arr,',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '}, {',
+    '  a: 10,',
+    '  p: $mod.Arr,',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor_2ParamsFail;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    function GetItems(Index1, Index2: longint): jsvalue; external name ''[]'';');
+  Add('    procedure SetItems(Index1, Index2: longint; Value: jsvalue); external name ''[]'';');
+  Add('    property Items[Index1, Index2: longint]: jsvalue read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError(sBracketAccessorOfExternalClassMustHaveOneParameter,
+    nBracketAccessorOfExternalClassMustHaveOneParameter);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor_ReadOnly;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    function GetItems(Index: longint): jsvalue; external name ''[]'';');
+  Add('    property Items[Index: longint]: jsvalue read GetItems; default;');
+  Add('  end;');
+  Add('procedure DoIt(vI: JSValue; const vJ: jsvalue);');
+  Add('begin end;');
+  Add('var');
+  Add('  Arr: tjsarray;');
+  Add('  v: jsvalue;');
+  Add('begin');
+  Add('  v:=arr[0];');
+  Add('  v:=arr.items[1];');
+  Add('  with arr do v:=items[2];');
+  Add('  doit(arr[3],arr[4]);');
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor_ReadOnly',
+    LinesToStr([ // statements
+    'this.DoIt = function (vI, vJ) {',
+    '};',
+    'this.Arr = null;',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.Arr[0];',
+    '$mod.v = $mod.Arr[1];',
+    'var $with1 = $mod.Arr;',
+    '$mod.v = $with1[2];',
+    '$mod.DoIt($mod.Arr[3], $mod.Arr[4]);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor_WriteOnly;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
+  Add('    property Items[Index: longint]: jsvalue write SetItems; default;');
+  Add('  end;');
+  Add('var');
+  Add('  Arr: tjsarray;');
+  Add('  s: string;');
+  Add('  i: longint;');
+  Add('  v: jsvalue;');
+  Add('begin');
+  Add('  arr[2]:=s;');
+  Add('  arr.items[3]:=s;');
+  Add('  arr[4]:=i;');
+  Add('  with arr do items[5]:=i;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor_WriteOnly',
+    LinesToStr([ // statements
+    'this.Arr = null;',
+    'this.s = "";',
+    'this.i = 0;',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr[2] = $mod.s;',
+    '$mod.Arr[3] = $mod.s;',
+    '$mod.Arr[4] = $mod.i;',
+    'var $with1 = $mod.Arr;',
+    '$with1[5] = $mod.i;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor_MultiType;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
+  Add('    property Items[Index: longint]: jsvalue write SetItems; default;');
+  Add('    procedure SetNumbers(Index: longint; Value: longint); external name ''[]'';');
+  Add('    property Numbers[Index: longint]: longint write SetNumbers;');
+  Add('  end;');
+  Add('var');
+  Add('  Arr: tjsarray;');
+  Add('  s: string;');
+  Add('  i: longint;');
+  Add('  v: jsvalue;');
+  Add('begin');
+  Add('  arr[2]:=s;');
+  Add('  arr.items[3]:=s;');
+  Add('  arr.numbers[4]:=i;');
+  Add('  with arr do items[5]:=i;');
+  Add('  with arr do numbers[6]:=i;');
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor_MultiType',
+    LinesToStr([ // statements
+    'this.Arr = null;',
+    'this.s = "";',
+    'this.i = 0;',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr[2] = $mod.s;',
+    '$mod.Arr[3] = $mod.s;',
+    '$mod.Arr[4] = $mod.i;',
+    'var $with1 = $mod.Arr;',
+    '$with1[5] = $mod.i;',
+    'var $with2 = $mod.Arr;',
+    '$with2[6] = $mod.i;',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_BracketAccessor_Index;
+begin
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TJSArray = class external name ''Array2''');
+  Add('    function GetItems(Index: longint): jsvalue; external name ''[]'';');
+  Add('    procedure SetItems(Index: longint; Value: jsvalue); external name ''[]'';');
+  Add('    property Items[Index: longint]: jsvalue read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('var');
+  Add('  Arr: tjsarray;');
+  Add('  i: longint;');
+  Add('  IntArr: array of longint;');
+  Add('  v: jsvalue;');
+  Add('begin');
+  Add('  v:=arr.items[i];');
+  Add('  arr[longint(v)]:=arr.items[intarr[0]];');
+  Add('  arr.items[intarr[1]]:=arr[IntArr[2]];');
+  ConvertProgram;
+  CheckSource('TestExternalClass_BracketAccessor_Index',
+    LinesToStr([ // statements
+    'this.Arr = null;',
+    'this.i = 0;',
+    'this.IntArr = [];',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.Arr[$mod.i];',
+    '$mod.Arr[Math.floor($mod.v)] = $mod.Arr[$mod.IntArr[0]];',
+    '$mod.Arr[$mod.IntArr[1]] = $mod.Arr[$mod.IntArr[2]];',
+    '']));
+end;
+
+procedure TTestModule.TestProcType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TProcInt = procedure(vI: longint = 1);');
+  Add('procedure DoIt(vJ: longint);');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tprocint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;');
+  Add('  vp;');
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:=vp=nil;');
+  Add('  b:=nil=vp;');
+  Add('  b:=vp=vq;');
+  Add('  b:=vp=@doit;');
+  Add('  b:=@doit=vp;');
+  Add('  b:=vp<>nil;');
+  Add('  b:=nil<>vp;');
+  Add('  b:=vp<>vq;');
+  Add('  b:=vp<>@doit;');
+  Add('  b:=@doit<>vp;');
+  Add('  b:=Assigned(vp);');
+  Add('  if Assigned(vp) then ;');
+  ConvertProgram;
+  CheckSource('TestProcType',
+    LinesToStr([ // statements
+    'this.DoIt = function(vJ) {',
+    '};',
+    'this.b = false;',
+    'this.vP = null;',
+    'this.vQ = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.vP = null;',
+    '$mod.vP = $mod.vP;',
+    '$mod.vP = $mod.DoIt;',
+    '$mod.vP(1);',
+    '$mod.vP(1);',
+    '$mod.vP(2);',
+    '$mod.b = $mod.vP == null;',
+    '$mod.b = null == $mod.vP;',
+    '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
+    '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
+    '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
+    '$mod.b = $mod.vP != null;',
+    '$mod.b = null != $mod.vP;',
+    '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
+    '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
+    '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
+    '$mod.b = $mod.vP != null;',
+    'if ($mod.vP != null) ;',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_FunctionFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('function DoIt(vI: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tfuncint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;'); // ok in fpc and delphi
+  //Add('  vp:=doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
+  Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
+  Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
+  Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
+  Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
+  Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
+  Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=Assigned(vp);');
+  //Add('  doit(vp);'); // illegal in fpc, ok in delphi
+  Add('  doit(vp());'); // ok in fpc and delphi
+  Add('  doit(vp(2));'); // ok in fpc and delphi
+  ConvertProgram;
+  CheckSource('TestProcType_FunctionFPC',
+    LinesToStr([ // statements
+    'this.DoIt = function(vI) {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    'this.b = false;',
+    'this.vP = null;',
+    'this.vQ = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.vP = null;',
+    '$mod.vP = $mod.vP;',
+    '$mod.vP = $mod.DoIt;',
+    '$mod.vP(1);',
+    '$mod.vP(1);',
+    '$mod.vP(2);',
+    '$mod.b = $mod.vP == null;',
+    '$mod.b = null == $mod.vP;',
+    '$mod.b = rtl.eqCallback($mod.vP,$mod.vQ);',
+    '$mod.b = rtl.eqCallback($mod.vP, $mod.DoIt);',
+    '$mod.b = rtl.eqCallback($mod.DoIt, $mod.vP);',
+    '$mod.b = 4 == $mod.vP(1);',
+    '$mod.b = $mod.vP != null;',
+    '$mod.b = null != $mod.vP;',
+    '$mod.b = !rtl.eqCallback($mod.vP,$mod.vQ);',
+    '$mod.b = !rtl.eqCallback($mod.vP, $mod.DoIt);',
+    '$mod.b = !rtl.eqCallback($mod.DoIt, $mod.vP);',
+    '$mod.b = 6 != $mod.vP(1);',
+    '$mod.b = $mod.vP != null;',
+    '$mod.DoIt($mod.vP(1));',
+    '$mod.DoIt($mod.vP(2));',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_FunctionDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode Delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('function DoIt(vI: longint): longint;');
+  Add('begin end;');
+  Add('var');
+  Add('  b: boolean;');
+  Add('  vP, vQ: tfuncint;');
+  Add('begin');
+  Add('  vp:=nil;');
+  Add('  vp:=vp;');
+  Add('  vp:=@doit;'); // ok in fpc and delphi
+  Add('  vp:=doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  //Add('  b:=vp=nil;'); // ok in fpc, illegal in delphi
+  //Add('  b:=nil=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=vq;'); // in fpc compare proctypes, in delphi compare results
+  //Add('  b:=vp=@doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@doit=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp=3;'); // illegal in fpc, ok in delphi
+  Add('  b:=4=vp;'); // illegal in fpc, ok in delphi
+  //Add('  b:=vp<>nil;'); // ok in fpc, illegal in delphi
+  //Add('  b:=nil<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>vq;'); // in fpc compare proctypes, in delphi compare results
+  //Add('  b:=vp<>@doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@doit<>vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>5;'); // illegal in fpc, ok in delphi
+  Add('  b:=6<>vp;'); // illegal in fpc, ok in delphi
+  Add('  b:=Assigned(vp);');
+  Add('  doit(vp);'); // illegal in fpc, ok in delphi
+  Add('  doit(vp());'); // ok in fpc and delphi
+  Add('  doit(vp(2));'); // ok in fpc and delphi  *)
+  ConvertProgram;
+  CheckSource('TestProcType_FunctionDelphi',
+    LinesToStr([ // statements
+    'this.DoIt = function(vI) {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
+    'this.b = false;',
+    'this.vP = null;',
+    'this.vQ = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.vP = null;',
+    '$mod.vP = $mod.vP;',
+    '$mod.vP = $mod.DoIt;',
+    '$mod.vP = $mod.DoIt;',
+    '$mod.vP(1);',
+    '$mod.vP(1);',
+    '$mod.vP(2);',
+    '$mod.b = $mod.vP(1) == $mod.vQ(1);',
+    '$mod.b = $mod.vP(1) == 3;',
+    '$mod.b = 4 == $mod.vP(1);',
+    '$mod.b = $mod.vP(1) != $mod.vQ(1);',
+    '$mod.b = $mod.vP(1) != 5;',
+    '$mod.b = 6 != $mod.vP(1);',
+    '$mod.b = $mod.vP != null;',
+    '$mod.DoIt($mod.vP(1));',
+    '$mod.DoIt($mod.vP(1));',
+    '$mod.DoIt($mod.vP(2));',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_AsParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint;');
+  Add('procedure DoIt(vG: tfuncint; const vH: tfuncint; var vI: tfuncint);');
+  Add('var vJ: tfuncint;');
+  Add('begin');
+  Add('  vg:=vg;');
+  Add('  vj:=vh;');
+  Add('  vi:=vi;');
+  Add('  doit(vg,vg,vg);');
+  Add('  doit(vh,vh,vj);');
+  Add('  doit(vi,vi,vi);');
+  Add('  doit(vj,vj,vj);');
+  Add('end;');
+  Add('var i: tfuncint;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestProcType_AsParam',
+    LinesToStr([ // statements
+    'this.DoIt = function (vG,vH,vI) {',
+    '  var vJ = null;',
+    '  vG = vG;',
+    '  vJ = vH;',
+    '  vI.set(vI.get());',
+    '  $mod.DoIt(vG, vG, {',
+    '    get: function () {',
+    '      return vG;',
+    '    },',
+    '    set: function (v) {',
+    '      vG = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vH, vH, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '  $mod.DoIt(vI.get(), vI.get(), vI);',
+    '  $mod.DoIt(vJ, vJ, {',
+    '    get: function () {',
+    '      return vJ;',
+    '    },',
+    '    set: function (v) {',
+    '      vJ = v;',
+    '    }',
+    '  });',
+    '};',
+    'this.i = null;'
+    ]),
+    LinesToStr([
+    '$mod.DoIt($mod.i,$mod.i,{',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});'
+    ]));
+end;
+
+procedure TTestModule.TestProcType_MethodFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('  end;');
+  Add('function TObject.DoIt(vA: longint = 1): longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  vp:=@obj.doit;'); // ok in fpc and delphi
+  //Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  Add('  b:=vp=@obj.doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@obj.doit=vp;'); // ok in fpc, illegal in delphi
+  Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
+  Add('  b:=@obj.doit<>vp;'); // ok in fpc, illegal in delphi
+  ConvertProgram;
+  CheckSource('TestProcType_MethodFPC',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (vA) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.vP = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
+    '$mod.vP(1);',
+    '$mod.vP(1);',
+    '$mod.vP(2);',
+    '$mod.b = rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
+    '$mod.b = !rtl.eqCallback($mod.vP, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = !rtl.eqCallback(rtl.createCallback($mod.Obj, "DoIt"), $mod.vP);',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_MethodDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('  end;');
+  Add('function TObject.DoIt(vA: longint = 1): longint;');
+  Add('begin');
+  Add('end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  vp:=@obj.doit;'); // ok in fpc and delphi
+  Add('  vp:=obj.doit;'); // illegal in fpc, ok in delphi
+  Add('  vp;'); // ok in fpc and delphi
+  Add('  vp();');
+  Add('  vp(2);');
+  //Add('  b:=vp=@obj.doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@obj.doit=vp;'); // ok in fpc, illegal in delphi
+  //Add('  b:=vp<>@obj.doit;'); // ok in fpc, illegal in delphi
+  //Add('  b:=@obj.doit<>vp;'); // ok in fpc, illegal in delphi
+  ConvertProgram;
+  CheckSource('TestProcType_MethodDelphi',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (vA) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.vP = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
+    '$mod.vP = rtl.createCallback($mod.Obj, "DoIt");',
+    '$mod.vP(1);',
+    '$mod.vP(1);',
+    '$mod.vP(2);',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_PropertyFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    FOnFoo: TFuncInt;');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('    function GetFoo: TFuncInt;');
+  Add('    procedure SetFoo(const Value: TFuncInt);');
+  Add('    function GetEvents(Index: longint): TFuncInt;');
+  Add('    procedure SetEvents(Index: longint; const Value: TFuncInt);');
+  Add('    property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
+  Add('    property OnBar: TFuncInt read GetFoo write SetFoo;');
+  Add('    property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
+  Add('  end;');
+  Add('function tobject.doit(va: longint = 1): longint; begin end;');
+  Add('function tobject.getfoo: tfuncint; begin end;');
+  Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
+  Add('function tobject.getevents(index: longint): tfuncint; begin end;');
+  Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  obj.onfoo:=nil;');
+  Add('  obj.onbar:=nil;');
+  Add('  obj.events[1]:=nil;');
+  Add('  obj.onfoo:=obj.onfoo;');
+  Add('  obj.onbar:=obj.onbar;');
+  Add('  obj.events[2]:=obj.events[3];');
+  Add('  obj.onfoo:=@obj.doit;');
+  Add('  obj.onbar:=@obj.doit;');
+  Add('  obj.events[4]:=@obj.doit;');
+  //Add('  obj.onfoo:=obj.doit;'); // delphi
+  //Add('  obj.onbar:=obj.doit;'); // delphi
+  //Add('  obj.events[4]:=obj.doit;'); // delphi
+  Add('  obj.onfoo;');
+  Add('  obj.onbar;');
+  //Add('  obj.events[5];'); ToDo in pasresolver
+  Add('  obj.onfoo();');
+  Add('  obj.onbar();');
+  Add('  obj.events[6]();');
+  Add('  b:=obj.onfoo=nil;');
+  Add('  b:=obj.onbar=nil;');
+  Add('  b:=obj.events[7]=nil;');
+  Add('  b:=obj.onfoo<>nil;');
+  Add('  b:=obj.onbar<>nil;');
+  Add('  b:=obj.events[8]<>nil;');
+  Add('  b:=obj.onfoo=vp;');
+  Add('  b:=obj.onbar=vp;');
+  Add('  b:=obj.events[9]=vp;');
+  Add('  b:=obj.onfoo=obj.onfoo;');
+  Add('  b:=obj.onbar=obj.onfoo;');
+  Add('  b:=obj.events[10]=obj.onfoo;');
+  Add('  b:=obj.onfoo<>obj.onfoo;');
+  Add('  b:=obj.onbar<>obj.onfoo;');
+  Add('  b:=obj.events[11]<>obj.onfoo;');
+  Add('  b:=obj.onfoo=@obj.doit;');
+  Add('  b:=obj.onbar=@obj.doit;');
+  Add('  b:=obj.events[12]=@obj.doit;');
+  Add('  b:=obj.onfoo<>@obj.doit;');
+  Add('  b:=obj.onbar<>@obj.doit;');
+  Add('  b:=obj.events[12]<>@obj.doit;');
+  Add('  b:=Assigned(obj.onfoo);');
+  Add('  b:=Assigned(obj.onbar);');
+  Add('  b:=Assigned(obj.events[13]);');
+  ConvertProgram;
+  CheckSource('TestProcType_PropertyFPC',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FOnFoo = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FOnFoo = undefined;',
+    '  };',
+    '  this.DoIt = function (vA) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    'this.GetFoo = function () {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.SetFoo = function (Value) {',
+    '};',
+    'this.GetEvents = function (Index) {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.SetEvents = function (Index, Value) {',
+    '};',
+    '});',
+    'this.Obj = null;',
+    'this.vP = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    '$mod.Obj.FOnFoo = null;',
+    '$mod.Obj.SetFoo(null);',
+    '$mod.Obj.SetEvents(1, null);',
+    '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
+    '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
+    '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
+    '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
+    '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.Obj.FOnFoo(1);',
+    '$mod.Obj.GetFoo();',
+    '$mod.Obj.FOnFoo(1);',
+    '$mod.Obj.GetFoo()(1);',
+    '$mod.Obj.GetEvents(6)(1);',
+    '$mod.b = $mod.Obj.FOnFoo == null;',
+    '$mod.b = $mod.Obj.GetFoo() == null;',
+    '$mod.b = $mod.Obj.GetEvents(7) == null;',
+    '$mod.b = $mod.Obj.FOnFoo != null;',
+    '$mod.b = $mod.Obj.GetFoo() != null;',
+    '$mod.b = $mod.Obj.GetEvents(8) != null;',
+    '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.vP);',
+    '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.vP);',
+    '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(9), $mod.vP);',
+    '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
+    '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
+    '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(10), $mod.Obj.FOnFoo);',
+    '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, $mod.Obj.FOnFoo);',
+    '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), $mod.Obj.FOnFoo);',
+    '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(11), $mod.Obj.FOnFoo);',
+    '$mod.b = rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = !rtl.eqCallback($mod.Obj.FOnFoo, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = !rtl.eqCallback($mod.Obj.GetFoo(), rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = !rtl.eqCallback($mod.Obj.GetEvents(12), rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.b = $mod.Obj.FOnFoo != null;',
+    '$mod.b = $mod.Obj.GetFoo() != null;',
+    '$mod.b = $mod.Obj.GetEvents(13) != null;',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_PropertyDelphi;
+begin
+  StartProgram(false);
+  Add('{$mode delphi}');
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    FOnFoo: TFuncInt;');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('    function GetFoo: TFuncInt;');
+  Add('    procedure SetFoo(const Value: TFuncInt);');
+  Add('    function GetEvents(Index: longint): TFuncInt;');
+  Add('    procedure SetEvents(Index: longint; const Value: TFuncInt);');
+  Add('    property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
+  Add('    property OnBar: TFuncInt read GetFoo write SetFoo;');
+  Add('    property Events[Index: longint]: TFuncInt read GetEvents write SetEvents; default;');
+  Add('  end;');
+  Add('function tobject.doit(va: longint = 1): longint; begin end;');
+  Add('function tobject.getfoo: tfuncint; begin end;');
+  Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
+  Add('function tobject.getevents(index: longint): tfuncint; begin end;');
+  Add('procedure tobject.setevents(index: longint; const value: tfuncint); begin end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('  obj.onfoo:=nil;');
+  Add('  obj.onbar:=nil;');
+  Add('  obj.events[1]:=nil;');
+  Add('  obj.onfoo:=obj.onfoo;');
+  Add('  obj.onbar:=obj.onbar;');
+  Add('  obj.events[2]:=obj.events[3];');
+  Add('  obj.onfoo:=@obj.doit;');
+  Add('  obj.onbar:=@obj.doit;');
+  Add('  obj.events[4]:=@obj.doit;');
+  Add('  obj.onfoo:=obj.doit;'); // delphi
+  Add('  obj.onbar:=obj.doit;'); // delphi
+  Add('  obj.events[4]:=obj.doit;'); // delphi
+  Add('  obj.onfoo;');
+  Add('  obj.onbar;');
+  //Add('  obj.events[5];'); ToDo in pasresolver
+  Add('  obj.onfoo();');
+  Add('  obj.onbar();');
+  Add('  obj.events[6]();');
+  //Add('  b:=obj.onfoo=nil;'); // fpc
+  //Add('  b:=obj.onbar=nil;'); // fpc
+  //Add('  b:=obj.events[7]=nil;'); // fpc
+  //Add('  b:=obj.onfoo<>nil;'); // fpc
+  //Add('  b:=obj.onbar<>nil;'); // fpc
+  //Add('  b:=obj.events[8]<>nil;'); // fpc
+  Add('  b:=obj.onfoo=vp;');
+  Add('  b:=obj.onbar=vp;');
+  //Add('  b:=obj.events[9]=vp;'); ToDo in pasresolver
+  Add('  b:=obj.onfoo=obj.onfoo;');
+  Add('  b:=obj.onbar=obj.onfoo;');
+  //Add('  b:=obj.events[10]=obj.onfoo;'); // ToDo in pasresolver
+  Add('  b:=obj.onfoo<>obj.onfoo;');
+  Add('  b:=obj.onbar<>obj.onfoo;');
+  //Add('  b:=obj.events[11]<>obj.onfoo;'); // ToDo in pasresolver
+  //Add('  b:=obj.onfoo=@obj.doit;'); // fpc
+  //Add('  b:=obj.onbar=@obj.doit;'); // fpc
+  //Add('  b:=obj.events[12]=@obj.doit;'); // fpc
+  //Add('  b:=obj.onfoo<>@obj.doit;'); // fpc
+  //Add('  b:=obj.onbar<>@obj.doit;'); // fpc
+  //Add('  b:=obj.events[12]<>@obj.doit;'); // fpc
+  Add('  b:=Assigned(obj.onfoo);');
+  Add('  b:=Assigned(obj.onbar);');
+  Add('  b:=Assigned(obj.events[13]);');
+  ConvertProgram;
+  CheckSource('TestProcType_PropertyDelphi',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FOnFoo = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FOnFoo = undefined;',
+    '  };',
+    '  this.DoIt = function (vA) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    'this.GetFoo = function () {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.SetFoo = function (Value) {',
+    '};',
+    'this.GetEvents = function (Index) {',
+    '  var Result = null;',
+    '  return Result;',
+    '};',
+    'this.SetEvents = function (Index, Value) {',
+    '};',
+    '});',
+    'this.Obj = null;',
+    'this.vP = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    '$mod.Obj.FOnFoo = null;',
+    '$mod.Obj.SetFoo(null);',
+    '$mod.Obj.SetEvents(1, null);',
+    '$mod.Obj.FOnFoo = $mod.Obj.FOnFoo;',
+    '$mod.Obj.SetFoo($mod.Obj.GetFoo());',
+    '$mod.Obj.SetEvents(2, $mod.Obj.GetEvents(3));',
+    '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
+    '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.Obj.FOnFoo = rtl.createCallback($mod.Obj, "DoIt");',
+    '$mod.Obj.SetFoo(rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.Obj.SetEvents(4, rtl.createCallback($mod.Obj, "DoIt"));',
+    '$mod.Obj.FOnFoo(1);',
+    '$mod.Obj.GetFoo();',
+    '$mod.Obj.FOnFoo(1);',
+    '$mod.Obj.GetFoo()(1);',
+    '$mod.Obj.GetEvents(6)(1);',
+    '$mod.b = $mod.Obj.FOnFoo(1) == $mod.vP(1);',
+    '$mod.b = $mod.Obj.GetFoo() == $mod.vP(1);',
+    '$mod.b = $mod.Obj.FOnFoo(1) == $mod.Obj.FOnFoo(1);',
+    '$mod.b = $mod.Obj.GetFoo() == $mod.Obj.FOnFoo(1);',
+    '$mod.b = $mod.Obj.FOnFoo(1) != $mod.Obj.FOnFoo(1);',
+    '$mod.b = $mod.Obj.GetFoo() != $mod.Obj.FOnFoo(1);',
+    '$mod.b = $mod.Obj.FOnFoo != null;',
+    '$mod.b = $mod.Obj.GetFoo() != null;',
+    '$mod.b = $mod.Obj.GetEvents(13) != null;',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_WithClassInstDoPropertyFPC;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TFuncInt = function(vA: longint = 1): longint of object;');
+  Add('  TObject = class');
+  Add('    FOnFoo: TFuncInt;');
+  Add('    function DoIt(vA: longint = 1): longint;');
+  Add('    function GetFoo: TFuncInt;');
+  Add('    procedure SetFoo(const Value: TFuncInt);');
+  Add('    property OnFoo: TFuncInt read FOnFoo write FOnFoo;');
+  Add('    property OnBar: TFuncInt read GetFoo write SetFoo;');
+  Add('  end;');
+  Add('function tobject.doit(va: longint = 1): longint; begin end;');
+  Add('function tobject.getfoo: tfuncint; begin end;');
+  Add('procedure tobject.setfoo(const value: tfuncint); begin end;');
+  Add('var');
+  Add('  Obj: TObject;');
+  Add('  vP: tfuncint;');
+  Add('  b: boolean;');
+  Add('begin');
+  Add('with obj do begin');
+  Add('  fonfoo:=nil;');
+  Add('  onfoo:=nil;');
+  Add('  onbar:=nil;');
+  Add('  fonfoo:=fonfoo;');
+  Add('  onfoo:=onfoo;');
+  Add('  onbar:=onbar;');
+  Add('  fonfoo:=@doit;');
+  Add('  onfoo:=@doit;');
+  Add('  onbar:=@doit;');
+  //Add('  fonfoo:=doit;'); // delphi
+  //Add('  onfoo:=doit;'); // delphi
+  //Add('  onbar:=doit;'); // delphi
+  Add('  fonfoo;');
+  Add('  onfoo;');
+  Add('  onbar;');
+  Add('  fonfoo();');
+  Add('  onfoo();');
+  Add('  onbar();');
+  Add('  b:=fonfoo=nil;');
+  Add('  b:=onfoo=nil;');
+  Add('  b:=onbar=nil;');
+  Add('  b:=fonfoo<>nil;');
+  Add('  b:=onfoo<>nil;');
+  Add('  b:=onbar<>nil;');
+  Add('  b:=fonfoo=vp;');
+  Add('  b:=onfoo=vp;');
+  Add('  b:=onbar=vp;');
+  Add('  b:=fonfoo=fonfoo;');
+  Add('  b:=onfoo=onfoo;');
+  Add('  b:=onbar=onfoo;');
+  Add('  b:=fonfoo<>fonfoo;');
+  Add('  b:=onfoo<>onfoo;');
+  Add('  b:=onbar<>onfoo;');
+  Add('  b:=fonfoo=@doit;');
+  Add('  b:=onfoo=@doit;');
+  Add('  b:=onbar=@doit;');
+  Add('  b:=fonfoo<>@doit;');
+  Add('  b:=onfoo<>@doit;');
+  Add('  b:=onbar<>@doit;');
+  Add('  b:=Assigned(fonfoo);');
+  Add('  b:=Assigned(onfoo);');
+  Add('  b:=Assigned(onbar);');
+  Add('end;');
+  ConvertProgram;
+  CheckSource('TestProcType_WithClassInstDoPropertyFPC',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FOnFoo = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FOnFoo = undefined;',
+    '  };',
+    '  this.DoIt = function (vA) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.GetFoo = function () {',
+    '    var Result = null;',
+    '    return Result;',
+    '  };',
+    '  this.SetFoo = function (Value) {',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.vP = null;',
+    'this.b = false;'
+    ]),
+    LinesToStr([
+    'var $with1 = $mod.Obj;',
+    '$with1.FOnFoo = null;',
+    '$with1.FOnFoo = null;',
+    '$with1.SetFoo(null);',
+    '$with1.FOnFoo = $with1.FOnFoo;',
+    '$with1.FOnFoo = $with1.FOnFoo;',
+    '$with1.SetFoo($with1.GetFoo());',
+    '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
+    '$with1.FOnFoo = rtl.createCallback($with1, "DoIt");',
+    '$with1.SetFoo(rtl.createCallback($with1, "DoIt"));',
+    '$with1.FOnFoo(1);',
+    '$with1.FOnFoo(1);',
+    '$with1.GetFoo();',
+    '$with1.FOnFoo(1);',
+    '$with1.FOnFoo(1);',
+    '$with1.GetFoo()(1);',
+    '$mod.b = $with1.FOnFoo == null;',
+    '$mod.b = $with1.FOnFoo == null;',
+    '$mod.b = $with1.GetFoo() == null;',
+    '$mod.b = $with1.FOnFoo != null;',
+    '$mod.b = $with1.FOnFoo != null;',
+    '$mod.b = $with1.GetFoo() != null;',
+    '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
+    '$mod.b = rtl.eqCallback($with1.FOnFoo, $mod.vP);',
+    '$mod.b = rtl.eqCallback($with1.GetFoo(), $mod.vP);',
+    '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
+    '$mod.b = rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
+    '$mod.b = rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
+    '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
+    '$mod.b = !rtl.eqCallback($with1.FOnFoo, $with1.FOnFoo);',
+    '$mod.b = !rtl.eqCallback($with1.GetFoo(), $with1.FOnFoo);',
+    '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
+    '$mod.b = rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
+    '$mod.b = rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
+    '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
+    '$mod.b = !rtl.eqCallback($with1.FOnFoo, rtl.createCallback($with1, "DoIt"));',
+    '$mod.b = !rtl.eqCallback($with1.GetFoo(), rtl.createCallback($with1, "DoIt"));',
+    '$mod.b = $with1.FOnFoo != null;',
+    '$mod.b = $with1.FOnFoo != null;',
+    '$mod.b = $with1.GetFoo() != null;',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_Nested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProcInt = procedure(vI: longint = 1);',
+  'procedure DoIt(vJ: longint);',
+  'var aProc: TProcInt;',
+  '    b: boolean;',
+  '  procedure Sub(vK: longint);',
+  '  var aSub: TProcInt;',
+  '    procedure SubSub(vK: longint);',
+  '    var aSubSub: TProcInt;',
+  '    begin;',
+  '      aProc:=@DoIt;',
+  '      aSub:=@DoIt;',
+  '      aSubSub:=@DoIt;',
+  '      aProc:=@Sub;',
+  '      aSub:=@Sub;',
+  '      aSubSub:=@Sub;',
+  '      aProc:=@SubSub;',
+  '      aSub:=@SubSub;',
+  '      aSubSub:=@SubSub;',
+  '    end;',
+  '  begin;',
+  '  end;',
+  'begin;',
+  '  aProc:=@Sub;',
+  '  b:=aProc=@Sub;',
+  '  b:=@Sub=aProc;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_Nested',
+    LinesToStr([ // statements
+    'this.DoIt = function (vJ) {',
+    '  var aProc = null;',
+    '  var b = false;',
+    '  function Sub(vK) {',
+    '    var aSub = null;',
+    '    function SubSub(vK) {',
+    '      var aSubSub = null;',
+    '      aProc = $mod.DoIt;',
+    '      aSub = $mod.DoIt;',
+    '      aSubSub = $mod.DoIt;',
+    '      aProc = Sub;',
+    '      aSub = Sub;',
+    '      aSubSub = Sub;',
+    '      aProc = SubSub;',
+    '      aSub = SubSub;',
+    '      aSubSub = SubSub;',
+    '    };',
+    '  };',
+    '  aProc = Sub;',
+    '  b = rtl.eqCallback(aProc, Sub);',
+    '  b = rtl.eqCallback(Sub, aProc);',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestProcType_NestedOfObject;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProcInt = procedure(vI: longint = 1) of object;',
+  '  TObject = class',
+  '    procedure DoIt(vJ: longint);',
+  '  end;',
+  'procedure TObject.DoIt(vJ: longint);',
+  'var aProc: TProcInt;',
+  '    b: boolean;',
+  '  procedure Sub(vK: longint);',
+  '  var aSub: TProcInt;',
+  '    procedure SubSub(vK: longint);',
+  '    var aSubSub: TProcInt;',
+  '    begin;',
+  '      aProc:=@DoIt;',
+  '      aSub:=@DoIt;',
+  '      aSubSub:=@DoIt;',
+  '      aProc:=@Sub;',
+  '      aSub:=@Sub;',
+  '      aSubSub:=@Sub;',
+  '      aProc:=@SubSub;',
+  '      aSub:=@SubSub;',
+  '      aSubSub:=@SubSub;',
+  '    end;',
+  '  begin;',
+  '  end;',
+  'begin;',
+  '  aProc:=@Sub;',
+  '  b:=aProc=@Sub;',
+  '  b:=@Sub=aProc;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_Nested',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function (vJ) {',
+    '    var Self = this;',
+    '    var aProc = null;',
+    '    var b = false;',
+    '    function Sub(vK) {',
+    '      var aSub = null;',
+    '      function SubSub(vK) {',
+    '        var aSubSub = null;',
+    '        aProc = rtl.createCallback(Self, "DoIt");',
+    '        aSub = rtl.createCallback(Self, "DoIt");',
+    '        aSubSub = rtl.createCallback(Self, "DoIt");',
+    '        aProc = Sub;',
+    '        aSub = Sub;',
+    '        aSubSub = Sub;',
+    '        aProc = SubSub;',
+    '        aSub = SubSub;',
+    '        aSubSub = SubSub;',
+    '      };',
+    '    };',
+    '    aProc = Sub;',
+    '    b = rtl.eqCallback(aProc, Sub);',
+    '    b = rtl.eqCallback(Sub, aProc);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestProcType_ReferenceToProc;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProcRef = reference to procedure(i: longint = 0);',
+  '  TFuncRef = reference to function(i: longint = 0): longint;',
+  'var',
+  '  p: TProcRef;',
+  '  f: TFuncRef;',
+  'procedure DoIt(i: longint);',
+  'begin',
+  'end;',
+  'function GetIt(i: longint): longint;',
+  'begin',
+  '  p:=@DoIt;',
+  '  f:=@GetIt;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  'end;',
+  'begin',
+  '  p:=@DoIt;',
+  '  f:=@GetIt;',
+  '  f;',
+  '  f();',
+  '  f(1);',
+  '  p:=TProcRef(f);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_ReferenceToProc',
+    LinesToStr([ // statements
+    'this.p = null;',
+    'this.f = null;',
+    'this.DoIt = function (i) {',
+    '};',
+    'this.GetIt = function (i) {',
+    '  var Result = 0;',
+    '  $mod.p = $mod.DoIt;',
+    '  $mod.f = $mod.GetIt;',
+    '  $mod.f(0);',
+    '  $mod.f(0);',
+    '  $mod.f(1);',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.DoIt;',
+    '$mod.f = $mod.GetIt;',
+    '$mod.f(0);',
+    '$mod.f(0);',
+    '$mod.f(1);',
+    '$mod.p = $mod.f;',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_ReferenceToMethod;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TFuncRef = reference to function(i: longint = 5): longint;',
+  '  TObject = class',
+  '    function Grow(s: longint): longint;',
+  '  end;',
+  'var',
+  '  f: tfuncref;',
+  'function tobject.grow(s: longint): longint;',
+  '  function GrowSub(i: longint): longint;',
+  '  begin',
+  '    f:=@grow;',
+  '    f:=@growsub;',
+  '  end;',
+  'begin',
+  '  f:=@grow;',
+  '  f:=@growsub;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_ReferenceToMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Grow = function (s) {',
+    '    var Self = this;',
+    '    var Result = 0;',
+    '    function GrowSub(i) {',
+    '      var Result = 0;',
+    '      $mod.f = rtl.createCallback(Self, "Grow");',
+    '      $mod.f = GrowSub;',
+    '      return Result;',
+    '    };',
+    '    $mod.f = rtl.createCallback(Self, "Grow");',
+    '    $mod.f = GrowSub;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.f = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestProcType_Typecast;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TNotifyEvent = procedure(Sender: Pointer) of object;',
+  '  TEvent = procedure of object;',
+  '  TGetter = function:longint of object;',
+  '  TProcA = procedure(i: longint);',
+  '  TFuncB = function(i, j: longint): longint;',
+  'procedure DoIt(); varargs; begin end;',
+  'var',
+  '  Notify: tnotifyevent;',
+  '  Event: tevent;',
+  '  Getter: tgetter;',
+  '  ProcA: tproca;',
+  '  FuncB: tfuncb;',
+  '  p: pointer;',
+  'begin',
+  '  notify:=tnotifyevent(event);',
+  '  event:=tevent(event);',
+  '  event:=tevent(notify);',
+  '  event:=tevent(getter);',
+  '  event:=tevent(proca);',
+  '  proca:=tproca(funcb);',
+  '  funcb:=tfuncb(funcb);',
+  '  funcb:=tfuncb(proca);',
+  '  funcb:=tfuncb(getter);',
+  '  proca:=tproca(p);',
+  '  funcb:=tfuncb(p);',
+  '  getter:=tgetter(p);',
+  '  p:=pointer(notify);',
+  '  p:=notify;',
+  '  p:=pointer(proca);',
+  '  p:=proca;',
+  '  p:=pointer(funcb);',
+  '  p:=funcb;',
+  '  doit(Pointer(notify),pointer(event),pointer(proca));',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_Typecast',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '};',
+    'this.Notify = null;',
+    'this.Event = null;',
+    'this.Getter = null;',
+    'this.ProcA = null;',
+    'this.FuncB = null;',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Notify = $mod.Event;',
+    '$mod.Event = $mod.Event;',
+    '$mod.Event = $mod.Notify;',
+    '$mod.Event = $mod.Getter;',
+    '$mod.Event = $mod.ProcA;',
+    '$mod.ProcA = $mod.FuncB;',
+    '$mod.FuncB = $mod.FuncB;',
+    '$mod.FuncB = $mod.ProcA;',
+    '$mod.FuncB = $mod.Getter;',
+    '$mod.ProcA = $mod.p;',
+    '$mod.FuncB = $mod.p;',
+    '$mod.Getter = $mod.p;',
+    '$mod.p = $mod.Notify;',
+    '$mod.p = $mod.Notify;',
+    '$mod.p = $mod.ProcA;',
+    '$mod.p = $mod.ProcA;',
+    '$mod.p = $mod.FuncB;',
+    '$mod.p = $mod.FuncB;',
+    '$mod.DoIt($mod.Notify, $mod.Event, $mod.ProcA);',
+    '']));
+end;
+
+procedure TTestModule.TestProcType_PassProcToUntyped;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEvent = procedure of object;',
+  '  TFunc = function: longint;',
+  'procedure DoIt(); varargs; begin end;',
+  'procedure DoSome(const a; var b; p: pointer); begin end;',
+  'var',
+  '  Event: tevent;',
+  '  Func: TFunc;',
+  'begin',
+  '  doit(event,func);',
+  '  dosome(event,event,event);',
+  '  dosome(func,func,func);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestProcType_PassProcToUntyped',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '};',
+    'this.DoSome = function (a, b, p) {',
+    '};',
+    'this.Event = null;',
+    'this.Func = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.Event, $mod.Func);',
+    '$mod.DoSome($mod.Event, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.Event;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.Event = v;',
+    '    }',
+    '}, $mod.Event);',
+    '$mod.DoSome($mod.Func, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.Func;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.Func = v;',
+    '    }',
+    '}, $mod.Func);',
+    '']));
+end;
+
+procedure TTestModule.TestPointer;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  TClass = class of TObject;');
+  Add('  TArrInt = array of longint;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  Obj: tobject;');
+  Add('  C: tclass;');
+  Add('  a: tarrint;');
+  Add('  p: Pointer;');
+  Add('begin');
+  Add('  p:=p;');
+  Add('  p:=nil;');
+  Add('  if p=nil then;');
+  Add('  if nil=p then;');
+  Add('  if Assigned(p) then;');
+  Add('  p:=Pointer(v);');
+  Add('  p:=obj;');
+  Add('  p:=c;');
+  Add('  p:=a;');
+  Add('  p:=tobject;');
+  Add('  obj:=TObject(p);');
+  Add('  c:=TClass(p);');
+  Add('  a:=TArrInt(p);');
+  ConvertProgram;
+  CheckSource('TestPointer',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.v = undefined;',
+    'this.Obj = null;',
+    'this.C = null;',
+    'this.a = [];',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.p;',
+    '$mod.p = null;',
+    'if ($mod.p == null) ;',
+    'if (null == $mod.p) ;',
+    'if ($mod.p != null) ;',
+    '$mod.p = $mod.v;',
+    '$mod.p = $mod.Obj;',
+    '$mod.p = $mod.C;',
+    '$mod.p = $mod.a;',
+    '$mod.p = $mod.TObject;',
+    '$mod.Obj = $mod.p;',
+    '$mod.C = $mod.p;',
+    '$mod.a = $mod.p;',
+    '']));
+end;
+
+procedure TTestModule.TestPointer_Proc;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoIt; virtual; abstract;');
+  Add('  end;');
+  Add('procedure DoSome; begin end;');
+  Add('var');
+  Add('  o: TObject;');
+  Add('  p: Pointer;');
+  Add('begin');
+  Add('  p:=@DoSome;');
+  Add('  p:=@o.DoIt;');
+  ConvertProgram;
+  CheckSource('TestPointer_Proc',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoSome = function () {',
+    '};',
+    'this.o = null;',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.DoSome;',
+    '$mod.p = rtl.createCallback($mod.o, "DoIt");',
+    '']));
+end;
+
+procedure TTestModule.TestPointer_AssignRecordFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record end;');
+  Add('var');
+  Add('  p: Pointer;');
+  Add('  r: TRec;');
+  Add('begin');
+  Add('  p:=r;');
+  SetExpectedPasResolverError('Incompatible types: got "TRec" expected "Pointer"',
+    nIncompatibleTypesGotExpected);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestPointer_AssignStaticArrayFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TArr = array[boolean] of longint;');
+  Add('var');
+  Add('  p: Pointer;');
+  Add('  a: TArr;');
+  Add('begin');
+  Add('  p:=a;');
+  SetExpectedPasResolverError('Incompatible types: got "TArr" expected "Pointer"',
+    nIncompatibleTypesGotExpected);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestPointer_ArrayParamsFail;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  p: Pointer;');
+  Add('begin');
+  Add('  p:=p[1];');
+  SetExpectedPasResolverError('illegal qualifier "["',nIllegalQualifier);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestPointer_TypeCastJSValueToPointer;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(args: array of jsvalue); begin end;',
+  'procedure DoAll; varargs; begin end;',
+  'var',
+  '  v: jsvalue;',
+  'begin',
+  '  DoIt([pointer(v)]);',
+  '  DoAll(pointer(v));',
+  '']);
+  ConvertProgram;
+  CheckSource('TestPointer_TypeCastJSValueToPointer',
+    LinesToStr([ // statements
+    'this.DoIt = function (args) {',
+    '};',
+    'this.DoAll = function () {',
+    '};',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt([$mod.v]);',
+    '$mod.DoAll($mod.v);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_AssignToJSValue;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  i: longint;');
+  Add('  s: string;');
+  Add('  b: boolean;');
+  Add('  d: double;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  v:=v;');
+  Add('  v:=1;');
+  Add('  v:=i;');
+  Add('  v:='''';');
+  Add('  v:=''c'';');
+  Add('  v:=''foo'';');
+  Add('  v:=s;');
+  Add('  v:=false;');
+  Add('  v:=true;');
+  Add('  v:=b;');
+  Add('  v:=0.1;');
+  Add('  v:=d;');
+  Add('  v:=nil;');
+  Add('  v:=p;');
+  ConvertProgram;
+  CheckSource('TestJSValue_AssignToJSValue',
+    LinesToStr([ // statements
+    'this.v = undefined;',
+    'this.i = 0;',
+    'this.s = "";',
+    'this.b = false;',
+    'this.d = 0.0;',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.v;',
+    '$mod.v = 1;',
+    '$mod.v = $mod.i;',
+    '$mod.v = "";',
+    '$mod.v = "c";',
+    '$mod.v = "foo";',
+    '$mod.v = $mod.s;',
+    '$mod.v = false;',
+    '$mod.v = true;',
+    '$mod.v = $mod.b;',
+    '$mod.v = 0.1;',
+    '$mod.v = $mod.d;',
+    '$mod.v = null;',
+    '$mod.v = $mod.p;',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_TypeCastToBaseType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TYesNo = boolean;');
+  Add('  TFloat = double;');
+  Add('  TCaption = string;');
+  Add('  TChar = char;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  i: integer;');
+  Add('  s: TCaption;');
+  Add('  b: TYesNo;');
+  Add('  d: TFloat;');
+  Add('  c: char;');
+  Add('begin');
+  Add('  i:=longint(v);');
+  Add('  i:=integer(v);');
+  Add('  s:=string(v);');
+  Add('  s:=TCaption(v);');
+  Add('  b:=boolean(v);');
+  Add('  b:=TYesNo(v);');
+  Add('  d:=double(v);');
+  Add('  d:=TFloat(v);');
+  Add('  c:=char(v);');
+  Add('  c:=TChar(v);');
+  ConvertProgram;
+  CheckSource('TestJSValue_TypeCastToBaseType',
+    LinesToStr([ // statements
+    'this.v = undefined;',
+    'this.i = 0;',
+    'this.s = "";',
+    'this.b = false;',
+    'this.d = 0.0;',
+    'this.c = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.i = Math.floor($mod.v);',
+    '$mod.i = Math.floor($mod.v);',
+    '$mod.s = "" + $mod.v;',
+    '$mod.s = "" + $mod.v;',
+    '$mod.b = !($mod.v == false);',
+    '$mod.b = !($mod.v == false);',
+    '$mod.d = rtl.getNumber($mod.v);',
+    '$mod.d = rtl.getNumber($mod.v);',
+    '$mod.c = rtl.getChar($mod.v);',
+    '$mod.c = rtl.getChar($mod.v);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_Equal;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TYesNo = boolean;');
+  Add('  TFloat = double;');
+  Add('  TCaption = string;');
+  Add('  TChar = char;');
+  Add('  TMulti = JSValue;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  i: integer;');
+  Add('  s: TCaption;');
+  Add('  b: TYesNo;');
+  Add('  d: TFloat;');
+  Add('  c: char;');
+  Add('  m: TMulti;');
+  Add('begin');
+  Add('  b:=v=v;');
+  Add('  b:=v<>v;');
+  Add('  b:=v=1;');
+  Add('  b:=v<>1;');
+  Add('  b:=2=v;');
+  Add('  b:=2<>v;');
+  Add('  b:=v=i;');
+  Add('  b:=i=v;');
+  Add('  b:=v=nil;');
+  Add('  b:=nil=v;');
+  Add('  b:=v=false;');
+  Add('  b:=true=v;');
+  Add('  b:=v=b;');
+  Add('  b:=b=v;');
+  Add('  b:=v=s;');
+  Add('  b:=s=v;');
+  Add('  b:=v=''foo'';');
+  Add('  b:=''''=v;');
+  Add('  b:=v=d;');
+  Add('  b:=d=v;');
+  Add('  b:=v=3.4;');
+  Add('  b:=5.6=v;');
+  Add('  b:=v=c;');
+  Add('  b:=c=v;');
+  Add('  b:=m=m;');
+  Add('  b:=v=m;');
+  Add('  b:=m=v;');
+  ConvertProgram;
+  CheckSource('TestJSValue_Equal',
+    LinesToStr([ // statements
+    'this.v = undefined;',
+    'this.i = 0;',
+    'this.s = "";',
+    'this.b = false;',
+    'this.d = 0.0;',
+    'this.c = "";',
+    'this.m = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.b = $mod.v == $mod.v;',
+    '$mod.b = $mod.v != $mod.v;',
+    '$mod.b = $mod.v == 1;',
+    '$mod.b = $mod.v != 1;',
+    '$mod.b = 2 == $mod.v;',
+    '$mod.b = 2 != $mod.v;',
+    '$mod.b = $mod.v == $mod.i;',
+    '$mod.b = $mod.i == $mod.v;',
+    '$mod.b = $mod.v == null;',
+    '$mod.b = null == $mod.v;',
+    '$mod.b = $mod.v == false;',
+    '$mod.b = true == $mod.v;',
+    '$mod.b = $mod.v == $mod.b;',
+    '$mod.b = $mod.b == $mod.v;',
+    '$mod.b = $mod.v == $mod.s;',
+    '$mod.b = $mod.s == $mod.v;',
+    '$mod.b = $mod.v == "foo";',
+    '$mod.b = "" == $mod.v;',
+    '$mod.b = $mod.v == $mod.d;',
+    '$mod.b = $mod.d == $mod.v;',
+    '$mod.b = $mod.v == 3.4;',
+    '$mod.b = 5.6 == $mod.v;',
+    '$mod.b = $mod.v == $mod.c;',
+    '$mod.b = $mod.c == $mod.v;',
+    '$mod.b = $mod.m == $mod.m;',
+    '$mod.b = $mod.v == $mod.m;',
+    '$mod.b = $mod.m == $mod.v;',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_If;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  v: jsvalue;',
+  'begin',
+  '  if v then ;',
+  '  while v do ;',
+  '  repeat until v;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_If',
+    LinesToStr([ // statements
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if ($mod.v) ;',
+    'while($mod.v){',
+    '};',
+    'do{',
+    '} while(!$mod.v);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_Enum;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TColor = (red, blue);');
+  Add('  TRedBlue = TColor;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  e: TColor;');
+  Add('begin');
+  Add('  v:=e;');
+  Add('  v:=TColor(e);');
+  Add('  v:=TRedBlue(e);');
+  Add('  e:=TColor(v);');
+  Add('  e:=TRedBlue(v);');
+  ConvertProgram;
+  CheckSource('TestJSValue_Enum',
+    LinesToStr([ // statements
+    'this.TColor = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1',
+    '};',
+    'this.v = undefined;',
+    'this.e = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.e;',
+    '$mod.v = $mod.e;',
+    '$mod.v = $mod.e;',
+    '$mod.e = $mod.v;',
+    '$mod.e = $mod.v;',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_ClassInstance;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TBirdObject = TObject;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  v:=o;');
+  Add('  v:=TObject(o);');
+  Add('  v:=TBirdObject(o);');
+  Add('  o:=TObject(v);');
+  Add('  o:=TBirdObject(v);');
+  ConvertProgram;
+  CheckSource('TestJSValue_ClassInstance',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.v = undefined;',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.o;',
+    '$mod.v = $mod.o;',
+    '$mod.v = $mod.o;',
+    '$mod.o = rtl.getObject($mod.v);',
+    '$mod.o = rtl.getObject($mod.v);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_ClassOf;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of TObject;');
+  Add('  TObject = class');
+  Add('  end;');
+  Add('  TBirds = class of TBird;');
+  Add('  TBird = class(TObject) end;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  c: TClass;');
+  Add('begin');
+  Add('  v:=c;');
+  Add('  v:=TObject;');
+  Add('  v:=TClass(c);');
+  Add('  v:=TBirds(c);');
+  Add('  c:=TClass(v);');
+  Add('  c:=TBirds(v);');
+  ConvertProgram;
+  CheckSource('TestJSValue_ClassOf',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '});',
+    'this.v = undefined;',
+    'this.c = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.c;',
+    '$mod.v = $mod.TObject;',
+    '$mod.v = $mod.c;',
+    '$mod.v = $mod.c;',
+    '$mod.c = rtl.getObject($mod.v);',
+    '$mod.c = rtl.getObject($mod.v);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_ArrayOfJSValue;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TArray = array of JSValue;');
+  Add('  TArrgh = tarray;');
+  Add('  TArrInt = array of integer;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  TheArray: tarray;');
+  Add('  Arr: tarrgh;');
+  Add('  i: integer;');
+  Add('  ArrInt: tarrint;');
+  Add('begin');
+  Add('  arr:=thearray;');
+  Add('  thearray:=arr;');
+  Add('  setlength(arr,2);');
+  Add('  setlength(thearray,3);');
+  Add('  arr[4]:=v;');
+  Add('  arr[5]:=length(thearray);');
+  Add('  arr[6]:=nil;');
+  Add('  arr[7]:=thearray[8];');
+  Add('  arr[low(arr)]:=high(thearray);');
+  Add('  arr:=arrint;');
+  Add('  arrInt:=tarrint(arr);');
+  Add('  if TheArray = nil then ;');
+  Add('  if nil = TheArray then ;');
+  Add('  if TheArray <> nil then ;');
+  Add('  if nil <> TheArray then ;');
+  ConvertProgram;
+  CheckSource('TestJSValue_ArrayOfJSValue',
+    LinesToStr([ // statements
+    'this.v = undefined;',
+    'this.TheArray = [];',
+    'this.Arr = [];',
+    'this.i = 0;',
+    'this.ArrInt = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr = $mod.TheArray;',
+    '$mod.TheArray = $mod.Arr;',
+    '$mod.Arr = rtl.arraySetLength($mod.Arr,2,undefined);',
+    '$mod.TheArray = rtl.arraySetLength($mod.TheArray,3,undefined);',
+    '$mod.Arr[4] = $mod.v;',
+    '$mod.Arr[5] = rtl.length($mod.TheArray);',
+    '$mod.Arr[6] = null;',
+    '$mod.Arr[7] = $mod.TheArray[8];',
+    '$mod.Arr[0] = rtl.length($mod.TheArray) - 1;',
+    '$mod.Arr = $mod.ArrInt;',
+    '$mod.ArrInt = $mod.Arr;',
+    'if (rtl.length($mod.TheArray) == 0) ;',
+    'if (rtl.length($mod.TheArray) == 0) ;',
+    'if (rtl.length($mod.TheArray) > 0) ;',
+    'if (rtl.length($mod.TheArray) > 0) ;',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_Params;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TYesNo = boolean;');
+  Add('  TFloat = double;');
+  Add('  TCaption = string;');
+  Add('  TChar = char;');
+  Add('function DoIt(a: jsvalue; const b: jsvalue; var c: jsvalue; out d: jsvalue): jsvalue;');
+  Add('var');
+  Add('  l: jsvalue;');
+  Add('begin');
+  Add('  a:=a;');
+  Add('  l:=b;');
+  Add('  c:=c;');
+  Add('  d:=d;');
+  Add('  Result:=l;');
+  Add('end;');
+  Add('function DoSome(a: jsvalue; const b: jsvalue): jsvalue; begin end;');
+  Add('var');
+  Add('  v: jsvalue;');
+  Add('  i: integer;');
+  Add('  b: TYesNo;');
+  Add('  d: TFloat;');
+  Add('  s: TCaption;');
+  Add('  c: TChar;');
+  Add('begin');
+  Add('  v:=doit(v,v,v,v);');
+  Add('  i:=integer(dosome(i,i));');
+  Add('  b:=TYesNo(dosome(b,b));');
+  Add('  d:=TFloat(dosome(d,d));');
+  Add('  s:=TCaption(dosome(s,s));');
+  Add('  c:=TChar(dosome(c,c));');
+  ConvertProgram;
+  CheckSource('TestJSValue_Params',
+    LinesToStr([ // statements
+    'this.DoIt = function (a, b, c, d) {',
+    '  var Result = undefined;',
+    '  var l = undefined;',
+    '  a = a;',
+    '  l = b;',
+    '  c.set(c.get());',
+    '  d.set(d.get());',
+    '  Result = l;',
+    '  return Result;',
+    '};',
+    'this.DoSome = function (a, b) {',
+    '  var Result = undefined;',
+    '  return Result;',
+    '};',
+    'this.v = undefined;',
+    'this.i = 0;',
+    'this.b = false;',
+    'this.d = 0.0;',
+    'this.s = "";',
+    'this.c = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.v = $mod.DoIt($mod.v, $mod.v, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.v;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.v = v;',
+    '    }',
+    '}, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.v;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.v = v;',
+    '    }',
+    '});',
+    '$mod.i = Math.floor($mod.DoSome($mod.i, $mod.i));',
+    '$mod.b = !($mod.DoSome($mod.b, $mod.b) == false);',
+    '$mod.d = rtl.getNumber($mod.DoSome($mod.d, $mod.d));',
+    '$mod.s = "" + $mod.DoSome($mod.s, $mod.s);',
+    '$mod.c = rtl.getChar($mod.DoSome($mod.c, $mod.c));',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_UntypedParam;
+begin
+  StartProgram(false);
+  Add('function DoIt(const a; var b; out c): jsvalue;');
+  Add('begin');
+  Add('  Result:=a;');
+  Add('  Result:=b;');
+  Add('  Result:=c;');
+  Add('  b:=Result;');
+  Add('  c:=Result;');
+  Add('end;');
+  Add('var i: longint;');
+  Add('begin');
+  Add('  doit(i,i,i);');
+  ConvertProgram;
+  CheckSource('TestJSValue_UntypedParam',
+    LinesToStr([ // statements
+    'this.DoIt = function (a, b, c) {',
+    '  var Result = undefined;',
+    '  Result = a;',
+    '  Result = b.get();',
+    '  Result = c.get();',
+    '  b.set(Result);',
+    '  c.set(Result);',
+    '  return Result;',
+    '};',
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.i, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '}, {',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.i;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.i = v;',
+    '    }',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_FuncResultType;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TJSValueArray = array of JSValue;');
+  Add('  TListSortCompare = function(Item1, Item2: JSValue): Integer;');
+  Add('procedure Sort(P: JSValue; aList: TJSValueArray; const Compare: TListSortCompare);');
+  Add('begin');
+  Add('  while Compare(P,aList[0])>0 do ;');
+  Add('end;');
+  Add('var');
+  Add('  Compare: TListSortCompare;');
+  Add('  V: JSValue;');
+  Add('  i: integer;');
+  Add('begin');
+  Add('  if Compare(V,V)>0 then ;');
+  Add('  if Compare(i,i)>1 then ;');
+  Add('  if Compare(nil,false)>2 then ;');
+  Add('  if Compare(1,true)>3 then ;');
+  ConvertProgram;
+  CheckSource('TestJSValue_UntypedParam',
+    LinesToStr([ // statements
+    'this.Sort = function (P, aList, Compare) {',
+    '  while (Compare(P, aList[0]) > 0) {',
+    '  };',
+    '};',
+    'this.Compare = null;',
+    'this.V = undefined;',
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if ($mod.Compare($mod.V, $mod.V) > 0) ;',
+    'if ($mod.Compare($mod.i, $mod.i) > 1) ;',
+    'if ($mod.Compare(null, false) > 2) ;',
+    'if ($mod.Compare(1, true) > 3) ;',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_ProcType_Assign;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TObject = class');
+  Add('    class function GetGlob: integer;');
+  Add('    function Getter: integer;');
+  Add('  end;');
+  Add('class function TObject.GetGlob: integer;');
+  Add('var v1: jsvalue;');
+  Add('begin');
+  Add('  v1:=@GetGlob;');
+  Add('  v1:=@Self.GetGlob;');
+  Add('end;');
+  Add('function TObject.Getter: integer;');
+  Add('var v2: jsvalue;');
+  Add('begin');
+  Add('  v2:=@Getter;');
+  Add('  v2:=@Self.Getter;');
+  Add('  v2:=@GetGlob;');
+  Add('  v2:=@Self.GetGlob;');
+  Add('end;');
+  Add('function GetIt(i: integer): integer;');
+  Add('var v3: jsvalue;');
+  Add('begin');
+  Add('  v3:=@GetIt;');
+  Add('end;');
+  Add('var');
+  Add('  V: JSValue;');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  v:=@GetIt;');
+  Add('  v:=@o.Getter;');
+  Add('  v:=@o.GetGlob;');
+  ConvertProgram;
+  CheckSource('TestJSValue_ProcType_Assign',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetGlob = function () {',
+    '    var Result = 0;',
+    '    var v1 = undefined;',
+    '    v1 = rtl.createCallback(this, "GetGlob");',
+    '    v1 = rtl.createCallback(this, "GetGlob");',
+    '    return Result;',
+    '  };',
+    '  this.Getter = function () {',
+    '    var Result = 0;',
+    '    var v2 = undefined;',
+    '    v2 = rtl.createCallback(this, "Getter");',
+    '    v2 = rtl.createCallback(this, "Getter");',
+    '    v2 = rtl.createCallback(this.$class, "GetGlob");',
+    '    v2 = rtl.createCallback(this.$class, "GetGlob");',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.GetIt = function (i) {',
+    '  var Result = 0;',
+    '  var v3 = undefined;',
+    '  v3 = $mod.GetIt;',
+    '  return Result;',
+    '};',
+    'this.V = undefined;',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.V = $mod.GetIt;',
+    '$mod.V = rtl.createCallback($mod.o, "Getter");',
+    '$mod.V = rtl.createCallback($mod.o.$class, "GetGlob");',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_ProcType_Equal;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TObject = class');
+  Add('    class function GetGlob: integer;');
+  Add('    function Getter: integer;');
+  Add('  end;');
+  Add('class function TObject.GetGlob: integer;');
+  Add('var v1: jsvalue;');
+  Add('begin');
+  Add('  if v1=@GetGlob then;');
+  Add('  if v1=@Self.GetGlob then ;');
+  Add('end;');
+  Add('function TObject.Getter: integer;');
+  Add('var v2: jsvalue;');
+  Add('begin');
+  Add('  if v2=@Getter then;');
+  Add('  if v2=@Self.Getter then ;');
+  Add('  if v2=@GetGlob then;');
+  Add('  if v2=@Self.GetGlob then;');
+  Add('end;');
+  Add('function GetIt(i: integer): integer;');
+  Add('var v3: jsvalue;');
+  Add('begin');
+  Add('  if v3=@GetIt then;');
+  Add('end;');
+  Add('var');
+  Add('  V: JSValue;');
+  Add('  o: TObject;');
+  Add('begin');
+  Add('  if v=@GetIt then;');
+  Add('  if v=@o.Getter then;');
+  Add('  if v=@o.GetGlob then;');
+  Add('  if @GetIt=v then;');
+  Add('  if @o.Getter=v then;');
+  Add('  if @o.GetGlob=v then;');
+  ConvertProgram;
+  CheckSource('TestJSValue_ProcType_Equal',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetGlob = function () {',
+    '    var Result = 0;',
+    '    var v1 = undefined;',
+    '    if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
+    '    if (rtl.eqCallback(v1, rtl.createCallback(this, "GetGlob"))) ;',
+    '    return Result;',
+    '  };',
+    '  this.Getter = function () {',
+    '    var Result = 0;',
+    '    var v2 = undefined;',
+    '    if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
+    '    if (rtl.eqCallback(v2, rtl.createCallback(this, "Getter"))) ;',
+    '    if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
+    '    if (rtl.eqCallback(v2, rtl.createCallback(this.$class, "GetGlob"))) ;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.GetIt = function (i) {',
+    '  var Result = 0;',
+    '  var v3 = undefined;',
+    '  if (rtl.eqCallback(v3, $mod.GetIt)) ;',
+    '  return Result;',
+    '};',
+    'this.V = undefined;',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if (rtl.eqCallback($mod.V, $mod.GetIt)) ;',
+    'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o, "Getter"))) ;',
+    'if (rtl.eqCallback($mod.V, rtl.createCallback($mod.o.$class, "GetGlob"))) ;',
+    'if (rtl.eqCallback($mod.GetIt, $mod.V)) ;',
+    'if (rtl.eqCallback(rtl.createCallback($mod.o, "Getter"), $mod.V)) ;',
+    'if (rtl.eqCallback(rtl.createCallback($mod.o.$class, "GetGlob"), $mod.V)) ;',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_AssignToPointerFail;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  v: JSValue;',
+  '  p: Pointer;',
+  'begin',
+  '  p:=v;',
+  '']);
+  SetExpectedPasResolverError('Incompatible types: got "JSValue" expected "Pointer"',
+    nIncompatibleTypesGotExpected);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestJSValue_OverloadDouble;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  tdatetime = double;',
+  'procedure DoIt(d: double); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadDouble',
+    LinesToStr([ // statements
+    'this.DoIt = function (d) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.d);',
+    '$mod.DoIt($mod.dt);',
+    '$mod.DoIt($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt($mod.smi);',
+    '$mod.DoIt($mod.lw);',
+    '$mod.DoIt($mod.li);',
+    '$mod.DoIt($mod.ni);',
+    '$mod.DoIt($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadNativeInt;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  int53 = nativeint;',
+  '  tdatetime = double;',
+  'procedure DoIt(n: nativeint); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadNativeInt',
+    LinesToStr([ // statements
+    'this.DoIt = function (n) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.d);',
+    '$mod.DoIt$1($mod.dt);',
+    '$mod.DoIt($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt($mod.smi);',
+    '$mod.DoIt($mod.lw);',
+    '$mod.DoIt($mod.li);',
+    '$mod.DoIt($mod.ni);',
+    '$mod.DoIt($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadWord;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  integer = longint;',
+  '  int53 = nativeint;',
+  '  tdatetime = double;',
+  'procedure DoIt(w: word); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  d: double;',
+  '  dt: tdatetime;',
+  '  i: integer;',
+  '  b: byte;',
+  '  shi: shortint;',
+  '  w: word;',
+  '  smi: smallint;',
+  '  lw: longword;',
+  '  li: longint;',
+  '  ni: nativeint;',
+  '  nu: nativeuint;',
+  'begin',
+  '  DoIt(d);',
+  '  DoIt(dt);',
+  '  DoIt(i);',
+  '  DoIt(b);',
+  '  DoIt(shi);',
+  '  DoIt(w);',
+  '  DoIt(smi);',
+  '  DoIt(lw);',
+  '  DoIt(li);',
+  '  DoIt(ni);',
+  '  DoIt(nu);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadWord',
+    LinesToStr([ // statements
+    'this.DoIt = function (w) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.d = 0.0;',
+    'this.dt = 0.0;',
+    'this.i = 0;',
+    'this.b = 0;',
+    'this.shi = 0;',
+    'this.w = 0;',
+    'this.smi = 0;',
+    'this.lw = 0;',
+    'this.li = 0;',
+    'this.ni = 0;',
+    'this.nu = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.d);',
+    '$mod.DoIt$1($mod.dt);',
+    '$mod.DoIt$1($mod.i);',
+    '$mod.DoIt($mod.b);',
+    '$mod.DoIt($mod.shi);',
+    '$mod.DoIt($mod.w);',
+    '$mod.DoIt$1($mod.smi);',
+    '$mod.DoIt$1($mod.lw);',
+    '$mod.DoIt$1($mod.li);',
+    '$mod.DoIt$1($mod.ni);',
+    '$mod.DoIt$1($mod.nu);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadString;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  uni = string;',
+  '  WideChar = char;',
+  'procedure DoIt(s: string); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  u: uni;',
+  'begin',
+  '  DoIt(s);',
+  '  DoIt(c);',
+  '  DoIt(u);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadString',
+    LinesToStr([ // statements
+    'this.DoIt = function (s) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.s = "";',
+    'this.c = "";',
+    'this.u = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.s);',
+    '$mod.DoIt($mod.c);',
+    '$mod.DoIt($mod.u);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadChar;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  uni = string;',
+  '  WideChar = char;',
+  'procedure DoIt(c: char); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  s: string;',
+  '  c: char;',
+  '  u: uni;',
+  'begin',
+  '  DoIt(s);',
+  '  DoIt(c);',
+  '  DoIt(u);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadChar',
+    LinesToStr([ // statements
+    'this.DoIt = function (c) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.s = "";',
+    'this.c = "";',
+    'this.u = "";',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$1($mod.s);',
+    '$mod.DoIt($mod.c);',
+    '$mod.DoIt$1($mod.u);',
+    '']));
+end;
+
+procedure TTestModule.TestJSValue_OverloadPointer;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  'procedure DoIt(p: pointer); begin end;',
+  'procedure DoIt(v: jsvalue); begin end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  DoIt(o);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestJSValue_OverloadPointer',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function (p) {',
+    '};',
+    'this.DoIt$1 = function (v) {',
+    '};',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt($mod.o);',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_ProcType;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TProcA = procedure;');
+  Add('  TMethodB = procedure of object;');
+  Add('  TProcC = procedure; varargs;');
+  Add('  TProcD = procedure(i: longint; const j: string; var c: char; out d: double);');
+  Add('  TProcE = function: nativeint;');
+  Add('  TProcF = function(const p: TProcA): nativeuint;');
+  Add('var p: pointer;');
+  Add('begin');
+  Add('  p:=typeinfo(tproca);');
+  ConvertProgram;
+  CheckSource('TestRTTI_ProcType',
+    LinesToStr([ // statements
+    '$mod.$rtti.$ProcVar("TProcA", {',
+    '  procsig: rtl.newTIProcSig(null)',
+    '});',
+    '$mod.$rtti.$MethodVar("TMethodB", {',
+    '  procsig: rtl.newTIProcSig(null),',
+    '  methodkind: 0',
+    '});',
+    '$mod.$rtti.$ProcVar("TProcC", {',
+    '  procsig: rtl.newTIProcSig(null, 2)',
+    '});',
+    '$mod.$rtti.$ProcVar("TProcD", {',
+    '  procsig: rtl.newTIProcSig([["i", rtl.longint], ["j", rtl.string, 2], ["c", rtl.char, 1], ["d", rtl.double, 4]])',
+    '});',
+    '$mod.$rtti.$ProcVar("TProcE", {',
+    '  procsig: rtl.newTIProcSig(null, rtl.nativeint)',
+    '});',
+    '$mod.$rtti.$ProcVar("TProcF", {',
+    '  procsig: rtl.newTIProcSig([["p", $mod.$rtti["TProcA"], 2]], rtl.nativeuint)',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TProcA"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_ProcType_ArgFromOtherUnit;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class end;'
+    ]),
+    '');
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('type');
+  Add('  TProcA = function(o: tobject): tobject;');
+  Add('implementation');
+  Add('type');
+  Add('  TProcB = function(o: tobject): tobject;');
+  Add('var p: Pointer;');
+  Add('initialization');
+  Add('  p:=typeinfo(tproca);');
+  Add('  p:=typeinfo(tprocb);');
+  ConvertUnit;
+  CheckSource('TestRTTI_ProcType_ArgFromOtherUnit',
+    LinesToStr([ // statements
+    'var $impl = $mod.$impl;',
+    '$mod.$rtti.$ProcVar("TProcA", {',
+    '  procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
+    '});',
+    '']),
+    LinesToStr([ // this.$init
+    '$impl.p = $mod.$rtti["TProcA"];',
+    '$impl.p = $mod.$rtti["TProcB"];',
+    '']),
+    LinesToStr([ // implementation
+    '$mod.$rtti.$ProcVar("TProcB", {',
+    '  procsig: rtl.newTIProcSig([["o", pas.unit2.$rtti["TObject"]]], pas.unit2.$rtti["TObject"])',
+    '});',
+    '$impl.p = null;',
+    '']) );
+end;
+
+procedure TTestModule.TestRTTI_EnumAndSetType;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (light,dark);');
+  Add('  TFlags = set of TFlag;');
+  Add('  TProc = function(f: TFlags): TFlag;');
+  Add('var p: pointer;');
+  Add('begin');
+  Add('  p:=typeinfo(tflag);');
+  Add('  p:=typeinfo(tflags);');
+  ConvertProgram;
+  CheckSource('TestRTTI_EnumAndType',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "light",',
+    '  light: 0,',
+    '  "1": "dark",',
+    '  dark: 1',
+    '};',
+    '$mod.$rtti.$Enum("TFlag", {',
+    '  minvalue: 0,',
+    '  maxvalue: 1,',
+    '  enumtype: this.TFlag',
+    '});',
+    '$mod.$rtti.$Set("TFlags", {',
+    '  comptype: $mod.$rtti["TFlag"]',
+    '});',
+    '$mod.$rtti.$ProcVar("TProc", {',
+    '  procsig: rtl.newTIProcSig([["f", $mod.$rtti["TFlags"]]], $mod.$rtti["TFlag"])',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TFlag"];',
+    '$mod.p = $mod.$rtti["TFlags"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_AnonymousEnumType;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TFlags = set of (red, green);');
+  Add('var');
+  Add('  f: TFlags;');
+  Add('begin');
+  Add('  Include(f,red);');
+  ConvertProgram;
+  CheckSource('TestRTTI_AnonymousEnumType',
+    LinesToStr([ // statements
+    'this.TFlags$a = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "green",',
+    '  green: 1',
+    '};',
+    '$mod.$rtti.$Enum("TFlags$a", {',
+    '  minvalue: 0,',
+    '  maxvalue: 1,',
+    '  enumtype: this.TFlags$a',
+    '});',
+    '$mod.$rtti.$Set("TFlags", {',
+    '  comptype: $mod.$rtti["TFlags$a"]',
+    '});',
+    'this.f = {};',
+    '']),
+    LinesToStr([
+    '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_StaticArray;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TFlag = (light,dark);');
+  Add('  TFlagNames = array[TFlag] of string;');
+  Add('  TBoolNames = array[boolean] of string;');
+  Add('  TProc = function(f: TBoolNames): TFlagNames;');
+  Add('var p: pointer;');
+  Add('begin');
+  Add('  p:=typeinfo(TFlagNames);');
+  Add('  p:=typeinfo(TBoolNames);');
+  ConvertProgram;
+  CheckSource('TestRTTI_StaticArray',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "light",',
+    '  light: 0,',
+    '  "1": "dark",',
+    '  dark: 1',
+    '};',
+    '$mod.$rtti.$Enum("TFlag", {',
+    '  minvalue: 0,',
+    '  maxvalue: 1,',
+    '  enumtype: this.TFlag',
+    '});',
+    '$mod.$rtti.$StaticArray("TFlagNames", {',
+    '  dims: [2],',
+    '  eltype: rtl.string',
+    '});',
+    '$mod.$rtti.$StaticArray("TBoolNames", {',
+    '  dims: [2],',
+    '  eltype: rtl.string',
+    '});',
+    '$mod.$rtti.$ProcVar("TProc", {',
+    '  procsig: rtl.newTIProcSig([["f", $mod.$rtti["TBoolNames"]]], $mod.$rtti["TFlagNames"])',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TFlagNames"];',
+    '$mod.p = $mod.$rtti["TBoolNames"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_DynArray;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TArrStr = array of string;');
+  Add('  TArr2Dim = array of tarrstr;');
+  Add('  TProc = function(f: TArrStr): TArr2Dim;');
+  Add('var p: pointer;');
+  Add('begin');
+  Add('  p:=typeinfo(tarrstr);');
+  Add('  p:=typeinfo(tarr2dim);');
+  ConvertProgram;
+  CheckSource('TestRTTI_DynArray',
+    LinesToStr([ // statements
+    '$mod.$rtti.$DynArray("TArrStr", {',
+    '  eltype: rtl.string',
+    '});',
+    '$mod.$rtti.$DynArray("TArr2Dim", {',
+    '  eltype: $mod.$rtti["TArrStr"]',
+    '});',
+    '$mod.$rtti.$ProcVar("TProc", {',
+    '  procsig: rtl.newTIProcSig([["f", $mod.$rtti["TArrStr"]]], $mod.$rtti["TArr2Dim"])',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TArrStr"];',
+    '$mod.p = $mod.$rtti["TArr2Dim"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_ArrayNestedAnonymous;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TArr = array of array of longint;');
+  Add('var a: TArr;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_ArrayNestedAnonymous',
+    LinesToStr([ // statements
+    '$mod.$rtti.$DynArray("TArr$a", {',
+    '  eltype: rtl.longint',
+    '});',
+    '$mod.$rtti.$DynArray("TArr", {',
+    '  eltype: $mod.$rtti["TArr$a"]',
+    '});',
+    'this.a = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    ]));
+end;
+
+procedure TTestModule.TestRTTI_PublishedMethodOverloadFail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    procedure Proc; virtual; abstract;');
+  Add('    procedure Proc(Sender: tobject); virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError('Duplicate identifier "Proc" at test1.pp(6,18)',
+    nDuplicateIdentifier);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    procedure Proc; external name ''foo'';');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
+    nPublishedNameMustMatchExternal);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestRTTI_PublishedClassPropertyFail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var FA: longint;');
+  Add('  published');
+  Add('    class property A: longint read FA;');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError('Invalid published property modifier "class"',
+    nInvalidXModifierY);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestRTTI_PublishedClassFieldFail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    class var FA: longint;');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError(sSymbolCannotBePublished,
+    nSymbolCannotBePublished);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestRTTI_PublishedFieldExternalFail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    V: longint; external name ''foo'';');
+  Add('  end;');
+  Add('begin');
+  SetExpectedPasResolverError(sPublishedNameMustMatchExternal,
+    nPublishedNameMustMatchExternal);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestRTTI_Class_Field;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    FPropA: string;');
+  Add('  published');
+  Add('    VarLI: longint;');
+  Add('    VarC: char;');
+  Add('    VarS: string;');
+  Add('    VarD: double;');
+  Add('    VarB: boolean;');
+  Add('    VarLW: longword;');
+  Add('    VarSmI: smallint;');
+  Add('    VarW: word;');
+  Add('    VarShI: shortint;');
+  Add('    VarBy: byte;');
+  Add('    VarExt: longint external name ''VarExt'';');
+  Add('  end;');
+  Add('var p: pointer;');
+  Add('  Obj: tobject;');
+  Add('begin');
+  Add('  p:=typeinfo(tobject);');
+  Add('  p:=typeinfo(p);');
+  Add('  p:=typeinfo(obj);');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_Field',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FPropA = "";',
+    '    this.VarLI = 0;',
+    '    this.VarC = "";',
+    '    this.VarS = "";',
+    '    this.VarD = 0.0;',
+    '    this.VarB = false;',
+    '    this.VarLW = 0;',
+    '    this.VarSmI = 0;',
+    '    this.VarW = 0;',
+    '    this.VarShI = 0;',
+    '    this.VarBy = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("VarLI", rtl.longint);',
+    '  $r.addField("VarC", rtl.char);',
+    '  $r.addField("VarS", rtl.string);',
+    '  $r.addField("VarD", rtl.double);',
+    '  $r.addField("VarB", rtl.boolean);',
+    '  $r.addField("VarLW", rtl.longword);',
+    '  $r.addField("VarSmI", rtl.smallint);',
+    '  $r.addField("VarW", rtl.word);',
+    '  $r.addField("VarShI", rtl.shortint);',
+    '  $r.addField("VarBy", rtl.byte);',
+    '  $r.addField("VarExt", rtl.longint);',
+    '});',
+    'this.p = null;',
+    'this.Obj = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TObject"];',
+    '$mod.p = rtl.pointer;',
+    '$mod.p = $mod.Obj.$rtti;',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Class_Method;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    procedure Internal; external name ''$intern'';');
+  Add('  published');
+  Add('    procedure Click; virtual; abstract;');
+  Add('    procedure Notify(Sender: TObject); virtual; abstract;');
+  Add('    function GetNotify: boolean; external name ''GetNotify'';');
+  Add('    procedure Println(a,b: longint); varargs; virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_Method',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("Click", 0, null);',
+    '  $r.addMethod("Notify", 0, [["Sender", $r]]);',
+    '  $r.addMethod("GetNotify", 1, null, rtl.boolean,{flags: 4});',
+    '  $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, {',
+    '    flags: 2',
+    '  });',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Class_MethodArgFlags;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    procedure OpenArray(const Args: array of string); virtual; abstract;');
+  Add('    procedure ByRef(var Value: longint; out Item: longint); virtual; abstract;');
+  Add('    procedure Untyped(var Value; out Item); virtual; abstract;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_MethodOpenArray',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]]);',
+    '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]]);',
+    '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]]);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Class_Property;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    FColor: longint;');
+  Add('    FColorStored: boolean;');
+  Add('    procedure SetColor(Value: longint); virtual; abstract;');
+  Add('    function GetColor: longint; virtual; abstract;');
+  Add('    function GetColorStored: boolean; virtual; abstract;');
+  Add('    FExtSize: longint external name ''$extSize'';');
+  Add('    FExtSizeStored: boolean external name ''$extSizeStored'';');
+  Add('    procedure SetExtSize(Value: longint); external name ''$setSize'';');
+  Add('    function GetExtSize: longint; external name ''$getSize'';');
+  Add('    function GetExtSizeStored: boolean; external name ''$getExtSizeStored'';');
+  Add('  published');
+  Add('    property ColorA: longint read FColor;');
+  Add('    property ColorB: longint write FColor;');
+  Add('    property ColorC: longint read GetColor write SetColor;');
+  Add('    property ColorD: longint read FColor write FColor stored FColorStored;');
+  Add('    property ExtSizeA: longint read FExtSize write FExtSize;');
+  Add('    property ExtSizeB: longint read GetExtSize write SetExtSize stored FExtSizeStored;');
+  Add('    property ExtSizeC: longint read FExtSize write FExtSize stored GetExtSizeStored;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_Property',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FColor = 0;',
+    '    this.FColorStored = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addProperty("ColorA", 0, rtl.longint, "FColor", "");',
+    '  $r.addProperty("ColorB", 0, rtl.longint, "", "FColor");',
+    '  $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor");',
+    '  $r.addProperty("ColorD", 0, rtl.longint, "FColor", "FColor",{',
+    '      stored: "FColorStored"',
+    '    }',
+    '  );',
+    '  $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize");',
+    '  $r.addProperty("ExtSizeB", 3, rtl.longint, "$getSize", "$setSize",{',
+    '      stored: "$extSizeStored"',
+    '    }',
+    '  );',
+    '  $r.addProperty("ExtSizeC", 4, rtl.longint, "$extSize", "$extSize",{',
+    '      stored: "$getExtSizeStored"',
+    '    }',
+    '  );',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Class_PropertyParams;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    function GetItems(i: integer): tobject; virtual; abstract;');
+  Add('    procedure SetItems(i: integer; value: tobject); virtual; abstract;');
+  Add('    function GetValues(const i: integer; var b: boolean): char; virtual; abstract;');
+  Add('    procedure SetValues(const i: integer; var b: boolean; value: char); virtual; abstract;');
+  Add('  published');
+  Add('    property Items[Index: integer]: tobject read getitems write setitems;');
+  Add('    property Values[const keya: integer; var keyb: boolean]: char read getvalues write setvalues;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_PropertyParams',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addProperty("Items", 3, $r, "GetItems", "SetItems");',
+    '  $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues");',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_OverrideMethod;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    procedure DoIt; virtual; abstract;');
+  Add('  end;');
+  Add('  TSky = class');
+  Add('  published');
+  Add('    procedure DoIt; override;');
+  Add('  end;');
+  Add('procedure TSky.DoIt; begin end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_OverrideMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("DoIt", 0, null);',
+    '});',
+    'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
+    '  this.DoIt = function () {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_OverloadProperty;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  protected');
+  Add('    FFlag: longint;');
+  Add('  published');
+  Add('    property Flag: longint read fflag;');
+  Add('  end;');
+  Add('  TSky = class');
+  Add('  published');
+  Add('    property FLAG: longint write fflag;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_OverrideMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFlag = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addProperty("Flag", 0, rtl.longint, "FFlag", "");',
+    '});',
+    'rtl.createClass($mod, "TSky", $mod.TObject, function () {',
+    '  var $r = this.$rtti;',
+    '  $r.addProperty("Flag", 0, rtl.longint, "", "FFlag");',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_ClassForward;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('  tbridge = class;');
+  Add('  TProc = function: tbridge;');
+  Add('  TOger = class');
+  Add('  published');
+  Add('    FBridge: tbridge;');
+  Add('    procedure SetBridge(Value: tbridge); virtual; abstract;');
+  Add('    property Bridge: tbridge read fbridge write setbridge;');
+  Add('  end;');
+  Add('  TBridge = class');
+  Add('    FOger: toger;');
+  Add('  end;');
+  Add('var p: Pointer;');
+  Add(' b: tbridge;');
+  Add('begin');
+  Add('  p:=typeinfo(tbridge);');
+  Add('  p:=typeinfo(b);');
+  ConvertProgram;
+  CheckSource('TestRTTI_ClassForward',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    '$mod.$rtti.$Class("TBridge");',
+    '$mod.$rtti.$ProcVar("TProc", {',
+    '  procsig: rtl.newTIProcSig(null, $mod.$rtti["TBridge"])',
+    '});',
+    'rtl.createClass($mod, "TOger", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FBridge = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FBridge = undefined;',
+    '    $mod.TObject.$final.call(this);',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("FBridge", $mod.$rtti["TBridge"]);',
+    '  $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]]);',
+    '  $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge");',
+    '});',
+    'rtl.createClass($mod, "TBridge", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FOger = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FOger = undefined;',
+    '    $mod.TObject.$final.call(this);',
+    '  };',
+    '});',
+    'this.p = null;',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TBridge"];',
+    '$mod.p = $mod.b.$rtti;',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_ClassOf;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TClass = class of tobject;');
+  Add('  TProcA = function: TClass;');
+  Add('  TObject = class');
+  Add('  published');
+  Add('    C: tclass;');
+  Add('  end;');
+  Add('  tfox = class;');
+  Add('  TBird = class end;');
+  Add('  TBirds = class of tbird;');
+  Add('  TFox = class end;');
+  Add('  TFoxes = class of tfox;');
+  Add('  TCows = class of TCow;');
+  Add('  TCow = class;');
+  Add('  TCow = class end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_ClassOf',
+    LinesToStr([ // statements
+    '$mod.$rtti.$Class("TObject");',
+    '$mod.$rtti.$ClassRef("TClass", {',
+    '  instancetype: $mod.$rtti["TObject"]',
+    '});',
+    '$mod.$rtti.$ProcVar("TProcA", {',
+    '  procsig: rtl.newTIProcSig(null, $mod.$rtti["TClass"])',
+    '});',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.C = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.C = undefined;',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("C", $mod.$rtti["TClass"]);',
+    '});',
+    '$mod.$rtti.$Class("TFox");',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '});',
+    '$mod.$rtti.$ClassRef("TBirds", {',
+    '  instancetype: $mod.$rtti["TBird"]',
+    '});',
+    'rtl.createClass($mod, "TFox", $mod.TObject, function () {',
+    '});',
+    '$mod.$rtti.$ClassRef("TFoxes", {',
+    '  instancetype: $mod.$rtti["TFox"]',
+    '});',
+    '$mod.$rtti.$Class("TCow");',
+    '$mod.$rtti.$ClassRef("TCows", {',
+    '  instancetype: $mod.$rtti["TCow"]',
+    '});',
+    'rtl.createClass($mod, "TCow", $mod.TObject, function () {',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Record;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TPoint = record');
+  Add('    x,y: integer;');
+  Add('  end;');
+  Add('var p: pointer;');
+  Add('  r: tpoint;');
+  Add('begin');
+  Add('  p:=typeinfo(tpoint);');
+  Add('  p:=typeinfo(r);');
+  Add('  p:=typeinfo(r.x);');
+  ConvertProgram;
+  CheckSource('TestRTTI_Record',
+    LinesToStr([ // statements
+    'this.TPoint = function (s) {',
+    '  if (s) {',
+    '    this.x = s.x;',
+    '    this.y = s.y;',
+    '  } else {',
+    '    this.x = 0;',
+    '    this.y = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return (this.x == b.x) && (this.y == b.y);',
+    '  };',
+    '};',
+    '$mod.$rtti.$Record("TPoint", {}).addFields("x", rtl.longint, "y", rtl.longint);',
+    'this.p = null;',
+    'this.r = new $mod.TPoint();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TPoint"];',
+    '$mod.p = $mod.$rtti["TPoint"];',
+    '$mod.p = rtl.longint;',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_LocalTypes;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TPoint = record');
+  Add('    x,y: integer;');
+  Add('  end;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_LocalTypes',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  this.TPoint = function (s) {',
+    '    if (s) {',
+    '      this.x = s.x;',
+    '      this.y = s.y;',
+    '    } else {',
+    '      this.x = 0;',
+    '      this.y = 0;',
+    '    };',
+    '    this.$equal = function (b) {',
+    '      return (this.x == b.x) && (this.y == b.y);',
+    '    };',
+    '  };',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_TypeInfo_BaseTypes;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('type');
+  Add('  TCaption = string;');
+  Add('  TYesNo = boolean;');
+  Add('  TLetter = char;');
+  Add('  TFloat = double;');
+  Add('  TPtr = pointer;');
+  Add('  TShortInt = shortint;');
+  Add('  TByte = byte;');
+  Add('  TSmallInt = smallint;');
+  Add('  TWord = word;');
+  Add('  TInt32 = longint;');
+  Add('  TDWord = longword;');
+  Add('  TValue = jsvalue;');
+  Add('var p: TPtr;');
+  Add('begin');
+  Add('  p:=typeinfo(string);');
+  Add('  p:=typeinfo(tcaption);');
+  Add('  p:=typeinfo(boolean);');
+  Add('  p:=typeinfo(tyesno);');
+  Add('  p:=typeinfo(char);');
+  Add('  p:=typeinfo(tletter);');
+  Add('  p:=typeinfo(double);');
+  Add('  p:=typeinfo(tfloat);');
+  Add('  p:=typeinfo(pointer);');
+  Add('  p:=typeinfo(tptr);');
+  Add('  p:=typeinfo(shortint);');
+  Add('  p:=typeinfo(tshortint);');
+  Add('  p:=typeinfo(byte);');
+  Add('  p:=typeinfo(tbyte);');
+  Add('  p:=typeinfo(smallint);');
+  Add('  p:=typeinfo(tsmallint);');
+  Add('  p:=typeinfo(word);');
+  Add('  p:=typeinfo(tword);');
+  Add('  p:=typeinfo(longword);');
+  Add('  p:=typeinfo(tdword);');
+  Add('  p:=typeinfo(jsvalue);');
+  Add('  p:=typeinfo(tvalue);');
+  ConvertProgram;
+  CheckSource('TestRTTI_TypeInfo_BaseTypes',
+    LinesToStr([ // statements
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = rtl.string;',
+    '$mod.p = rtl.string;',
+    '$mod.p = rtl.boolean;',
+    '$mod.p = rtl.boolean;',
+    '$mod.p = rtl.char;',
+    '$mod.p = rtl.char;',
+    '$mod.p = rtl.double;',
+    '$mod.p = rtl.double;',
+    '$mod.p = rtl.pointer;',
+    '$mod.p = rtl.pointer;',
+    '$mod.p = rtl.shortint;',
+    '$mod.p = rtl.shortint;',
+    '$mod.p = rtl.byte;',
+    '$mod.p = rtl.byte;',
+    '$mod.p = rtl.smallint;',
+    '$mod.p = rtl.smallint;',
+    '$mod.p = rtl.word;',
+    '$mod.p = rtl.word;',
+    '$mod.p = rtl.longword;',
+    '$mod.p = rtl.longword;',
+    '$mod.p = rtl.jsvalue;',
+    '$mod.p = rtl.jsvalue;',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_TypeInfo_LocalFail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('type');
+  Add('  integer = longint;');
+  Add('  TPoint = record');
+  Add('    x,y: integer;');
+  Add('  end;');
+  Add('var p: pointer;');
+  Add('begin');
+  Add('  p:=typeinfo(tpoint);');
+  Add('end;');
+  Add('begin');
+  SetExpectedPasResolverError(sSymbolCannotBePublished,nSymbolCannotBePublished);
+  ConvertProgram;
+end;
+
+procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
+  Add('  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;');
+  Add('  TFlag = (up,down);');
+  Add('  TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;');
+  Add('  TFlags = set of TFlag;');
+  Add('  TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;');
+  Add('var');
+  Add('  ti: TTypeInfo;');
+  Add('  tiInt: TTypeInfoInteger;');
+  Add('  tiEnum: TTypeInfoEnum;');
+  Add('  tiSet: TTypeInfoSet;');
+  Add('begin');
+  Add('  ti:=typeinfo(string);');
+  Add('  ti:=typeinfo(boolean);');
+  Add('  ti:=typeinfo(char);');
+  Add('  ti:=typeinfo(double);');
+  Add('  tiInt:=typeinfo(shortint);');
+  Add('  tiInt:=typeinfo(byte);');
+  Add('  tiInt:=typeinfo(smallint);');
+  Add('  tiInt:=typeinfo(word);');
+  Add('  tiInt:=typeinfo(longint);');
+  Add('  tiInt:=typeinfo(longword);');
+  Add('  ti:=typeinfo(jsvalue);');
+  Add('  tiEnum:=typeinfo(tflag);');
+  Add('  tiSet:=typeinfo(tflags);');
+  ConvertProgram;
+  CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses1',
+    LinesToStr([ // statements
+    'this.TFlag = {',
+    '  "0": "up",',
+    '  up: 0,',
+    '  "1": "down",',
+    '  down: 1',
+    '};',
+    '$mod.$rtti.$Enum("TFlag", {',
+    '  minvalue: 0,',
+    '  maxvalue: 1,',
+    '  enumtype: this.TFlag',
+    '});',
+    '$mod.$rtti.$Set("TFlags", {',
+    '  comptype: $mod.$rtti["TFlag"]',
+    '});',
+    'this.ti = null;',
+    'this.tiInt = null;',
+    'this.tiEnum = null;',
+    'this.tiSet = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.ti = rtl.string;',
+    '$mod.ti = rtl.boolean;',
+    '$mod.ti = rtl.char;',
+    '$mod.ti = rtl.double;',
+    '$mod.tiInt = rtl.shortint;',
+    '$mod.tiInt = rtl.byte;',
+    '$mod.tiInt = rtl.smallint;',
+    '$mod.tiInt = rtl.word;',
+    '$mod.tiInt = rtl.longint;',
+    '$mod.tiInt = rtl.longword;',
+    '$mod.ti = rtl.jsvalue;',
+    '$mod.tiEnum = $mod.$rtti["TFlag"];',
+    '$mod.tiSet = $mod.$rtti["TFlags"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
+  Add('  TStaticArr = array[boolean] of string;');
+  Add('  TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;');
+  Add('  TDynArr = array of string;');
+  Add('  TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;');
+  Add('  TProc = procedure;');
+  Add('  TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;');
+  Add('  TMethod = procedure of object;');
+  Add('  TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;');
+  Add('var');
+  Add('  StaticArray: TStaticArr;');
+  Add('  tiStaticArray: TTypeInfoStaticArray;');
+  Add('  DynArray: TDynArr;');
+  Add('  tiDynArray: TTypeInfoDynArray;');
+  Add('  ProcVar: TProc;');
+  Add('  tiProcVar: TTypeInfoProcVar;');
+  Add('  MethodVar: TMethod;');
+  Add('  tiMethodVar: TTypeInfoMethodVar;');
+  Add('begin');
+  Add('  tiStaticArray:=typeinfo(StaticArray);');
+  Add('  tiStaticArray:=typeinfo(TStaticArr);');
+  Add('  tiDynArray:=typeinfo(DynArray);');
+  Add('  tiDynArray:=typeinfo(TDynArr);');
+  Add('  tiProcVar:=typeinfo(ProcVar);');
+  Add('  tiProcVar:=typeinfo(TProc);');
+  Add('  tiMethodVar:=typeinfo(MethodVar);');
+  Add('  tiMethodVar:=typeinfo(TMethod);');
+  ConvertProgram;
+  CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses2',
+    LinesToStr([ // statements
+    '  $mod.$rtti.$StaticArray("TStaticArr", {',
+    '  dims: [2],',
+    '  eltype: rtl.string',
+    '});',
+    '$mod.$rtti.$DynArray("TDynArr", {',
+    '  eltype: rtl.string',
+    '});',
+    '$mod.$rtti.$ProcVar("TProc", {',
+    '  procsig: rtl.newTIProcSig(null)',
+    '});',
+    '$mod.$rtti.$MethodVar("TMethod", {',
+    '  procsig: rtl.newTIProcSig(null),',
+    '  methodkind: 0',
+    '});',
+    'this.StaticArray = rtl.arrayNewMultiDim([2], "");',
+    'this.tiStaticArray = null;',
+    'this.DynArray = [];',
+    'this.tiDynArray = null;',
+    'this.ProcVar = null;',
+    'this.tiProcVar = null;',
+    'this.MethodVar = null;',
+    'this.tiMethodVar = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
+    '$mod.tiStaticArray = $mod.$rtti["TStaticArr"];',
+    '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
+    '$mod.tiDynArray = $mod.$rtti["TDynArr"];',
+    '$mod.tiProcVar = $mod.$rtti["TProc"];',
+    '$mod.tiProcVar = $mod.$rtti["TProc"];',
+    '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
+    '$mod.tiMethodVar = $mod.$rtti["TMethod"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add('{$modeswitch externalclass}');
+  Add('type');
+  Add('  TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
+  Add('  TRec = record end;');
+  Add('  TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;');
+  // ToDo: ^PRec
+  Add('  TObject = class end;');
+  Add('  TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;');
+  Add('  TClass = class of tobject;');
+  Add('  TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;');
+  Add('  TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;');
+  Add('var');
+  Add('  Rec: trec;');
+  Add('  tiRecord: ttypeinforecord;');
+  Add('  Obj: tobject;');
+  Add('  tiClass: ttypeinfoclass;');
+  Add('  aClass: tclass;');
+  Add('  tiClassRef: ttypeinfoclassref;');
+  // ToDo: ^PRec
+  Add('  tiPointer: ttypeinfopointer;');
+  Add('begin');
+  Add('  tirecord:=typeinfo(trec);');
+  Add('  tirecord:=typeinfo(trec);');
+  Add('  ticlass:=typeinfo(obj);');
+  Add('  ticlass:=typeinfo(tobject);');
+  Add('  ticlass:=typeinfo(aclass);');
+  Add('  ticlassref:=typeinfo(tclass);');
+  ConvertProgram;
+  CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
+    LinesToStr([ // statements
+    'this.TRec = function (s) {',
+    '};',
+    '$mod.$rtti.$Record("TRec", {});',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    '$mod.$rtti.$ClassRef("TClass", {',
+    '  instancetype: $mod.$rtti["TObject"]',
+    '});',
+    'this.Rec = new $mod.TRec();',
+    'this.tiRecord = null;',
+    'this.Obj = null;',
+    'this.tiClass = null;',
+    'this.aClass = null;',
+    'this.tiClassRef = null;',
+    'this.tiPointer = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.tiRecord = $mod.$rtti["TRec"];',
+    '$mod.tiRecord = $mod.$rtti["TRec"];',
+    '$mod.tiClass = $mod.Obj.$rtti;',
+    '$mod.tiClass = $mod.$rtti["TObject"];',
+    '$mod.tiClass = $mod.aClass.$rtti;',
+    '$mod.tiClassRef = $mod.$rtti["TClass"];',
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TClass = class of tobject;',
+  '  TObject = class',
+  '    function MyClass: TClass;',
+  '    class function ClassType: TClass;',
+  '  end;',
+  '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
+  '  TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
+  'function TObject.MyClass: TClass;',
+  'var t: TTypeInfoClass;',
+  'begin',
+  '  t:=TypeInfo(Self);',
+  '  t:=TypeInfo(Result);',
+  'end;',
+  'class function TObject.ClassType: TClass;',
+  'var t: TTypeInfoClass;',
+  'begin',
+  '  t:=TypeInfo(Self);',
+  '  t:=TypeInfo(Result);',
+  'end;',
+  'var',
+  '  Obj: TObject;',
+  '  t: TTypeInfoClass;',
+  'begin',
+  '  t:=TypeInfo(TObject.ClassType);',
+  '  t:=TypeInfo(Obj.ClassType);',
+  '  t:=TypeInfo(Obj.MyClass);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRTTI_TypeInfo_FunctionClassType',
+    LinesToStr([ // statements
+    '$mod.$rtti.$Class("TObject");',
+    '$mod.$rtti.$ClassRef("TClass", {',
+    '  instancetype: $mod.$rtti["TObject"]',
+    '});',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.MyClass = function () {',
+    '    var Result = null;',
+    '    var t = null;',
+    '    t = this.$rtti;',
+    '    t = Result.$rtti;',
+    '    return Result;',
+    '  };',
+    '  this.ClassType = function () {',
+    '    var Result = null;',
+    '    var t = null;',
+    '    t = this.$rtti;',
+    '    t = Result.$rtti;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.t = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.t = $mod.TObject.ClassType().$rtti;',
+    '$mod.t = $mod.Obj.$class.ClassType().$rtti;',
+    '$mod.t = $mod.Obj.MyClass().$rtti;',
+    '']));
+end;
+
+Initialization
+  RegisterTests([TTestModule]);
+end.
+
diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas
new file mode 100644
index 0000000000..a476e2be81
--- /dev/null
+++ b/packages/pastojs/tests/tcoptimizations.pas
@@ -0,0 +1,866 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2017 by Michael Van Canneyt
+
+    Unit tests for Pascal-to-Javascript converter class.
+
+    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.
+
+ **********************************************************************
+
+ Examples:
+   ./testpas2js --suite=TTestOptimizations
+   ./testpas2js --suite=TTestOptimizations.TestOmitLocalVar
+}
+unit tcoptimizations;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, testregistry, fppas2js, pastree,
+  PScanner, PasUseAnalyzer, PasResolver, PasResolveEval,
+  tcmodules;
+
+type
+
+
+  { TCustomTestOptimizations }
+
+  TCustomTestOptimizations = class(TCustomTestModule)
+  private
+    FAnalyzerModule: TPasAnalyzer;
+    FAnalyzerProgram: TPasAnalyzer;
+    FWholeProgramOptimization: boolean;
+    function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
+    function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    procedure ParseModule; override;
+    procedure ParseProgram; override;
+  public
+    property AnalyzerModule: TPasAnalyzer read FAnalyzerModule;
+    property AnalyzerProgram: TPasAnalyzer read FAnalyzerProgram;
+    property WholeProgramOptimization: boolean read FWholeProgramOptimization
+        write FWholeProgramOptimization;
+  end;
+
+  { TTestOptimizations }
+
+  TTestOptimizations = class(TCustomTestOptimizations)
+  published
+    // Whole Program Optimization
+    procedure TestWPO_OmitLocalVar;
+    procedure TestWPO_OmitLocalProc;
+    procedure TestWPO_OmitLocalProcForward;
+    procedure TestWPO_OmitProcLocalVar;
+    procedure TestWPO_OmitProcLocalConst;
+    procedure TestWPO_OmitProcLocalType;
+    procedure TestWPO_OmitProcLocalProc;
+    procedure TestWPO_OmitProcLocalForwardProc;
+    procedure TestWPO_OmitRecordMember;
+    procedure TestWPO_OmitNotUsedTObject;
+    procedure TestWPO_TObject;
+    procedure TestWPO_OmitClassField;
+    procedure TestWPO_OmitClassMethod;
+    procedure TestWPO_OmitClassClassMethod;
+    procedure TestWPO_OmitPropertyGetter1;
+    procedure TestWPO_OmitPropertyGetter2;
+    procedure TestWPO_OmitPropertySetter1;
+    procedure TestWPO_OmitPropertySetter2;
+    procedure TestWPO_CallInherited;
+    procedure TestWPO_UseUnit;
+    procedure TestWPO_ProgramPublicDeclaration;
+    procedure TestWPO_RTTI_PublishedField;
+    procedure TestWPO_RTTI_TypeInfo;
+  end;
+
+implementation
+
+{ TCustomTestOptimizations }
+
+function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
+  El: TPasElement): boolean;
+var
+  A: TPasAnalyzer;
+begin
+  if WholeProgramOptimization then
+    A:=AnalyzerProgram
+  else
+    A:=AnalyzerModule;
+  Result:=A.IsUsed(El);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.OnConverterIsElementUsed El=',GetObjName(El),' WPO=',WholeProgramOptimization,' Result=',Result);
+  {$ENDIF}
+end;
+
+function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
+  El: TPasElement): boolean;
+var
+  A: TPasAnalyzer;
+begin
+  if WholeProgramOptimization then
+    A:=AnalyzerProgram
+  else
+    A:=AnalyzerModule;
+  Result:=A.IsTypeInfoUsed(El);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.OnConverterIsTypeInfoUsed El=',GetObjName(El),' WPO=',WholeProgramOptimization,' Result=',Result);
+  {$ENDIF}
+end;
+
+procedure TCustomTestOptimizations.SetUp;
+begin
+  inherited SetUp;
+  FWholeProgramOptimization:=false;
+  FAnalyzerModule:=TPasAnalyzer.Create;
+  FAnalyzerModule.Resolver:=Engine;
+  FAnalyzerProgram:=TPasAnalyzer.Create;
+  FAnalyzerProgram.Resolver:=Engine;
+  Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
+  Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
+end;
+
+procedure TCustomTestOptimizations.TearDown;
+begin
+  FreeAndNil(FAnalyzerProgram);
+  FreeAndNil(FAnalyzerModule);
+  inherited TearDown;
+end;
+
+procedure TCustomTestOptimizations.ParseModule;
+begin
+  inherited ParseModule;
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseModule START');
+  {$ENDIF}
+  AnalyzerModule.AnalyzeModule(Module);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseModule END');
+  {$ENDIF}
+end;
+
+procedure TCustomTestOptimizations.ParseProgram;
+begin
+  WholeProgramOptimization:=true;
+  inherited ParseProgram;
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseProgram START');
+  {$ENDIF}
+  AnalyzerProgram.AnalyzeWholeProgram(Module as TPasProgram);
+  {$IF defined(VerbosePas2JS) or defined(VerbosePasAnalyzer)}
+  writeln('TCustomTestOptimizations.ParseProgram START');
+  {$ENDIF}
+end;
+
+{ TTestOptimizations }
+
+procedure TTestOptimizations.TestWPO_OmitLocalVar;
+begin
+  StartProgram(false);
+  Add('var');
+  Add('  a: longint;');
+  Add('  b: longint;');
+  Add('begin');
+  Add('  b:=3;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitLocalVar',
+    'this.b = 0;',
+    '$mod.b = 3;');
+end;
+
+procedure TTestOptimizations.TestWPO_OmitLocalProc;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; begin end;');
+  Add('procedure NoIt; begin end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitLocalProc',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitLocalProcForward;
+begin
+  StartProgram(false);
+  Add('procedure DoIt; forward;');
+  Add('procedure NoIt; forward;');
+  Add('procedure DoIt; begin end;');
+  Add('procedure NoIt; begin end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitLocalProcForward',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalVar;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('var');
+  Add('  a: longint;');
+  Add('  b: longint;');
+  Add('begin');
+  Add('  b:=3;');
+  Add('  Result:=b;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalVar',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  var b = 0;',
+    '  b = 3;',
+    '  Result = b;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalConst;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('const');
+  Add('  a = 3;');
+  Add('  b = 4;');
+  Add('  c: longint = 5;');
+  Add('  d: longint = 6;');
+  Add('begin');
+  Add('  Result:=b+d;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalConst',
+    LinesToStr([
+    'var b = 4;',
+    'var d = 6;',
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  Result = b + d;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalType;
+begin
+  StartProgram(false);
+  Add('function DoIt: longint;');
+  Add('type');
+  Add('  TEnum = (red, green);');
+  Add('  TEnums = set of TEnum;');
+  Add('begin');
+  Add('  Result:=3;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalType',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  var Result = 0;',
+    '  Result = 3;',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalProc;
+begin
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('  procedure SubProcA; begin end;');
+  Add('  procedure SubProcB; begin end;');
+  Add('begin');
+  Add('  SubProcB;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalProc',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  function SubProcB() {',
+    '  };',
+    '  SubProcB();',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitProcLocalForwardProc;
+begin
+  StartProgram(false);
+  Add('procedure DoIt;');
+  Add('  procedure SubProcA; forward;');
+  Add('  procedure SubProcB; forward;');
+  Add('  procedure SubProcA; begin end;');
+  Add('  procedure SubProcB; begin end;');
+  Add('begin');
+  Add('  SubProcB;');
+  Add('end;');
+  Add('begin');
+  Add('  DoIt;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitProcLocalForwardProc',
+    LinesToStr([
+    'this.DoIt = function () {',
+    '  function SubProcB() {',
+    '  };',
+    '  SubProcB();',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoIt();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitRecordMember;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TRec = record');
+  Add('    a: longint;');
+  Add('    b: longint;');
+  Add('  end;');
+  Add('var r: TRec;');
+  Add('begin');
+  Add('  r.a:=3;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitRecordMember',
+    LinesToStr([
+    'this.TRec = function (s) {',
+    '  if (s) {',
+    '    this.a = s.a;',
+    '  } else {',
+    '    this.a = 0;',
+    '  };',
+    '  this.$equal = function (b) {',
+    '    return this.a == b.a;',
+    '  };',
+    '};',
+    'this.r = new $mod.TRec();',
+    '']),
+    LinesToStr([
+    '$mod.r.a = 3;',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitNotUsedTObject;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class end;');
+  Add('var o: TObject;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitNotUsedTObject',
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_TObject;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure AfterConstruction; virtual;');
+  Add('    procedure BeforeDestruction; virtual;');
+  Add('  end;');
+  Add('procedure TObject.AfterConstruction; begin end;');
+  Add('procedure TObject.BeforeDestruction; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o:=nil;');
+  ConvertProgram;
+  CheckSource('TestWPO_TObject',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.AfterConstruction = function () {',
+    '  };',
+    '  this.BeforeDestruction = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o = null;']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitClassField;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    a: longint;');
+  Add('    b: longint;');
+  Add('  end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.a:=3;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassField',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.a = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o.a = 3;']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure ProcA;');
+  Add('    procedure ProcB;');
+  Add('  end;');
+  Add('procedure TObject.ProcA; begin end;');
+  Add('procedure TObject.ProcB; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.ProcB;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassMethod',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcB = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o.ProcB();']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitClassClassMethod;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class procedure ProcA;');
+  Add('    class procedure ProcB;');
+  Add('  end;');
+  Add('class procedure TObject.ProcA; begin end;');
+  Add('class procedure TObject.ProcB; begin end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.ProcB;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassMethod',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.ProcB = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o.$class.ProcB();']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertyGetter1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    function GetFoo: boolean;');
+  Add('    property Foo: boolean read FFoo;');
+  Add('    property Foo2: boolean read GetFoo;');
+  Add('    FBar: boolean;');
+  Add('    function GetBar: boolean;');
+  Add('    property Bar: boolean read FBar;');
+  Add('    property Bar2: boolean read GetBar;');
+  Add('  end;');
+  Add('function TObject.GetFoo: boolean; begin Result:=FFoo; end;');
+  Add('function TObject.GetBar: boolean; begin Result:=FBar; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  if o.Foo then;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertyGetter1',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'if ($mod.o.FFoo);',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertyGetter2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    function GetFoo: boolean;');
+  Add('    property Foo: boolean read FFoo;');
+  Add('    property Foo2: boolean read GetFoo;');
+  Add('  end;');
+  Add('function TObject.GetFoo: boolean; begin Result:=FFoo; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  if o.Foo2 then;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertyGetter2',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetFoo = function () {',
+    '    var Result = false;',
+    '    Result = this.FFoo;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    'if ($mod.o.GetFoo()) ;',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertySetter1;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    procedure SetFoo(Value: boolean);');
+  Add('    property Foo: boolean write FFoo;');
+  Add('    property Foo2: boolean write SetFoo;');
+  Add('    FBar: boolean;');
+  Add('    procedure SetBar(Value: boolean);');
+  Add('    property Bar: boolean write FBar;');
+  Add('    property Bar2: boolean write SetBar;');
+  Add('  end;');
+  Add('procedure TObject.SetFoo(Value: boolean); begin FFoo:=Value; end;');
+  Add('procedure TObject.SetBar(Value: boolean); begin FBar:=Value; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.Foo:=true;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertySetter1',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o.FFoo = true;',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_OmitPropertySetter2;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    FFoo: boolean;');
+  Add('    procedure SetFoo(Value: boolean);');
+  Add('    property Foo: boolean write FFoo;');
+  Add('    property Foo2: boolean write SetFoo;');
+  Add('  end;');
+  Add('procedure TObject.SetFoo(Value: boolean); begin FFoo:=Value; end;');
+  Add('var o: TObject;');
+  Add('begin');
+  Add('  o.Foo2:=true;');
+  ConvertProgram;
+  CheckSource('TestWPO_OmitClassPropertySetter2',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FFoo = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.SetFoo = function (Value) {',
+    '    this.FFoo = Value;',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o.SetFoo(true);',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_CallInherited;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    procedure DoA;');
+  Add('    procedure DoB;');
+  Add('  end;');
+  Add('  TMobile = class');
+  Add('    procedure DoA;');
+  Add('    procedure DoC;');
+  Add('  end;');
+  Add('procedure TObject.DoA; begin end;');
+  Add('procedure TObject.DoB; begin end;');
+  Add('procedure TMobile.DoA;');
+  Add('begin');
+  Add('  inherited;');
+  Add('end;');
+  Add('procedure TMobile.DoC;');
+  Add('begin');
+  Add('  inherited DoB;');
+  Add('end;');
+  Add('var o: TMobile;');
+  Add('begin');
+  Add('  o.DoA;');
+  Add('  o.DoC;');
+  ConvertProgram;
+  CheckSource('TestWPO_CallInherited',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoA = function () {',
+    '  };',
+    '  this.DoB = function () {',
+    '  };',
+    '});',
+    ' rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
+    '  this.DoA$1 = function () {',
+    '    $mod.TObject.DoA.apply(this, arguments);',
+    '  };',
+    '  this.DoC = function () {',
+    '    $mod.TObject.DoB.call(this);',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([
+    '$mod.o.DoA$1();',
+    '$mod.o.DoC();',
+    '']));
+end;
+
+procedure TTestOptimizations.TestWPO_UseUnit;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'var i: longint;',
+    'procedure DoIt;',
+    '']),
+    LinesToStr([
+    'procedure DoIt; begin end;']));
+
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var j: longint;',
+    'procedure DoMore;',
+    '']),
+    LinesToStr([
+    'procedure DoMore; begin end;']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  j:=3;');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system", "unit2"], function () {',
+    '  var $mod = this;',
+    '  $mod.$main = function () {',
+    '    pas.unit2.j = 3;',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
+end;
+
+procedure TTestOptimizations.TestWPO_ProgramPublicDeclaration;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  StartProgram(true);
+  Add('var');
+  Add('  vPublic: longint; public;');
+  Add('  vPrivate: longint;');
+  Add('procedure DoPublic; public; begin end;');
+  Add('procedure DoPrivate; begin end;');
+  Add('begin');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system"], function () {',
+    '  var $mod = this;',
+    '  this.vPublic = 0;',
+    '  this.DoPublic =function(){',
+    '  };',
+    '  $mod.$main = function () {',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_ProgramPublicDeclaration',ExpectedSrc,ActualSrc);
+end;
+
+procedure TTestOptimizations.TestWPO_RTTI_PublishedField;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true);
+  Add('type');
+  Add('  TArrA = array of char;');
+  Add('  TArrB = array of string;');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    PublicA: TArrA;');
+  Add('  published');
+  Add('    PublishedB: TArrB;');
+  Add('  end;');
+  Add('var');
+  Add('  C: TObject;');
+  Add('begin');
+  Add('  C.PublicA:=nil;');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system"], function () {',
+    '  var $mod = this;',
+    '  $mod.$rtti.$DynArray("TArrB", {',
+    '    eltype: rtl.string',
+    '  });',
+    '  rtl.createClass($mod, "TObject", null, function () {',
+    '    this.$init = function () {',
+    '      this.PublicA = [];',
+    '      this.PublishedB = [];',
+    '    };',
+    '    this.$final = function () {',
+    '      this.PublicA = undefined;',
+    '      this.PublishedB = undefined;',
+    '    };',
+    '    var $r = this.$rtti;',
+    '    $r.addField("PublishedB", $mod.$rtti["TArrB"]);',
+    '  });',
+    '  this.C = null;',
+    '  $mod.$main = function () {',
+    '    $mod.C.PublicA = [];',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_RTTI_PublishedField',ExpectedSrc,ActualSrc);
+end;
+
+procedure TTestOptimizations.TestWPO_RTTI_TypeInfo;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true);
+  Add('type');
+  Add('  TArrA = array of char;');
+  Add('  TArrB = array of string;');
+  Add('var');
+  Add('  A: TArrA;');
+  Add('  B: TArrB;');
+  Add('  p: pointer;');
+  Add('begin');
+  Add('  A:=nil;');
+  Add('  p:=typeinfo(B);');
+  ConvertProgram;
+  ActualSrc:=JSToStr(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system"], function () {',
+    '  var $mod = this;',
+    '  $mod.$rtti.$DynArray("TArrB", {',
+    '    eltype: rtl.string',
+    '  });',
+    '  this.A = [];',
+    '  this.B = [];',
+    '  this.p = null;',
+    '  $mod.$main = function () {',
+    '    $mod.A = [];',
+    '    $mod.p = $mod.$rtti["TArrB"];',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_RTTI_TypeInfo',ExpectedSrc,ActualSrc);
+end;
+
+Initialization
+  RegisterTests([TTestOptimizations]);
+end.
+
diff --git a/packages/pastojs/tests/testpas2js.lpi b/packages/pastojs/tests/testpas2js.lpi
index e9ae7fad29..46da792b59 100644
--- a/packages/pastojs/tests/testpas2js.lpi
+++ b/packages/pastojs/tests/testpas2js.lpi
@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -12,9 +12,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
@@ -34,35 +31,53 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="5">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testpas2js"/>
       </Unit0>
       <Unit1>
         <Filename Value="tcconverter.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcconverter"/>
       </Unit1>
       <Unit2>
         <Filename Value="../src/fppas2js.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fppas2js"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="tcmodules.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="tcoptimizations.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="11"/>
+    <Target>
+      <Filename Value="testpas2js"/>
+    </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src"/>
+      <OtherUnitFiles Value="../src;../../fcl-js/src;../../fcl-passrc/src;../../pastojs/tests"/>
+      <UnitOutputDirectory Value="lib"/>
     </SearchPaths>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
     <Other>
-      <CompilerMessages>
-        <MsgFileName Value=""/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
+      <CustomOptions Value="-dVerbosePas2JS"/>
+      <OtherDefines Count="1">
+        <Define0 Value="VerbosePas2JS"/>
+      </OtherDefines>
     </Other>
   </CompilerOptions>
   <Debugging>
diff --git a/packages/pastojs/tests/testpas2js.pp b/packages/pastojs/tests/testpas2js.pp
index db958f61e4..07670f1851 100644
--- a/packages/pastojs/tests/testpas2js.pp
+++ b/packages/pastojs/tests/testpas2js.pp
@@ -17,7 +17,7 @@ program testpas2js;
 {$mode objfpc}{$H+}
 
 uses
-  Classes, consoletestrunner, tcconverter, fppas2js;
+  Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations;
 
 type
 
diff --git a/packages/paszlib/src/zipper.pp b/packages/paszlib/src/zipper.pp
index 5bcdbbac5f..c5ff2ffe26 100644
--- a/packages/paszlib/src/zipper.pp
+++ b/packages/paszlib/src/zipper.pp
@@ -339,7 +339,7 @@ Type
   TZipFileEntry = Class(TCollectionItem)
   private
     FArchiveFileName: String; //Name of the file as it appears in the zip file list
-    FAttributes: LongInt;
+    FAttributes: LongWord;
     FDateTime: TDateTime;
     FDiskFileName: String; {Name of the file on disk (i.e. uncompressed. Can be empty if based on a stream.);
     uses local OS/filesystem directory separators}
@@ -368,7 +368,7 @@ Type
     Property Size : Int64 Read FSize Write FSize;
     Property DateTime : TDateTime Read FDateTime Write FDateTime;
     property OS: Byte read FOS write FOS;
-    property Attributes: LongInt read FAttributes write FAttributes;
+    property Attributes: LongWord read FAttributes write FAttributes;
     Property CompressionLevel: TCompressionlevel read FCompressionLevel write FCompressionLevel;
   end;
 
diff --git a/packages/paszlib/src/zstream.pp b/packages/paszlib/src/zstream.pp
index 5d568092f9..b37bd70105 100644
--- a/packages/paszlib/src/zstream.pp
+++ b/packages/paszlib/src/zstream.pp
@@ -324,7 +324,7 @@ begin
     raise Edecompressionerror.create(zerror(err));
 end;
 
-function Tdecompressionstream.GetPosition() : Int64; 
+function Tdecompressionstream.GetPosition() : Int64;
 begin
   GetPosition := raw_read;
 end;
@@ -335,31 +335,28 @@ var c,off: int64;
 
 begin
   off:=Offset;
-  if (origin=soBeginning) or  ((origin=soCurrent) and (off+raw_read>=0)) then
-    begin
-      if origin = soCurrent then
-        seek := raw_read + off
-      else
-        seek := off;
-        
-      if origin=soBeginning then
-        dec(off,raw_read);
-      if offset<0 then
-        begin
-          inc(off,raw_read);
-          reset;
-        end;
-      while off>0 do
-        begin
-          c:=off;
-          if c>bufsize then
-            c:=bufsize;
-          c:=read(Fbuffer^,c);
-          dec(off,c);
-        end;
-    end
-  else
+
+  if origin=soCurrent then
+    inc(off,raw_read);
+  if (origin=soEnd) or (off<0) then
     raise Edecompressionerror.create(Sseek_failed);
+
+  seek:=off;
+
+  if off<raw_read then
+    reset
+  else
+    dec(off,raw_read);
+
+  while off>0 do
+    begin
+      c:=off;
+      if c>bufsize then
+        c:=bufsize;
+      if read(Fbuffer^,c)<>c then
+        raise Edecompressionerror.create(Sseek_failed);
+      dec(off,c);
+    end;
 end;
 
 function Tdecompressionstream.get_compressionrate:single;
diff --git a/packages/paszlib/tests/tczstreamseek.pp b/packages/paszlib/tests/tczstreamseek.pp
new file mode 100644
index 0000000000..9ba41b0943
--- /dev/null
+++ b/packages/paszlib/tests/tczstreamseek.pp
@@ -0,0 +1,58 @@
+program tczstreamseek;
+{$MODE OBJFPC}
+{$ASSERTIONS ON}
+
+uses
+  classes,
+  zstream;
+
+const
+  val: Uint32 = $123456;
+  wasError: boolean = False;
+var
+  data: TMemoryStream;
+  comprStream: TCompressionStream;
+  decomprStream: TDecompressionStream;
+begin
+  data := TMemoryStream.Create();
+
+  comprStream := TCompressionStream.Create(clMax, data);
+  comprStream.WriteDWord(val);
+  comprStream.Free;
+
+  data.Seek(0, soFromBeginning);
+
+  decomprStream := TDecompressionStream.Create(data);
+  Assert(decomprStream.ReadDWord() = val);
+  Assert(decomprStream.Position = SizeOf(val));
+
+  decomprStream.Seek(0, soFromBeginning);
+  Assert(decomprStream.Position = 0);
+  Assert(decomprStream.ReadDWord() = val);
+
+  decomprStream.Seek(-SizeOf(val), soFromCurrent);
+  Assert(decomprStream.Position = 0);
+  Assert(decomprStream.ReadDWord() = val);
+
+  wasError := False;
+  decomprStream.Seek(0, soFromBeginning);
+  try
+    decomprStream.Seek(-SizeOf(val), soFromCurrent);
+  except
+    on EDecompressionError do
+      wasError := True;
+  end;
+  assert(wasError);
+
+  decomprStream.Seek(SizeOf(val), soFromBeginning);
+  Assert(decomprStream.Position = SizeOf(val));
+
+  wasError := False;
+  try
+    decomprStream.Seek(40, soFromBeginning);
+  except
+    on EDecompressionError do
+      wasError := True;
+  end;
+  assert(wasError);
+end.
diff --git a/packages/postgres/src/postgres3dyn.pp b/packages/postgres/src/postgres3dyn.pp
index b434ef7a61..8c4e4e9867 100644
--- a/packages/postgres/src/postgres3dyn.pp
+++ b/packages/postgres/src/postgres3dyn.pp
@@ -233,6 +233,8 @@ var
 { === in fe-auth.c === }
   PQencryptPassword : function (passwd:Pcchar; user:Pcchar):Pcchar;cdecl;
 
+{ === in encnames.c === }
+  pg_encoding_to_char: function (encoding:cint):Pcchar;cdecl;
 
 Function InitialisePostgres3(Const libpath : ansistring) : integer;
 Procedure InitialisePostgres3;
@@ -398,6 +400,7 @@ begin
       pointer(PQmblen) := GetProcedureAddress(Postgres3LibraryHandle,'PQmblen');
       pointer(PQenv2encoding) := GetProcedureAddress(Postgres3LibraryHandle,'PQenv2encoding');
       pointer(PQencryptPassword) := GetProcedureAddress(Postgres3LibraryHandle,'PQencryptPassword');
+      pointer(pg_encoding_to_char) := GetProcedureAddress(Postgres3LibraryHandle,'pg_encoding_to_char');
 
       InitialiseDllist(libpath);
       end
diff --git a/packages/ptc/docs/CHANGES.txt b/packages/ptc/docs/CHANGES.txt
index 8469293ec7..c414a657ec 100644
--- a/packages/ptc/docs/CHANGES.txt
+++ b/packages/ptc/docs/CHANGES.txt
@@ -1,3 +1,107 @@
+0.99.15
+ - dead key support under Windows and X11 (via XIM)
+ - more character scripts (Latin 2, Latin 3, Latin 4, Latin 9, Katakana,
+   Arabic, Greek with diacritics, Technical, Special, Publishing, APL, Hebrew,
+   Thai, Currency signs - Korean Won sign and Euro sign) are now recognized and
+   converted to Unicode in the X11 console. Previously only Latin 1, Greek
+   without diacritics and Cyrillic were supported, but even they didn't work in
+   recent ptcpas versions, due to regressions, which are now fixed as well.
+ - use an alternative method (via GetKeyState) for obtaining the Alt, Shift and
+   Control key modifier status under Windows; This eliminates a problem, where
+   the alt key appears "stuck", after alt-tabbing away from the application,
+   then focusing back to it with a mouse click.
+ - new key modifiers added for distinguishing between left and right shift,
+   control and alt, the status of num lock, caps lock and scroll lock and for
+   distinguishing right keys (e.g. right shift, right alt, right ctrl),
+   numpad keys and dead keys. All of them are implemented as elements in the
+   ModifierKeys set, which was added to IPTCKeyEvent. They can be checked,
+   for example, with:
+     if pmkNumLockActive in key_event.ModifierKeys then
+       ...
+   The following modifiers are available:
+     pmkAlt, pmkShift, pmkControl, pmkLeftAlt, pmkRightAlt, pmkLeftShift,
+     pmkRightShift, pmkLeftControl, pmkRightControl, pmkNumLockActive,
+     pmkNumLockPressed, pmkCapsLockActive, pmkCapsLockPressed,
+     pmkScrollLockActive, pmkScrollLockPressed, pmkRightKey, pmkNumPadKey,
+     pmkDeadKey
+ - there is now a MoveMouseTo method, added to the console. It can be used to
+   warp the mouse cursor to a different location.
+ - added support for a relative mouse mode. It supports continuous mouse
+   motion, not limited within the boundaries of the current window. It is
+   usually used with an invisible cursor. It is activated with the
+   'relative mouse on' console option, and turned off with the option
+   'relative mouse off'.
+ - the number of mouse buttons supported has been increased to 31. There is now
+   support for a horizontal and a vertical mouse wheel, which are treated as
+   buttons. Overall, this is the default button arrangement:
+     PTCMouseButton1  - left mouse button
+     PTCMouseButton2  - right mouse button
+     PTCMouseButton3  - middle mouse button
+     PTCMouseButton4  - mouse wheel rotated forward (scroll up)
+     PTCMouseButton5  - mouse wheel rotated backward (scroll down)
+     PTCMouseButton6  - mouse horizontal scroll wheel rotated left
+     PTCMouseButton7  - mouse horizontal scroll wheel rotated right
+     PTCMouseButton8  - "back" button ("X button 1")
+     PTCMouseButton9  - "forward" button ("X button 2")
+   The remaining mouse buttons are hardware specific and will vary, depending
+   on the actual mouse (provided it has that many buttons at all).
+ - ptccrt now supports several keyboard input modes, which can be set by
+   changing the new global variable KeyMode. The following values are supported:
+     kmTP7      - behaves like Turbo Pascal 7's CRT unit under DOS. This is the
+                  default value. Previous versions of ptccrt always behaved this
+                  way. Since TP7's CRT unit doesn't support the Enhanced
+                  Keyboard, several keys (e.g. F11 and F12) and key combinations
+                  are intentionally not recognized for compatibility reasons.
+     kmGO32     - behaves like Free Pascal's CRT unit under DOS (GO32V2). It has
+                  Enhanced Keyboard support.
+     kmFPWINCRT - behaves like Free Pascal's CRT unit under Windows. Similar to
+                  kmGO32, but emulates several incompatibilities that the
+                  Windows CRT unit has with the GO32V2 CRT unit. Not all of them
+                  are emulated though, since some of them can be considered
+                  bugs.
+ - ptcgraph now has a global string variable WindowTitle, which allows you to
+   set the window title, before calling InitGraph
+ - ptcgraph was extended to also support resolutions, different than the ones,
+   defined by VESA. This means that you can now use ptcgraph with resolutions,
+   higher than 1280x1024 and widescreen (e.g. 16:9 or 16:10) aspect ratios, as
+   long as they are supported by the display. For this, you need to call
+   QueryAdapterInfo and walk through the linked list of modes, to choose a
+   mode, then pass its DriverNumber and ModeNumber to InitGraph. Here's an
+   example:
+
+uses
+  ptcgraph, ptccrt;
+var
+  m: PModeInfo;
+  gd, gm: Integer;
+begin
+  Writeln('List of all modes:');
+  m := QueryAdapterInfo;
+  while m <> nil do
+  begin
+    Writeln(m^.MaxX+1, ' x ', m^.MaxY+1, ' x ', m^.MaxColor);
+    m := m^.next;
+  end;
+
+  Writeln('Now let''s find 1920x1080 with 16-bit colour...');
+  m := QueryAdapterInfo;
+  while m <> nil do
+  begin
+    if (m^.MaxX = (1920-1)) and (m^.MaxY = (1080-1)) and (m^.MaxColor = 65536) then
+    begin
+      InitGraph(m^.DriverNumber, m^.ModeNumber, '');
+      SetColor($FFFF);
+      OutTextXY(0, 0, 'Hurrah! Full HD 1920x1080 mode is available!');
+      ReadKey;
+      CloseGraph;
+      Halt;
+    end;
+    m := m^.next;
+  end;
+
+  Writeln('Mode not found in list!');
+end.
+
 0.99.14.1
  - fixed X11 middle and right mouse button mapping. Previously, the right mouse
    button and the middle mouse button were swapped, compared to Windows and DOS
diff --git a/packages/ptc/docs/INSTALL.txt b/packages/ptc/docs/INSTALL.txt
index 07cad0a576..6f1ebfb4ed 100644
--- a/packages/ptc/docs/INSTALL.txt
+++ b/packages/ptc/docs/INSTALL.txt
@@ -1,13 +1,16 @@
-The supported platforms are Linux, FreeBSD, Windows, Windows Mobile and DOS.
+The supported platforms are Linux, FreeBSD, Windows, Windows Mobile and 32-bit
+DOS (go32v2).
 
 Generally you need the latest stable version of the Free Pascal Compiler, which
-currently means version 2.6.2.
+currently means version 3.0.4. Note that Windows 95/98/ME and NT 4.0 are still
+supported, when this library is compiled with FPC 2.6.4. However, using
+FPC 2.6.4 isn't guaranteed to work for any other platforms, besides Windows.
 
  - Compiling the library:
 Before starting make sure the FPCDIR environment variable is set correctly.
-For example: (windows, fpc version 2.6.2, default install dir)
+For example: (windows, fpc version 3.0.4, default install dir)
 
-  set FPCDIR=c:\fpc\2.6.2
+  set FPCDIR=c:\fpc\3.0.4
 
 To compile the library type:
 
diff --git a/packages/ptc/docs/README.txt b/packages/ptc/docs/README.txt
index 93bb3bd166..7f0c9208d4 100644
--- a/packages/ptc/docs/README.txt
+++ b/packages/ptc/docs/README.txt
@@ -1,4 +1,4 @@
-PTCPas 0.99.14.1
+PTCPas 0.99.15
 Nikolay Nikolov (nickysn@users.sourceforge.net)
 
 PTCPas is a free, portable framebuffer library, written in Free Pascal. It is
diff --git a/packages/ptc/docs/lgpl.txt b/packages/ptc/docs/lgpl.txt
index 40ff392ab0..9a408cc725 100644
--- a/packages/ptc/docs/lgpl.txt
+++ b/packages/ptc/docs/lgpl.txt
@@ -485,7 +485,7 @@ convey the exclusion of warranty; and each file should have at least the
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 Also add information on how to contact you by electronic and paper mail.
 
diff --git a/packages/ptc/examples/keyboard3.pp b/packages/ptc/examples/keyboard3.pp
index c484c3703d..6e0770a8db 100644
--- a/packages/ptc/examples/keyboard3.pp
+++ b/packages/ptc/examples/keyboard3.pp
@@ -10,11 +10,143 @@ program KeyboardExample3;
 uses
   ptc;
 
+function KeyCode2String(ACode: Integer): string;
+begin
+  case ACode of
+    PTCKEY_UNDEFINED    : Result := 'PTCKEY_UNDEFINED';
+    PTCKEY_CANCEL       : Result := 'PTCKEY_CANCEL';
+    PTCKEY_BACKSPACE    : Result := 'PTCKEY_BACKSPACE';
+    PTCKEY_TAB          : Result := 'PTCKEY_TAB';
+    PTCKEY_ENTER        : Result := 'PTCKEY_ENTER';
+    PTCKEY_CLEAR        : Result := 'PTCKEY_CLEAR';
+    PTCKEY_SHIFT        : Result := 'PTCKEY_SHIFT';
+    PTCKEY_CONTROL      : Result := 'PTCKEY_CONTROL';
+    PTCKEY_ALT          : Result := 'PTCKEY_ALT';
+    PTCKEY_PAUSE        : Result := 'PTCKEY_PAUSE';
+    PTCKEY_CAPSLOCK     : Result := 'PTCKEY_CAPSLOCK';
+    PTCKEY_KANA         : Result := 'PTCKEY_KANA';
+    PTCKEY_FINAL        : Result := 'PTCKEY_FINAL';
+    PTCKEY_KANJI        : Result := 'PTCKEY_KANJI';
+    PTCKEY_ESCAPE       : Result := 'PTCKEY_ESCAPE';
+    PTCKEY_CONVERT      : Result := 'PTCKEY_CONVERT';
+    PTCKEY_NONCONVERT   : Result := 'PTCKEY_NONCONVERT';
+    PTCKEY_ACCEPT       : Result := 'PTCKEY_ACCEPT';
+    PTCKEY_MODECHANGE   : Result := 'PTCKEY_MODECHANGE';
+    PTCKEY_SPACE        : Result := 'PTCKEY_SPACE';
+    PTCKEY_PAGEUP       : Result := 'PTCKEY_PAGEUP';
+    PTCKEY_PAGEDOWN     : Result := 'PTCKEY_PAGEDOWN';
+    PTCKEY_END          : Result := 'PTCKEY_END';
+    PTCKEY_HOME         : Result := 'PTCKEY_HOME';
+    PTCKEY_LEFT         : Result := 'PTCKEY_LEFT';
+    PTCKEY_UP           : Result := 'PTCKEY_UP';
+    PTCKEY_RIGHT        : Result := 'PTCKEY_RIGHT';
+    PTCKEY_DOWN         : Result := 'PTCKEY_DOWN';
+    PTCKEY_COMMA        : Result := 'PTCKEY_COMMA';
+    PTCKEY_PERIOD       : Result := 'PTCKEY_PERIOD';
+    PTCKEY_SLASH        : Result := 'PTCKEY_SLASH';
+    PTCKEY_ZERO         : Result := 'PTCKEY_ZERO';
+    PTCKEY_ONE          : Result := 'PTCKEY_ONE';
+    PTCKEY_TWO          : Result := 'PTCKEY_TWO';
+    PTCKEY_THREE        : Result := 'PTCKEY_THREE';
+    PTCKEY_FOUR         : Result := 'PTCKEY_FOUR';
+    PTCKEY_FIVE         : Result := 'PTCKEY_FIVE';
+    PTCKEY_SIX          : Result := 'PTCKEY_SIX';
+    PTCKEY_SEVEN        : Result := 'PTCKEY_SEVEN';
+    PTCKEY_EIGHT        : Result := 'PTCKEY_EIGHT';
+    PTCKEY_NINE         : Result := 'PTCKEY_NINE';
+    PTCKEY_SEMICOLON    : Result := 'PTCKEY_SEMICOLON';
+    PTCKEY_EQUALS       : Result := 'PTCKEY_EQUALS';
+    PTCKEY_A            : Result := 'PTCKEY_A';
+    PTCKEY_B            : Result := 'PTCKEY_B';
+    PTCKEY_C            : Result := 'PTCKEY_C';
+    PTCKEY_D            : Result := 'PTCKEY_D';
+    PTCKEY_E            : Result := 'PTCKEY_E';
+    PTCKEY_F            : Result := 'PTCKEY_F';
+    PTCKEY_G            : Result := 'PTCKEY_G';
+    PTCKEY_H            : Result := 'PTCKEY_H';
+    PTCKEY_I            : Result := 'PTCKEY_I';
+    PTCKEY_J            : Result := 'PTCKEY_J';
+    PTCKEY_K            : Result := 'PTCKEY_K';
+    PTCKEY_L            : Result := 'PTCKEY_L';
+    PTCKEY_M            : Result := 'PTCKEY_M';
+    PTCKEY_N            : Result := 'PTCKEY_N';
+    PTCKEY_O            : Result := 'PTCKEY_O';
+    PTCKEY_P            : Result := 'PTCKEY_P';
+    PTCKEY_Q            : Result := 'PTCKEY_Q';
+    PTCKEY_R            : Result := 'PTCKEY_R';
+    PTCKEY_S            : Result := 'PTCKEY_S';
+    PTCKEY_T            : Result := 'PTCKEY_T';
+    PTCKEY_U            : Result := 'PTCKEY_U';
+    PTCKEY_V            : Result := 'PTCKEY_V';
+    PTCKEY_W            : Result := 'PTCKEY_W';
+    PTCKEY_X            : Result := 'PTCKEY_X';
+    PTCKEY_Y            : Result := 'PTCKEY_Y';
+    PTCKEY_Z            : Result := 'PTCKEY_Z';
+    PTCKEY_OPENBRACKET  : Result := 'PTCKEY_OPENBRACKET';
+    PTCKEY_BACKSLASH    : Result := 'PTCKEY_BACKSLASH';
+    PTCKEY_CLOSEBRACKET : Result := 'PTCKEY_CLOSEBRACKET';
+    PTCKEY_NUMPAD0      : Result := 'PTCKEY_NUMPAD0';
+    PTCKEY_NUMPAD1      : Result := 'PTCKEY_NUMPAD1';
+    PTCKEY_NUMPAD2      : Result := 'PTCKEY_NUMPAD2';
+    PTCKEY_NUMPAD3      : Result := 'PTCKEY_NUMPAD3';
+    PTCKEY_NUMPAD4      : Result := 'PTCKEY_NUMPAD4';
+    PTCKEY_NUMPAD5      : Result := 'PTCKEY_NUMPAD5';
+    PTCKEY_NUMPAD6      : Result := 'PTCKEY_NUMPAD6';
+    PTCKEY_NUMPAD7      : Result := 'PTCKEY_NUMPAD7';
+    PTCKEY_NUMPAD8      : Result := 'PTCKEY_NUMPAD8';
+    PTCKEY_NUMPAD9      : Result := 'PTCKEY_NUMPAD9';
+    PTCKEY_MULTIPLY     : Result := 'PTCKEY_MULTIPLY';
+    PTCKEY_ADD          : Result := 'PTCKEY_ADD';
+    PTCKEY_SEPARATOR    : Result := 'PTCKEY_SEPARATOR';
+    PTCKEY_SUBTRACT     : Result := 'PTCKEY_SUBTRACT';
+    PTCKEY_DECIMAL      : Result := 'PTCKEY_DECIMAL';
+    PTCKEY_DIVIDE       : Result := 'PTCKEY_DIVIDE';
+    PTCKEY_F1           : Result := 'PTCKEY_F1';
+    PTCKEY_F2           : Result := 'PTCKEY_F2';
+    PTCKEY_F3           : Result := 'PTCKEY_F3';
+    PTCKEY_F4           : Result := 'PTCKEY_F4';
+    PTCKEY_F5           : Result := 'PTCKEY_F5';
+    PTCKEY_F6           : Result := 'PTCKEY_F6';
+    PTCKEY_F7           : Result := 'PTCKEY_F7';
+    PTCKEY_F8           : Result := 'PTCKEY_F8';
+    PTCKEY_F9           : Result := 'PTCKEY_F9';
+    PTCKEY_F10          : Result := 'PTCKEY_F10';
+    PTCKEY_F11          : Result := 'PTCKEY_F11';
+    PTCKEY_F12          : Result := 'PTCKEY_F12';
+    PTCKEY_DELETE       : Result := 'PTCKEY_DELETE';
+    PTCKEY_NUMLOCK      : Result := 'PTCKEY_NUMLOCK';
+    PTCKEY_SCROLLLOCK   : Result := 'PTCKEY_SCROLLLOCK';
+    PTCKEY_PRINTSCREEN  : Result := 'PTCKEY_PRINTSCREEN';
+    PTCKEY_INSERT       : Result := 'PTCKEY_INSERT';
+    PTCKEY_HELP         : Result := 'PTCKEY_HELP';
+    PTCKEY_META         : Result := 'PTCKEY_META';
+    PTCKEY_MINUS        : Result := 'PTCKEY_MINUS';
+    PTCKEY_BACKQUOTE    : Result := 'PTCKEY_BACKQUOTE';
+    PTCKEY_QUOTE        : Result := 'PTCKEY_QUOTE';
+    else
+      Result := '';
+  end;
+end;
+
 procedure DumpKey(AKey: IPTCKeyEvent);
+var
+  mk: TPTCModifierKey;
+  first: Boolean;
 begin
-  Writeln('Code=', AKey.Code:3, ', Unicode=$', HexStr(AKey.Unicode, 4),
-    ', Press=', AKey.Press:5, ', Shift=', AKey.Shift:5, ', Alt=', AKey.Alt:5,
-    ', Control=', AKey.Control:5);
+  Write('Code=', AKey.Code:3, ' (', KeyCode2String(AKey.Code):19,
+    '), Unicode=$', HexStr(AKey.Unicode, 4), ', Press=', AKey.Press:5,
+    ', Shift=', AKey.Shift:5, ', Alt=', AKey.Alt:5, ', Control=',
+    AKey.Control:5, ', ModifierKeys=[');
+  first := True;
+  for mk in TPTCModifierKey do
+    if mk in AKey.ModifierKeys then
+    begin
+      if not first then
+        Write(',');
+      first := False;
+      Write(mk);
+    end;
+  Writeln(']');
 end;
 
 var
diff --git a/packages/ptc/fpmake.pp b/packages/ptc/fpmake.pp
index e2ef349ebf..4d603c2599 100644
--- a/packages/ptc/fpmake.pp
+++ b/packages/ptc/fpmake.pp
@@ -57,7 +57,6 @@ begin
 
   T:=P.Targets.AddUnit('p_ddraw.pp', [win32, win64]);
 
-  T:=P.Targets.AddUnit('go32fix.pp',[go32v2]);
   T:=P.Targets.AddUnit('mouse33h.pp',[go32v2]);
   T:=P.Targets.AddUnit('textfx2.pp',[go32v2]);
   T:=P.Targets.AddUnit('cga.pp',[go32v2]);
@@ -186,7 +185,6 @@ begin
       AddInclude('vgaconsoled.inc', [go32v2]);
       AddInclude('vgaconsolei.inc', [go32v2]);
       AddUnit('p_gx',[Wince]);
-      AddUnit('go32fix',[go32v2]);
       AddUnit('mouse33h',[go32v2]);
       AddUnit('textfx2',[go32v2]);
       AddUnit('cga',[go32v2]);
diff --git a/packages/ptc/src/c_api/capi_area.inc b/packages/ptc/src/c_api/capi_area.inc
index 1e746e12c5..b6a360b03b 100644
--- a/packages/ptc/src/c_api/capi_area.inc
+++ b/packages/ptc/src/c_api/capi_area.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_area_create(left, top, right, bottom: Integer): TPTC_AREA;
diff --git a/packages/ptc/src/c_api/capi_aread.inc b/packages/ptc/src/c_api/capi_aread.inc
index be1f490519..8f9f9ffa47 100644
--- a/packages/ptc/src/c_api/capi_aread.inc
+++ b/packages/ptc/src/c_api/capi_aread.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_clear.inc b/packages/ptc/src/c_api/capi_clear.inc
index 2a014eece9..92f7df2800 100644
--- a/packages/ptc/src/c_api/capi_clear.inc
+++ b/packages/ptc/src/c_api/capi_clear.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_clear_create: TPTC_CLEAR;
diff --git a/packages/ptc/src/c_api/capi_cleard.inc b/packages/ptc/src/c_api/capi_cleard.inc
index 3129bddb87..aef7065924 100644
--- a/packages/ptc/src/c_api/capi_cleard.inc
+++ b/packages/ptc/src/c_api/capi_cleard.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_clipper.inc b/packages/ptc/src/c_api/capi_clipper.inc
index 43128960b4..df0dbd7db5 100644
--- a/packages/ptc/src/c_api/capi_clipper.inc
+++ b/packages/ptc/src/c_api/capi_clipper.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 procedure ptc_clipper_clip(area, clip, clipped: TPTC_AREA);
diff --git a/packages/ptc/src/c_api/capi_clipperd.inc b/packages/ptc/src/c_api/capi_clipperd.inc
index 045a25dbc4..f0b6923777 100644
--- a/packages/ptc/src/c_api/capi_clipperd.inc
+++ b/packages/ptc/src/c_api/capi_clipperd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { clip a single area against clip area }
diff --git a/packages/ptc/src/c_api/capi_color.inc b/packages/ptc/src/c_api/capi_color.inc
index 50a15ee4ce..24e81bea29 100644
--- a/packages/ptc/src/c_api/capi_color.inc
+++ b/packages/ptc/src/c_api/capi_color.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_color_create: TPTC_COLOR;
diff --git a/packages/ptc/src/c_api/capi_colord.inc b/packages/ptc/src/c_api/capi_colord.inc
index 7de056d34e..de02b4c169 100644
--- a/packages/ptc/src/c_api/capi_colord.inc
+++ b/packages/ptc/src/c_api/capi_colord.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_console.inc b/packages/ptc/src/c_api/capi_console.inc
index f8a4a17cd6..2ff4fecafb 100644
--- a/packages/ptc/src/c_api/capi_console.inc
+++ b/packages/ptc/src/c_api/capi_console.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_console_create: TPTC_CONSOLE;
diff --git a/packages/ptc/src/c_api/capi_consoled.inc b/packages/ptc/src/c_api/capi_consoled.inc
index fd5a3a054f..b0ca0ed745 100644
--- a/packages/ptc/src/c_api/capi_consoled.inc
+++ b/packages/ptc/src/c_api/capi_consoled.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_copy.inc b/packages/ptc/src/c_api/capi_copy.inc
index 5fa83332a7..1b8bc52db1 100644
--- a/packages/ptc/src/c_api/capi_copy.inc
+++ b/packages/ptc/src/c_api/capi_copy.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_copy_create: TPTC_COPY;
diff --git a/packages/ptc/src/c_api/capi_copyd.inc b/packages/ptc/src/c_api/capi_copyd.inc
index 2ea395f073..de5ce5021b 100644
--- a/packages/ptc/src/c_api/capi_copyd.inc
+++ b/packages/ptc/src/c_api/capi_copyd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_error.inc b/packages/ptc/src/c_api/capi_error.inc
index c94fb78d2d..f154a64bc2 100644
--- a/packages/ptc/src/c_api/capi_error.inc
+++ b/packages/ptc/src/c_api/capi_error.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_error_create(message: string): TPTC_ERROR;
diff --git a/packages/ptc/src/c_api/capi_errord.inc b/packages/ptc/src/c_api/capi_errord.inc
index fab8f5fec2..60264943ca 100644
--- a/packages/ptc/src/c_api/capi_errord.inc
+++ b/packages/ptc/src/c_api/capi_errord.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/c_api/capi_except.inc b/packages/ptc/src/c_api/capi_except.inc
index e41bdbccba..47566e8e8c 100644
--- a/packages/ptc/src/c_api/capi_except.inc
+++ b/packages/ptc/src/c_api/capi_except.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 var
diff --git a/packages/ptc/src/c_api/capi_exceptd.inc b/packages/ptc/src/c_api/capi_exceptd.inc
index 0a2037d729..fc600caf1f 100644
--- a/packages/ptc/src/c_api/capi_exceptd.inc
+++ b/packages/ptc/src/c_api/capi_exceptd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 procedure ptc_exception_handler(handler: TPTC_ERROR_HANDLER);
diff --git a/packages/ptc/src/c_api/capi_format.inc b/packages/ptc/src/c_api/capi_format.inc
index 75d4a07b2a..6829a40c8e 100644
--- a/packages/ptc/src/c_api/capi_format.inc
+++ b/packages/ptc/src/c_api/capi_format.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_format_create: TPTC_FORMAT;
diff --git a/packages/ptc/src/c_api/capi_formatd.inc b/packages/ptc/src/c_api/capi_formatd.inc
index 43e6ed583f..7892b73917 100644
--- a/packages/ptc/src/c_api/capi_formatd.inc
+++ b/packages/ptc/src/c_api/capi_formatd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_index.inc b/packages/ptc/src/c_api/capi_index.inc
index 5338108fed..6874ffe7e4 100644
--- a/packages/ptc/src/c_api/capi_index.inc
+++ b/packages/ptc/src/c_api/capi_index.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/c_api/capi_key.inc b/packages/ptc/src/c_api/capi_key.inc
index dab07b495f..5da56e28b4 100644
--- a/packages/ptc/src/c_api/capi_key.inc
+++ b/packages/ptc/src/c_api/capi_key.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_key_create(code: Integer; alt, shift, control: Boolean): TPTC_KEY;
diff --git a/packages/ptc/src/c_api/capi_keyd.inc b/packages/ptc/src/c_api/capi_keyd.inc
index c7bad73d33..f53119ae5e 100644
--- a/packages/ptc/src/c_api/capi_keyd.inc
+++ b/packages/ptc/src/c_api/capi_keyd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_mode.inc b/packages/ptc/src/c_api/capi_mode.inc
index b2e3d61a2b..b8130a0bb6 100644
--- a/packages/ptc/src/c_api/capi_mode.inc
+++ b/packages/ptc/src/c_api/capi_mode.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_mode_create(width, height: Integer; format: TPTC_FORMAT): TPTC_MODE;
diff --git a/packages/ptc/src/c_api/capi_moded.inc b/packages/ptc/src/c_api/capi_moded.inc
index 16340a9145..93ec6c2bbb 100644
--- a/packages/ptc/src/c_api/capi_moded.inc
+++ b/packages/ptc/src/c_api/capi_moded.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_palette.inc b/packages/ptc/src/c_api/capi_palette.inc
index f3a6a45d65..a8f7d16379 100644
--- a/packages/ptc/src/c_api/capi_palette.inc
+++ b/packages/ptc/src/c_api/capi_palette.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_palette_create: TPTC_PALETTE;
diff --git a/packages/ptc/src/c_api/capi_paletted.inc b/packages/ptc/src/c_api/capi_paletted.inc
index b2d8ceaf1b..56b24aff0d 100644
--- a/packages/ptc/src/c_api/capi_paletted.inc
+++ b/packages/ptc/src/c_api/capi_paletted.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_surface.inc b/packages/ptc/src/c_api/capi_surface.inc
index eb61e6de78..b229e1b0c5 100644
--- a/packages/ptc/src/c_api/capi_surface.inc
+++ b/packages/ptc/src/c_api/capi_surface.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_surface_create(width, height: Integer; format: TPTC_FORMAT): TPTC_SURFACE;
diff --git a/packages/ptc/src/c_api/capi_surfaced.inc b/packages/ptc/src/c_api/capi_surfaced.inc
index 8f5fb398d1..92d6705b67 100644
--- a/packages/ptc/src/c_api/capi_surfaced.inc
+++ b/packages/ptc/src/c_api/capi_surfaced.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/c_api/capi_timer.inc b/packages/ptc/src/c_api/capi_timer.inc
index d4af8fa621..d4ec62b896 100644
--- a/packages/ptc/src/c_api/capi_timer.inc
+++ b/packages/ptc/src/c_api/capi_timer.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function ptc_timer_create: TPTC_TIMER;
diff --git a/packages/ptc/src/c_api/capi_timerd.inc b/packages/ptc/src/c_api/capi_timerd.inc
index 8b17beb7c5..0f0d34e249 100644
--- a/packages/ptc/src/c_api/capi_timerd.inc
+++ b/packages/ptc/src/c_api/capi_timerd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { setup }
diff --git a/packages/ptc/src/cocoa/cocoaconsoled.inc b/packages/ptc/src/cocoa/cocoaconsoled.inc
index 65a492d137..5b0cc16de8 100644
--- a/packages/ptc/src/cocoa/cocoaconsoled.inc
+++ b/packages/ptc/src/cocoa/cocoaconsoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/cocoa/cocoaconsolei.inc b/packages/ptc/src/cocoa/cocoaconsolei.inc
index 0ff2347d79..40ee0b9294 100644
--- a/packages/ptc/src/cocoa/cocoaconsolei.inc
+++ b/packages/ptc/src/cocoa/cocoaconsolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 threadvar
diff --git a/packages/ptc/src/core/aread.inc b/packages/ptc/src/core/aread.inc
index ea2f55569b..290282ab12 100644
--- a/packages/ptc/src/core/aread.inc
+++ b/packages/ptc/src/core/aread.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/areai.inc b/packages/ptc/src/core/areai.inc
index c94eba26a7..397ce99f39 100644
--- a/packages/ptc/src/core/areai.inc
+++ b/packages/ptc/src/core/areai.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/baseconsoled.inc b/packages/ptc/src/core/baseconsoled.inc
index 9a9133a0ac..b4785650b6 100644
--- a/packages/ptc/src/core/baseconsoled.inc
+++ b/packages/ptc/src/core/baseconsoled.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -70,6 +70,9 @@ type
     function GetKeyReleaseEnabled: Boolean;
     property KeyReleaseEnabled: Boolean read GetKeyReleaseEnabled write SetKeyReleaseEnabled;
 
+    { mouse handling }
+    function MoveMouseTo(X, Y: Integer): Boolean;
+
     property Pages: Integer read GetPages;
     property Name: string read GetName;
     property Title: string read GetTitle;
diff --git a/packages/ptc/src/core/baseconsolei.inc b/packages/ptc/src/core/baseconsolei.inc
index b970186e50..e41eaf745d 100644
--- a/packages/ptc/src/core/baseconsolei.inc
+++ b/packages/ptc/src/core/baseconsolei.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2016, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -117,6 +117,9 @@ type
     procedure ReadKey;
     property KeyReleaseEnabled: Boolean read GetKeyReleaseEnabled write SetKeyReleaseEnabled;
 
+    { mouse handling }
+    function MoveMouseTo(X, Y: Integer): Boolean; virtual;
+
     property Pages: Integer read GetPages;
     property Name: string read GetName;
     property Title: string read GetTitle;
@@ -212,6 +215,12 @@ begin
   Result := FReleaseEnabled;
 end;
 
+{ must be overriden in consoles, that support moving the mouse cursor }
+function TPTCBaseConsole.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  Result := False;
+end;
+
 function TPTCOpenGLLessConsole.GetOpenGL_Enabled: Boolean;
 begin
   Result := False;
diff --git a/packages/ptc/src/core/basesurfaced.inc b/packages/ptc/src/core/basesurfaced.inc
index 0e26ce0ac2..56711cf9ff 100644
--- a/packages/ptc/src/core/basesurfaced.inc
+++ b/packages/ptc/src/core/basesurfaced.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/basesurfacei.inc b/packages/ptc/src/core/basesurfacei.inc
index 11d7a83ba0..30b16138f9 100644
--- a/packages/ptc/src/core/basesurfacei.inc
+++ b/packages/ptc/src/core/basesurfacei.inc
@@ -27,5 +27,5 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
diff --git a/packages/ptc/src/core/cleard.inc b/packages/ptc/src/core/cleard.inc
index 069276f2e0..47b3b6f5b1 100644
--- a/packages/ptc/src/core/cleard.inc
+++ b/packages/ptc/src/core/cleard.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/cleari.inc b/packages/ptc/src/core/cleari.inc
index 3b0cebf4f0..e00f6245d0 100644
--- a/packages/ptc/src/core/cleari.inc
+++ b/packages/ptc/src/core/cleari.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TPTCClear.Create;
diff --git a/packages/ptc/src/core/clipperd.inc b/packages/ptc/src/core/clipperd.inc
index 588e53d90a..2afb601004 100644
--- a/packages/ptc/src/core/clipperd.inc
+++ b/packages/ptc/src/core/clipperd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/clipperi.inc b/packages/ptc/src/core/clipperi.inc
index 50ca03c918..7bdf28d50d 100644
--- a/packages/ptc/src/core/clipperi.inc
+++ b/packages/ptc/src/core/clipperi.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$INLINE ON}
diff --git a/packages/ptc/src/core/closeeventd.inc b/packages/ptc/src/core/closeeventd.inc
index a38e2b1f55..74d5c425b0 100644
--- a/packages/ptc/src/core/closeeventd.inc
+++ b/packages/ptc/src/core/closeeventd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/closeeventi.inc b/packages/ptc/src/core/closeeventi.inc
index e1b2fbee2d..5b42043634 100644
--- a/packages/ptc/src/core/closeeventi.inc
+++ b/packages/ptc/src/core/closeeventi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/colord.inc b/packages/ptc/src/core/colord.inc
index 6894197fe6..31891418d9 100644
--- a/packages/ptc/src/core/colord.inc
+++ b/packages/ptc/src/core/colord.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/colori.inc b/packages/ptc/src/core/colori.inc
index 982aa392f1..9b991c5df7 100644
--- a/packages/ptc/src/core/colori.inc
+++ b/packages/ptc/src/core/colori.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/consoled.inc b/packages/ptc/src/core/consoled.inc
index b742a6b6d3..068bbb8d7d 100644
--- a/packages/ptc/src/core/consoled.inc
+++ b/packages/ptc/src/core/consoled.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/consolei.inc b/packages/ptc/src/core/consolei.inc
index c0aac1a5de..3188b7f473 100644
--- a/packages/ptc/src/core/consolei.inc
+++ b/packages/ptc/src/core/consolei.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2015  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2015, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -114,6 +114,7 @@ type
     function GetInformation: string; override;
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
+    function MoveMouseTo(X, Y: Integer): Boolean; override;
     procedure OpenGL_SwapBuffers; override;
     procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
     function OpenGL_GetSwapInterval: Integer; override;
@@ -839,6 +840,12 @@ begin
     raise TPTCError.Create('console is not open (core)');
 end;
 
+function TPTCConsole.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  Check;
+  Result := FConsole.MoveMouseTo(X, Y);
+end;
+
 procedure TPTCConsole.PassOpenGLOptionsToInnerConsole;
 begin
   FConsole.OpenGL_Enabled := FUseOpenGL;
diff --git a/packages/ptc/src/core/copyd.inc b/packages/ptc/src/core/copyd.inc
index bc6c22737b..2332a10a7a 100644
--- a/packages/ptc/src/core/copyd.inc
+++ b/packages/ptc/src/core/copyd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/copyi.inc b/packages/ptc/src/core/copyi.inc
index 6b6924e4d8..c289226c14 100644
--- a/packages/ptc/src/core/copyi.inc
+++ b/packages/ptc/src/core/copyi.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TPTCCopy.Create;
diff --git a/packages/ptc/src/core/errord.inc b/packages/ptc/src/core/errord.inc
index 3db1d3e78d..0610096677 100644
--- a/packages/ptc/src/core/errord.inc
+++ b/packages/ptc/src/core/errord.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/errori.inc b/packages/ptc/src/core/errori.inc
index 0d01bf5311..bad8422de0 100644
--- a/packages/ptc/src/core/errori.inc
+++ b/packages/ptc/src/core/errori.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2007, 2009, 2010, 2012  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2007, 2009, 2010, 2012, 2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TPTCError.Create;
diff --git a/packages/ptc/src/core/eventd.inc b/packages/ptc/src/core/eventd.inc
index 5aa70b1363..dc5354e2b5 100644
--- a/packages/ptc/src/core/eventd.inc
+++ b/packages/ptc/src/core/eventd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/eventi.inc b/packages/ptc/src/core/eventi.inc
index aa325b854b..7816a2baa0 100644
--- a/packages/ptc/src/core/eventi.inc
+++ b/packages/ptc/src/core/eventi.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {function TPTCExposeEvent.GetType: TPTCEventType;
diff --git a/packages/ptc/src/core/formatd.inc b/packages/ptc/src/core/formatd.inc
index 5db2569262..99e0f92415 100644
--- a/packages/ptc/src/core/formatd.inc
+++ b/packages/ptc/src/core/formatd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/formati.inc b/packages/ptc/src/core/formati.inc
index 76c621a183..fac28fefb9 100644
--- a/packages/ptc/src/core/formati.inc
+++ b/packages/ptc/src/core/formati.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/keyeventd.inc b/packages/ptc/src/core/keyeventd.inc
index f700a992d9..add306b39f 100644
--- a/packages/ptc/src/core/keyeventd.inc
+++ b/packages/ptc/src/core/keyeventd.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2011, 2015  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2011, 2015, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,11 +27,16 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
-  TPTCModifierKey = (pmkAlt, pmkShift, pmkControl);
+  TPTCModifierKey = (pmkAlt, pmkShift, pmkControl, pmkLeftAlt, pmkRightAlt,
+    pmkLeftShift, pmkRightShift, pmkLeftControl, pmkRightControl,
+    pmkNumLockActive, pmkNumLockPressed,
+    pmkCapsLockActive, pmkCapsLockPressed,
+    pmkScrollLockActive, pmkScrollLockPressed,
+    pmkRightKey, pmkNumPadKey, pmkDeadKey);
   TPTCModifierKeys = set of TPTCModifierKey;
   IPTCKeyEvent = interface(IPTCEvent)
     ['{9BD1CD41-1DF6-4392-99DC-885EADB6D85A}']
diff --git a/packages/ptc/src/core/keyeventi.inc b/packages/ptc/src/core/keyeventi.inc
index ab9629c133..4fe9c4c61e 100644
--- a/packages/ptc/src/core/keyeventi.inc
+++ b/packages/ptc/src/core/keyeventi.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 type
   TPTCKeyEvent = class(TPTCEvent, IPTCKeyEvent)
diff --git a/packages/ptc/src/core/log.inc b/packages/ptc/src/core/log.inc
index 0641069b9b..7c8a93096d 100644
--- a/packages/ptc/src/core/log.inc
+++ b/packages/ptc/src/core/log.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFNDEF WinCE}
diff --git a/packages/ptc/src/core/moded.inc b/packages/ptc/src/core/moded.inc
index df2ad4b876..039e7528c4 100644
--- a/packages/ptc/src/core/moded.inc
+++ b/packages/ptc/src/core/moded.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/modei.inc b/packages/ptc/src/core/modei.inc
index c927b370d2..f15dbd719c 100644
--- a/packages/ptc/src/core/modei.inc
+++ b/packages/ptc/src/core/modei.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/mouseeventd.inc b/packages/ptc/src/core/mouseeventd.inc
index 8ab5913fce..b84b4964a1 100644
--- a/packages/ptc/src/core/mouseeventd.inc
+++ b/packages/ptc/src/core/mouseeventd.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2007, 2009-2011  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2007, 2009-2011, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,18 +27,44 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
 {todo  TPTCMouseCursor = (PTCMouseCursorDefault,
                      PTCMouseCursorAlwaysVisible,
                      PTCMouseCursorAlwaysInvisible);}
-  TPTCMouseButton = (PTCMouseButton1, { left mouse button }
-                     PTCMouseButton2, { right mouse button }
-                     PTCMouseButton3, { middle mouse button }
-                     PTCMouseButton4,
-                     PTCMouseButton5);
+  TPTCMouseButton = (PTCMouseButton1,  { left mouse button }
+                     PTCMouseButton2,  { right mouse button }
+                     PTCMouseButton3,  { middle mouse button }
+                     PTCMouseButton4,  { mouse wheel rotated forward (scroll up) }
+                     PTCMouseButton5,  { mouse wheel rotated backward (scroll down) }
+                     PTCMouseButton6,  { mouse horizontal scroll wheel rotated left }
+                     PTCMouseButton7,  { mouse horizontal scroll wheel rotated right }
+                     PTCMouseButton8,  { "back" button ("X button 1") }
+                     PTCMouseButton9,  { "forward" button ("X button 2") }
+                     PTCMouseButton10,
+                     PTCMouseButton11,
+                     PTCMouseButton12,
+                     PTCMouseButton13,
+                     PTCMouseButton14,
+                     PTCMouseButton15,
+                     PTCMouseButton16,
+                     PTCMouseButton17,
+                     PTCMouseButton18,
+                     PTCMouseButton19,
+                     PTCMouseButton20,
+                     PTCMouseButton21,
+                     PTCMouseButton22,
+                     PTCMouseButton23,
+                     PTCMouseButton24,
+                     PTCMouseButton25,
+                     PTCMouseButton26,
+                     PTCMouseButton27,
+                     PTCMouseButton28,
+                     PTCMouseButton29,
+                     PTCMouseButton30,
+                     PTCMouseButton31);
   TPTCMouseButtonState = set of TPTCMouseButton;
   IPTCMouseEvent = interface(IPTCEvent)
     ['{4D093608-6F27-4578-B41E-3492A4C7FEED}']
diff --git a/packages/ptc/src/core/mouseeventi.inc b/packages/ptc/src/core/mouseeventi.inc
index aff688ff72..507b77193d 100644
--- a/packages/ptc/src/core/mouseeventi.inc
+++ b/packages/ptc/src/core/mouseeventi.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/openglattributesd.inc b/packages/ptc/src/core/openglattributesd.inc
index d47f83f4bb..8257b7ff99 100644
--- a/packages/ptc/src/core/openglattributesd.inc
+++ b/packages/ptc/src/core/openglattributesd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/openglattributesi.inc b/packages/ptc/src/core/openglattributesi.inc
index eaf0a4e21b..ad341fc7a1 100644
--- a/packages/ptc/src/core/openglattributesi.inc
+++ b/packages/ptc/src/core/openglattributesi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/paletted.inc b/packages/ptc/src/core/paletted.inc
index 479292033f..7e025791a2 100644
--- a/packages/ptc/src/core/paletted.inc
+++ b/packages/ptc/src/core/paletted.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/palettei.inc b/packages/ptc/src/core/palettei.inc
index 322da209bd..510f15b4a9 100644
--- a/packages/ptc/src/core/palettei.inc
+++ b/packages/ptc/src/core/palettei.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/resizeeventd.inc b/packages/ptc/src/core/resizeeventd.inc
index 66a6edb706..053ac8b349 100644
--- a/packages/ptc/src/core/resizeeventd.inc
+++ b/packages/ptc/src/core/resizeeventd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/resizeeventi.inc b/packages/ptc/src/core/resizeeventi.inc
index 7c8cc6ded9..6b581bdd25 100644
--- a/packages/ptc/src/core/resizeeventi.inc
+++ b/packages/ptc/src/core/resizeeventi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/surfaced.inc b/packages/ptc/src/core/surfaced.inc
index b22e1512af..fd39a155c9 100644
--- a/packages/ptc/src/core/surfaced.inc
+++ b/packages/ptc/src/core/surfaced.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/surfacei.inc b/packages/ptc/src/core/surfacei.inc
index b51f7e7beb..73b590e21e 100644
--- a/packages/ptc/src/core/surfacei.inc
+++ b/packages/ptc/src/core/surfacei.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/timerd.inc b/packages/ptc/src/core/timerd.inc
index 9de79eb7a0..210652ae3b 100644
--- a/packages/ptc/src/core/timerd.inc
+++ b/packages/ptc/src/core/timerd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/core/timeri.inc b/packages/ptc/src/core/timeri.inc
index e63d91e996..ef48bbebd2 100644
--- a/packages/ptc/src/core/timeri.inc
+++ b/packages/ptc/src/core/timeri.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/base/go32fix.pp b/packages/ptc/src/dos/base/go32fix.pp
deleted file mode 100644
index c725168eaf..0000000000
--- a/packages/ptc/src/dos/base/go32fix.pp
+++ /dev/null
@@ -1,1299 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    and implements some stuff for protected mode programming
-    Copyright (c) 1999-2000 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-unit go32fix;
-
-{$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! }
-
-interface
-
-    const
-    { contants for the run modes returned by get_run_mode }
-       rm_unknown = 0;
-       rm_raw     = 1;     { raw (without HIMEM) }
-       rm_xms     = 2;     { XMS (for example with HIMEM, without EMM386) }
-       rm_vcpi    = 3;     { VCPI (for example HIMEM and EMM386) }
-       rm_dpmi    = 4;     { DPMI (for example DOS box or 386Max) }
-
-    { flags }
-       carryflag     = $001;
-       parityflag    = $004;
-       auxcarryflag  = $010;
-       zeroflag      = $040;
-       signflag      = $080;
-       trapflag      = $100;
-       interruptflag = $200;
-       directionflag = $400;
-       overflowflag  = $800;
-
-    type
-       tmeminfo = record
-          available_memory,
-          available_pages,
-          available_lockable_pages,
-          linear_space,
-          unlocked_pages,
-          available_physical_pages,
-          total_physical_pages,
-          free_linear_space,
-          max_pages_in_paging_file,
-          reserved0,
-          reserved1,
-          reserved2: longint;
-       end;
-
-       tseginfo = record
-          offset: pointer;
-          segment: word;
-       end;
-
-       trealregs = record
-         case integer of
-          1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint;
-                         Flags, ES, DS, FS, GS, IP, CS, SP, SS: word);
-          2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word;
-                         BX, BX2, DX, DX2, CX, CX2, AX, AX2: word);
-          3: { 8-bit }  (stuff: array[1..4] of longint;
-                         BL, BH, BL2, BH2, DL, DH, DL2, DH2,
-                         CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte);
-          4: { Compat } (RealEDI, RealESI, RealEBP, RealRES,
-                         RealEBX, RealEDX, RealECX, RealEAX: longint;
-                         RealFlags,
-                         RealES, RealDS, RealFS, RealGS,
-                         RealIP, RealCS, RealSP, RealSS: word);
-       end;
-
-      registers = trealregs;
-
-      tdpmiversioninfo = record
-        major, minor: byte;
-	flags: word;
-	cpu: byte;
-	master_pic, slave_pic: byte;
-      end;
-
-    { this works only with real DPMI }
-    function allocate_ldt_descriptors(count: word): word;
-    function free_ldt_descriptor(d: word): boolean;
-    function segment_to_descriptor(seg: word): word;
-    function get_next_selector_increment_value: word;
-    function get_segment_base_address(d: word): longint;
-    function set_segment_base_address(d: word;s: dword): boolean;
-    function set_segment_limit(d: word;s: dword): boolean;
-    function set_descriptor_access_right(d: word;w: word): boolean;
-    function create_code_segment_alias_descriptor(seg: word): word;
-    function get_linear_addr(phys_addr: dword;size: longint): dword;
-    function free_linear_addr_mapping(linear_addr: dword): boolean;
-    function get_segment_limit(d: word): dword;
-    function get_descriptor_access_right(d: word): longint;
-    function get_page_size:longint;
-    function map_device_in_memory_block(handle,offset,pagecount,device:dword):boolean;
-    function get_page_attributes(handle, offset, pagecount: dword; buf: pointer): boolean;
-    function set_page_attributes(handle, offset, pagecount: dword; buf: pointer): boolean;
-    function realintr(intnr: word;var regs: trealregs): boolean;
-    function get_dpmi_version(var version: tdpmiversioninfo): boolean;
-
-    { is needed for functions which need a real mode buffer }
-    function global_dos_alloc(bytes: longint): longint;
-    function global_dos_free(selector: word): boolean;
-
-    var
-       { selector for the DOS memory (only usable if in DPMI mode) }
-       dosmemselector: word;
-       { result of dpmi call }
-       int31error: word;
-
-    { this procedure copies data where the source and destination }
-    { are specified by 48 bit pointers                            }
-    { Note: the procedure checks only for overlapping if          }
-    { source selector=destination selector                        }
-    procedure seg_move(sseg: word;source: longint;dseg: word;dest: longint;count: longint);
-
-    { fills a memory area specified by a 48 bit pointer with c }
-    procedure seg_fillchar(seg: word;ofs: longint;count: longint;c: char);
-    procedure seg_fillword(seg: word;ofs: longint;count: longint;w: word);
-
-    {************************************}
-    { this works with all PM interfaces: }
-    {************************************}
-
-    function get_meminfo(var meminfo: tmeminfo): boolean;
-    function get_pm_interrupt(vector: byte;var intaddr: tseginfo): boolean;
-    function set_pm_interrupt(vector: byte;const intaddr: tseginfo): boolean;
-    function get_rm_interrupt(vector: byte;var intaddr: tseginfo): boolean;
-    function set_rm_interrupt(vector: byte;const intaddr: tseginfo): boolean;
-    function get_exception_handler(e: byte;var intaddr: tseginfo): boolean;
-    function set_exception_handler(e: byte;const intaddr: tseginfo): boolean;
-    function get_pm_exception_handler(e: byte;var intaddr: tseginfo): boolean;
-    function set_pm_exception_handler(e: byte;const intaddr: tseginfo): boolean;
-    function free_rm_callback(var intaddr: tseginfo): boolean;
-    function get_rm_callback(pm_func: pointer;const reg: trealregs;var rmcb: tseginfo): boolean;
-    function get_cs: word;
-    function get_ds: word;
-    function get_ss: word;
-
-    { locking functions }
-    function allocate_memory_block(size:longint):longint;
-    function free_memory_block(blockhandle: longint): boolean;
-    function request_linear_region(linearaddr, size: longint;
-                                   var blockhandle: longint): boolean;
-    function lock_linear_region(linearaddr, size: longint): boolean;
-    function lock_data(var data;size: longint): boolean;
-    function lock_code(functionaddr: pointer;size: longint): boolean;
-    function unlock_linear_region(linearaddr, size: longint): boolean;
-    function unlock_data(var data;size: longint): boolean;
-    function unlock_code(functionaddr: pointer;size: longint): boolean;
-
-    { disables and enables interrupts }
-    procedure disable;
-    procedure enable;
-
-    function inportb(port: word): byte;
-    function inportw(port: word): word;
-    function inportl(port: word): longint;
-
-    procedure outportb(port: word;data: byte);
-    procedure outportw(port: word;data: word);
-    procedure outportl(port: word;data: longint);
-    function get_run_mode: word;
-
-    function transfer_buffer: longint;
-    function tb_segment: longint;
-    function tb_offset: longint;
-    function tb_size: longint;
-    procedure copytodos(var addr; len: longint);
-    procedure copyfromdos(var addr; len: longint);
-
-    procedure dpmi_dosmemput(seg: word;ofs: word;var data;count: longint);
-    procedure dpmi_dosmemget(seg: word;ofs: word;var data;count: longint);
-    procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs: word;count: longint);
-    procedure dpmi_dosmemfillchar(seg,ofs: word;count: longint;c: char);
-    procedure dpmi_dosmemfillword(seg,ofs: word;count: longint;w: word);
-
-
-
-    const
-       { this procedures are assigned to the procedure which are needed }
-       { for the current mode to access DOS memory                      }
-       { It's strongly recommended to use this procedures!              }
-       dosmemput: procedure(seg: word;ofs: word;var data;count: longint)=@dpmi_dosmemput;
-       dosmemget: procedure(seg: word;ofs: word;var data;count: longint)=@dpmi_dosmemget;
-       dosmemmove: procedure(sseg,sofs,dseg,dofs: word;count: longint)=@dpmi_dosmemmove;
-       dosmemfillchar: procedure(seg,ofs: word;count: longint;c: char)=@dpmi_dosmemfillchar;
-       dosmemfillword: procedure(seg,ofs: word;count: longint;w: word)=@dpmi_dosmemfillword;
-
-  implementation
-
-{$asmmode ATT}
-
-
-    { the following procedures copy from and to DOS memory using DPMI }
-    procedure dpmi_dosmemput(seg: word;ofs: word;var data;count: longint);
-
-      begin
-         seg_move(get_ds,longint(@data),dosmemselector,seg*16+ofs,count);
-      end;
-
-    procedure dpmi_dosmemget(seg: word;ofs: word;var data;count: longint);
-
-      begin
-         seg_move(dosmemselector,seg*16+ofs,get_ds,longint(@data),count);
-      end;
-
-    procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs: word;count: longint);
-
-      begin
-         seg_move(dosmemselector,sseg*16+sofs,dosmemselector,dseg*16+dofs,count);
-      end;
-
-    procedure dpmi_dosmemfillchar(seg,ofs: word;count: longint;c: char);
-
-      begin
-         seg_fillchar(dosmemselector,seg*16+ofs,count,c);
-      end;
-
-    procedure dpmi_dosmemfillword(seg,ofs: word;count: longint;w: word);
-
-      begin
-         seg_fillword(dosmemselector,seg*16+ofs,count,w);
-      end;
-
-
-    procedure test_int31(flag: longint); stdcall; { stack-args! }
-      begin
-         asm
-            pushl %ebx
-            movw  $0,INT31ERROR
-            movl  flag,%ebx
-            testb $1,%bl
-            jz    .Lti31_1
-            movw  %ax,INT31ERROR
-            xorl  %eax,%eax
-            jmp   .Lti31_2
-            .Lti31_1:
-            movl  $1,%eax
-            .Lti31_2:
-            popl  %ebx
-         end;
-      end;
-
-    function global_dos_alloc(bytes: longint): longint;
-
-      begin
-         asm
-            pushl %ebx
-            movl bytes,%ebx
-            addl $0xf,%ebx              // round up
-            shrl $0x4,%ebx              // convert to Paragraphs
-            movl $0x100,%eax            // function 0x100
-            int  $0x31
-            jnc  .LDos_OK
-            movw %ax,INT31ERROR
-            xorl %eax,%eax
-            jmp  .LDos_end
-          .LDos_OK:
-            shll $0x10,%eax             // return Segment in hi(Result)
-            movw %dx,%ax                // return Selector in lo(Result)
-          .LDos_end:
-            movl %eax,__result
-            popl %ebx
-         end;
-      end;
-
-    function  global_dos_free(selector: word): boolean;
-
-      begin
-         asm
-            movw Selector,%dx
-            movl $0x101,%eax
-            int  $0x31
-            setnc %al
-            movb %al,__RESULT
-         end;
-      end;
-
-    function realintr(intnr: word;var regs: trealregs): boolean;
-
-      begin
-         regs.realsp:=0;
-         regs.realss:=0;
-         regs.realres:=0; { play it safe }
-         asm
-            { save all used registers to avoid crash under NTVDM }
-            { when spawning a 32-bit DPMI application            }
-            pushl %edi
-            pushl %ebx
-            pushw %fs
-            movw  intnr,%bx
-            xorl  %ecx,%ecx
-            movl  regs,%edi
-            { es is always equal ds }
-            movl  $0x300,%eax
-            int   $0x31
-            popw  %fs
-            setnc %al
-            movb  %al,__RESULT
-            popl  %ebx
-            popl  %edi
-         end;
-      end;
-
-    procedure seg_fillchar(seg: word;ofs: longint;count: longint;c: char);
-
-      begin
-         asm
-            pushl %edi
-            movl ofs,%edi
-            movl count,%ecx
-            movb c,%dl
-            { load es with selector }
-            pushw %es
-            movw seg,%ax
-            movw %ax,%es
-            { fill eax with duplicated c }
-            { so we can use stosl        }
-            movb %dl,%dh
-            movw %dx,%ax
-            shll $16,%eax
-            movw %dx,%ax
-            movl %ecx,%edx
-            shrl $2,%ecx
-            cld
-            rep
-            stosl
-            movl %edx,%ecx
-            andl $3,%ecx
-            rep
-            stosb
-            popw %es
-            popl %edi
-         end;
-      end;
-
-    procedure seg_fillword(seg: word;ofs: longint;count: longint;w: word);
-
-      begin
-         asm
-            pushl %edi
-            movl ofs,%edi
-            movl count,%ecx
-            movw w,%dx
-            { load segment }
-            pushw %es
-            movw seg,%ax
-            movw %ax,%es
-            { fill eax }
-            movw %dx,%ax
-            shll $16,%eax
-            movw %dx,%ax
-            movl %ecx,%edx
-            shrl $1,%ecx
-            cld
-            rep
-            stosl
-            movl %edx,%ecx
-            andl $1,%ecx
-            rep
-            stosw
-            popw %es
-            popl %edi
-         end;
-      end;
-
-    procedure seg_move(sseg: word;source: longint;dseg: word;dest: longint;count: longint);
-
-      begin
-         if count=0 then
-           exit;
-         if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
-           asm
-              pushl %esi
-              pushl %edi
-              pushw %es
-              pushw %ds
-              cld
-              movl count,%ecx
-              movl source,%esi
-              movl dest,%edi
-              movw dseg,%ax
-              movw %ax,%es
-              movw sseg,%ax
-              movw %ax,%ds
-              movl %ecx,%eax
-              shrl $2,%ecx
-              rep
-              movsl
-              movl %eax,%ecx
-              andl $3,%ecx
-              rep
-              movsb
-              popw %ds
-              popw %es
-              popl %edi
-              popl %esi
-           end ['ECX','EAX']
-         else if (source<dest) then
-           { copy backward for overlapping }
-           asm
-              pushl %esi
-              pushl %edi
-              pushw %es
-              pushw %ds
-              std
-              movl count,%ecx
-              movl source,%esi
-              movl dest,%edi
-              movw dseg,%ax
-              movw %ax,%es
-              movw sseg,%ax
-              movw %ax,%ds
-              addl %ecx,%esi
-              addl %ecx,%edi
-              movl %ecx,%eax
-              andl $3,%ecx
-              orl %ecx,%ecx
-              jz .LSEG_MOVE1
-
-              { calculate esi and edi}
-              decl %esi
-              decl %edi
-              rep
-              movsb
-              incl %esi
-              incl %edi
-           .LSEG_MOVE1:
-              subl $4,%esi
-              subl $4,%edi
-              movl %eax,%ecx
-              shrl $2,%ecx
-              rep
-              movsl
-              cld
-              popw %ds
-              popw %es
-              popl %edi
-              popl %esi
-           end ['ECX','EAX'];
-      end;
-
-    procedure outportb(port: word;data: byte);
-
-      begin
-         asm
-            movw port,%dx
-            movb data,%al
-            outb %al,%dx
-         end ['EAX','EDX'];
-      end;
-
-    procedure outportw(port: word;data: word);
-
-      begin
-         asm
-            movw port,%dx
-            movw data,%ax
-            outw %ax,%dx
-         end ['EAX','EDX'];
-      end;
-
-    procedure outportl(port: word;data: longint);
-
-      begin
-         asm
-            movw port,%dx
-            movl data,%eax
-            outl %eax,%dx
-         end ['EAX','EDX'];
-      end;
-
-    function inportb(port: word): byte;
-
-      begin
-         asm
-            movw port,%dx
-            inb %dx,%al
-            movb %al,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-    function inportw(port: word): word;
-
-      begin
-         asm
-            movw port,%dx
-            inw %dx,%ax
-            movw %ax,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-    function inportl(port: word): longint;
-
-      begin
-         asm
-            movw port,%dx
-            inl %dx,%eax
-            movl %eax,__RESULT
-         end ['EAX','EDX'];
-      end;
-
-
-
-    function get_cs: word;assembler;
-      asm
-            movw %cs,%ax
-      end;
-
-
-    function get_ss: word;assembler;
-      asm
-            movw %ss,%ax
-      end;
-
-
-    function get_ds: word;assembler;
-      asm
-            movw %ds,%ax
-      end;
-
-
-    function set_pm_interrupt(vector: byte;const intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movl intaddr,%eax
-            movl (%eax),%edx
-            movw 4(%eax),%cx
-            movl $0x205,%eax
-            movb vector,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function set_rm_interrupt(vector: byte;const intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movl intaddr,%eax
-            movw (%eax),%dx
-            movw 4(%eax),%cx
-            movl $0x201,%eax
-            movb vector,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function set_pm_exception_handler(e: byte;const intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movl intaddr,%eax
-            movl (%eax),%edx
-            movw 4(%eax),%cx
-            movl $0x212,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function set_exception_handler(e: byte;const intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movl intaddr,%eax
-            movl (%eax),%edx
-            movw 4(%eax),%cx
-            movl $0x203,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function get_pm_exception_handler(e: byte;var intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movl $0x210,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-            popl %ebx
-         end;
-      end;
-
-    function get_exception_handler(e: byte;var intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movl $0x202,%eax
-            movb e,%bl
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-            popl %ebx
-         end;
-      end;
-
-    function get_pm_interrupt(vector: byte;var intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movb vector,%bl
-            movl $0x204,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-            popl %ebx
-         end;
-      end;
-
-    function get_rm_interrupt(vector: byte;var intaddr: tseginfo): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movb vector,%bl
-            movl $0x200,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl intaddr,%eax
-            movzwl %dx,%edx
-            movl %edx,(%eax)
-            movw %cx,4(%eax)
-            popl %ebx
-         end;
-      end;
-
-    function free_rm_callback(var intaddr: tseginfo): boolean;
-      begin
-         asm
-            movl intaddr,%eax
-            movw (%eax),%dx
-            movw 4(%eax),%cx
-            movl $0x304,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-         end;
-      end;
-
-    { here we must use ___v2prt0_ds_alias instead of from v2prt0.s
-    because the exception processor sets the ds limit to $fff
-    at hardware exceptions }
-
-    var
-       ___v2prt0_ds_alias: word; external name '___v2prt0_ds_alias';
-
-    function get_rm_callback(pm_func: pointer;const reg: trealregs;var rmcb: tseginfo): boolean;
-      begin
-         asm
-            pushl %esi
-            pushl %edi
-            movl  pm_func,%esi
-            movl  reg,%edi
-            pushw %es
-            movw  ___v2prt0_ds_alias,%ax
-            movw  %ax,%es
-            pushw %ds
-            movw  %cs,%ax
-            movw  %ax,%ds
-            movl  $0x303,%eax
-            int   $0x31
-            popw  %ds
-            popw  %es
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl  rmcb,%eax
-            movzwl %dx,%edx
-            movl  %edx,(%eax)
-            movw  %cx,4(%eax)
-            popl %edi
-            popl %esi
-         end;
-      end;
-
-    function allocate_ldt_descriptors(count: word): word;
-
-      begin
-         asm
-            movw count,%cx
-            xorl %eax,%eax
-            int $0x31
-            movw %ax,__RESULT
-         end;
-      end;
-
-    function free_ldt_descriptor(d: word): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movw d,%bx
-            movl $1,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function segment_to_descriptor(seg: word): word;
-
-      begin
-         asm
-            pushl %ebx
-            movw seg,%bx
-            movl $2,%eax
-            int $0x31
-            movw %ax,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function get_next_selector_increment_value: word;
-
-      begin
-         asm
-            movl $3,%eax
-            int $0x31
-            movw %ax,__RESULT
-         end;
-      end;
-
-    function get_segment_base_address(d: word): longint;
-
-      begin
-         asm
-            pushl %ebx
-            movw d,%bx
-            movl $6,%eax
-            int $0x31
-            xorl %eax,%eax
-            movw %dx,%ax
-            shll $16,%ecx
-            orl %ecx,%eax
-            movl %eax,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function get_page_size:longint;
-      begin
-        asm
-           pushl %ebx
-           movl $0x604,%eax
-           int $0x31
-           shll $16,%ebx
-           movw %cx,%bx
-           movl %ebx,__RESULT
-           popl %ebx
-        end;
-      end;
-
-    function request_linear_region(linearaddr, size: longint;
-                                   var blockhandle: longint): boolean;
-      var
-         pageofs: longint;
-
-      begin
-         pageofs:=linearaddr and $3ff;
-         linearaddr:=linearaddr-pageofs;
-         size:=size+pageofs;
-         asm
-            pushl %ebx
-            pushl %esi
-            movl $0x504,%eax
-            movl linearaddr,%ebx
-            movl size,%ecx
-            movl $1,%edx
-            xorl %esi,%esi
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            movl blockhandle,%eax
-            movl %esi,(%eax)
-            movl %ebx,pageofs
-            popl %esi
-            popl %ebx
-         end;
-         if pageofs<>linearaddr then
-           request_linear_region:=false;
-      end;
-
-    function allocate_memory_block(size:longint):longint;
-      begin
-        asm
-          pushl %ebx
-          pushl %esi
-          movl  $0x501,%eax
-          movl  size,%ecx
-          movl  %ecx,%ebx
-          shrl  $16,%ebx
-          andl  $65535,%ecx
-          int   $0x31
-          jnc   .Lallocate_mem_block_err
-          xorl  %ebx,%ebx
-          xorl  %ecx,%ecx
-       .Lallocate_mem_block_err:
-          shll  $16,%ebx
-          movw  %cx,%bx
-          shll  $16,%esi
-          movw  %di,%si
-          movl  %ebx,__RESULT
-          popl %esi
-          popl %ebx
-        end;
-     end;
-
-    function free_memory_block(blockhandle: longint): boolean;
-      begin
-         asm
-            pushl %edi
-            pushl %esi
-            movl blockhandle,%esi
-            movl %esi,%edi
-            shll $16,%esi
-            movl $0x502,%eax
-            int  $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %esi
-            popl %edi
-         end;
-      end;
-
-    function lock_linear_region(linearaddr, size: longint): boolean;
-
-      begin
-          asm
-            pushl %ebx
-            pushl %edi
-            pushl %esi
-            movl  $0x600,%eax
-            movl  linearaddr,%ecx
-            movl  %ecx,%ebx
-            shrl  $16,%ebx
-            movl  size,%esi
-            movl  %esi,%edi
-            shrl  $16,%esi
-            int   $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %esi
-            popl %edi
-            popl %ebx
-          end;
-      end;
-
-    function lock_data(var data;size: longint): boolean;
-
-      var
-         linearaddr: longint;
-
-      begin
-         if get_run_mode<>rm_dpmi then
-           exit;
-         linearaddr:=longint(@data)+get_segment_base_address(get_ds);
-         lock_data:=lock_linear_region(linearaddr,size);
-      end;
-
-    function lock_code(functionaddr: pointer;size: longint): boolean;
-
-      var
-         linearaddr: longint;
-
-      begin
-         if get_run_mode<>rm_dpmi then
-           exit;
-         linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
-         lock_code:=lock_linear_region(linearaddr,size);
-      end;
-
-    function unlock_linear_region(linearaddr,size: longint): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            pushl %edi
-            pushl %esi
-            movl  $0x601,%eax
-            movl  linearaddr,%ecx
-            movl  %ecx,%ebx
-            shrl  $16,%ebx
-            movl  size,%esi
-            movl  %esi,%edi
-            shrl  $16,%esi
-            int   $0x31
-            pushf
-            call  test_int31
-            movb  %al,__RESULT
-            popl %esi
-            popl %edi
-            popl %ebx
-         end;
-      end;
-
-    function unlock_data(var data;size: longint): boolean;
-
-      var
-         linearaddr: longint;
-      begin
-         if get_run_mode<>rm_dpmi then
-           exit;
-         linearaddr:=longint(@data)+get_segment_base_address(get_ds);
-         unlock_data:=unlock_linear_region(linearaddr,size);
-      end;
-
-    function unlock_code(functionaddr: pointer;size: longint): boolean;
-
-      var
-         linearaddr: longint;
-      begin
-         if get_run_mode<>rm_dpmi then
-           exit;
-         linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
-         unlock_code:=unlock_linear_region(linearaddr,size);
-      end;
-
-    function set_segment_base_address(d: word;s: dword): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movw d,%bx
-            leal s,%eax
-            movw (%eax),%dx
-            movw 2(%eax),%cx
-            movl $7,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function set_descriptor_access_right(d: word;w: word): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movw d,%bx
-            movw w,%cx
-            movl $9,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function set_segment_limit(d: word;s: dword): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            movw d,%bx
-            leal s,%eax
-            movw (%eax),%dx
-            movw 2(%eax),%cx
-            movl $8,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function get_descriptor_access_right(d: word): longint;
-
-      begin
-         asm
-            movzwl d,%eax
-            lar %eax,%eax
-            jz .L_ok
-            xorl %eax,%eax
-         .L_ok:
-            movl %eax,__RESULT
-         end;
-      end;
-    function get_segment_limit(d: word): dword;
-
-      begin
-         asm
-            movzwl d,%eax
-            lsl %eax,%eax
-            jz .L_ok2
-            xorl %eax,%eax
-         .L_ok2:
-            movl %eax,__RESULT
-         end;
-      end;
-
-    function create_code_segment_alias_descriptor(seg: word): word;
-
-      begin
-         asm
-            pushl %ebx
-            movw seg,%bx
-            movl $0xa,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movw %ax,__RESULT
-            popl %ebx
-         end;
-      end;
-
-    function get_meminfo(var meminfo: tmeminfo): boolean;
-
-      begin
-         asm
-            pushl %edi
-            movl meminfo,%edi
-            movl $0x500,%eax
-            int $0x31
-            pushf
-            movb %al,__RESULT
-            call test_int31
-            popl %edi
-         end;
-      end;
-
-    function get_linear_addr(phys_addr: dword;size: longint): dword;
-
-      begin
-         asm
-            pushl %ebx
-            pushl %edi
-            pushl %esi
-            movl phys_addr,%ebx
-            movl %ebx,%ecx
-            shrl $16,%ebx
-            movl size,%esi
-            movl %esi,%edi
-            shrl $16,%esi
-            movl $0x800,%eax
-            int $0x31
-            pushf
-            call test_int31
-            shll $16,%ebx
-            movw %cx,%bx
-            movl %ebx,__RESULT
-            popl %esi
-            popl %edi
-            popl %ebx
-         end;
-      end;
-
-    function free_linear_addr_mapping(linear_addr: dword): boolean;
-
-      begin
-         asm
-            pushl %ebx
-            pushl %ecx
-            movl linear_addr,%ebx
-            movl %ebx,%ecx
-            shrl $16,%ebx
-            movl $0x801,%eax
-            int $0x31
-            pushf
-            call test_int31
-            movb %al,__RESULT
-	    popl %ecx
-            popl %ebx
-         end;
-      end;
-
-    procedure disable;assembler;
-
-      asm
-         cli
-      end;
-
-    procedure enable;assembler;
-
-      asm
-         sti
-      end;
-
-
-    var
-      _run_mode: word;external name '_run_mode';
-
-    function get_run_mode: word;
-
-      begin
-         get_run_mode:=_run_mode;
-      end;
-
-    function map_device_in_memory_block(handle,offset,pagecount,device:dword):boolean;
-      begin
-         asm
-           pushl %ebx
-           pushl %edi
-           pushl %esi
-           movl device,%edx
-           movl handle,%esi
-           movl offset,%ebx
-           movl pagecount,%ecx
-           movl $0x0508,%eax
-           int $0x31
-           pushf
-           call test_int31
-           movb %al,__RESULT
-           popl %esi
-           popl %edi
-           popl %ebx
-         end;
-      end;
-
-    function get_page_attributes(handle, offset, pagecount: dword; buf: pointer): boolean;
-      begin
-         asm
-           pushl %ebx
-           pushl %ecx
-           pushl %edx
-           pushl %esi
-           pushw %es
-	   pushw %ds
-	   popw %es
-           movl buf,%edx
-           movl handle,%esi
-           movl offset,%ebx
-           movl pagecount,%ecx
-           movl $0x0506,%eax
-           int $0x31
-           pushf
-           call test_int31
-           movb %al,__RESULT
-	   popw %es
-           popl %esi
-           popl %edx
-           popl %ecx
-           popl %ebx
-	 end;
-      end;
-
-    function set_page_attributes(handle, offset, pagecount: dword; buf: pointer): boolean;
-      begin
-         asm
-           pushl %ebx
-           pushl %ecx
-           pushl %edx
-           pushl %esi
-           pushw %es
-	   pushw %ds
-	   popw %es
-           movl buf,%edx
-           movl handle,%esi
-           movl offset,%ebx
-           movl pagecount,%ecx
-           movl $0x0507,%eax
-           int $0x31
-           pushf
-           call test_int31
-           movb %al,__RESULT
-	   popw %es
-           popl %esi
-           popl %edx
-           popl %ecx
-           popl %ebx
-	 end;
-      end;
-
-    function get_dpmi_version(var version: tdpmiversioninfo): boolean;
-      var
-        _version, _flags, _cpu, _pic: word;
-      begin
-         asm
-           movl $0x0400,%eax
-           int $0x31
-           pushf
-	   movw %ax,_version
-	   movw %bx,_flags
-	   movw %cx,_cpu
-	   movw %dx,_pic
-           call test_int31
-           movb %al,__RESULT
-	 end ['EAX','EBX','ECX','EDX'];
-
-	 if get_dpmi_version then
-	 begin
-	   FillChar(version, SizeOf(version), 0);
-	   version.major := _version shr 8;
-	   version.minor := _version and $ff;
-	   version.flags := _flags;
-	   version.cpu := _cpu and $ff;
-	   version.master_pic := _pic shr 8;
-	   version.slave_pic := _pic and $ff;
-	 end;
-      end;
-
-{*****************************************************************************
-                              Transfer Buffer
-*****************************************************************************}
-
-    function transfer_buffer: longint;
-      begin
-         transfer_buffer := go32_info_block.linear_address_of_transfer_buffer;
-      end;
-
-
-    function tb_segment: longint;
-      begin
-        tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
-      end;
-
-
-    function tb_offset: longint;
-      begin
-        tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
-      end;
-
-
-    function tb_size: longint;
-      begin
-         tb_size := go32_info_block.size_of_transfer_buffer;
-      end;
-
-
-    procedure copytodos(var addr; len: longint);
-       begin
-          if len>tb_size then
-            runerror(217);
-          seg_move(get_ds,longint(@addr),dosmemselector,transfer_buffer,len);
-       end;
-
-
-    procedure copyfromdos(var addr; len: longint);
-       begin
-          if len>tb_size then
-            runerror(217);
-          seg_move(dosmemselector,transfer_buffer,get_ds,longint(@addr),len);
-       end;
-
-
-    var
-      _core_selector: word;external name '_core_selector';
-
-begin
-   int31error:=0;
-   dosmemselector:=_core_selector;
-end.
diff --git a/packages/ptc/src/dos/base/kbd.inc b/packages/ptc/src/dos/base/kbd.inc
index 0069d51068..e176938488 100644
--- a/packages/ptc/src/dos/base/kbd.inc
+++ b/packages/ptc/src/dos/base/kbd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {Constructor TDosKeyboard.Create;
diff --git a/packages/ptc/src/dos/base/kbdd.inc b/packages/ptc/src/dos/base/kbdd.inc
index daaf6ee8a9..4580353f2a 100644
--- a/packages/ptc/src/dos/base/kbdd.inc
+++ b/packages/ptc/src/dos/base/kbdd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/base/mouse33h.pp b/packages/ptc/src/dos/base/mouse33h.pp
index 91643c649e..6c0d554438 100644
--- a/packages/ptc/src/dos/base/mouse33h.pp
+++ b/packages/ptc/src/dos/base/mouse33h.pp
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 unit mouse33h;
@@ -50,7 +50,7 @@ var
 implementation
 
 uses
-  go32fix;
+  go32;
 
 procedure InitMouse;
 
diff --git a/packages/ptc/src/dos/base/moused.inc b/packages/ptc/src/dos/base/moused.inc
index 2ce6923297..d4201ebaf9 100644
--- a/packages/ptc/src/dos/base/moused.inc
+++ b/packages/ptc/src/dos/base/moused.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/base/mousei.inc b/packages/ptc/src/dos/base/mousei.inc
index 33b4a36185..b30bb22354 100644
--- a/packages/ptc/src/dos/base/mousei.inc
+++ b/packages/ptc/src/dos/base/mousei.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TDosMouse.Create(Width, Height: Integer);
diff --git a/packages/ptc/src/dos/cga/cga.pp b/packages/ptc/src/dos/cga/cga.pp
index b4918e2b1a..9813ea642a 100644
--- a/packages/ptc/src/dos/cga/cga.pp
+++ b/packages/ptc/src/dos/cga/cga.pp
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 unit CGA;
@@ -48,7 +48,7 @@ procedure CGAFree;
 implementation
 
 uses
-  go32fix, crt;
+  go32, crt;
 
 const
   palette: array[0..15, 0..2] of Byte = (
diff --git a/packages/ptc/src/dos/cga/cgaconsoled.inc b/packages/ptc/src/dos/cga/cgaconsoled.inc
index 606e0ca494..b65c859283 100644
--- a/packages/ptc/src/dos/cga/cgaconsoled.inc
+++ b/packages/ptc/src/dos/cga/cgaconsoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/cga/cgaconsolei.inc b/packages/ptc/src/dos/cga/cgaconsolei.inc
index 96d16e46dc..3fd89bfc2f 100644
--- a/packages/ptc/src/dos/cga/cgaconsolei.inc
+++ b/packages/ptc/src/dos/cga/cgaconsolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MACRO ON}
diff --git a/packages/ptc/src/dos/textfx2/textfx2.pp b/packages/ptc/src/dos/textfx2/textfx2.pp
index b4df5d2593..41a8ebeec2 100644
--- a/packages/ptc/src/dos/textfx2/textfx2.pp
+++ b/packages/ptc/src/dos/textfx2/textfx2.pp
@@ -128,7 +128,7 @@ procedure dump_320x(y0, y1: Integer; buffer: PInteger);
 implementation
 
 uses
-  go32fix;
+  go32;
 
 { $define __USE_178NOT176}
  { uncomment to use 75% char instead of 25% char }
diff --git a/packages/ptc/src/dos/textfx2/textfx2consoled.inc b/packages/ptc/src/dos/textfx2/textfx2consoled.inc
index 837ce1b833..7994f69a76 100644
--- a/packages/ptc/src/dos/textfx2/textfx2consoled.inc
+++ b/packages/ptc/src/dos/textfx2/textfx2consoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/textfx2/textfx2consolei.inc b/packages/ptc/src/dos/textfx2/textfx2consolei.inc
index 2eaea2765d..d2da544f63 100644
--- a/packages/ptc/src/dos/textfx2/textfx2consolei.inc
+++ b/packages/ptc/src/dos/textfx2/textfx2consolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MACRO ON}
diff --git a/packages/ptc/src/dos/timeunit/timeunit.pp b/packages/ptc/src/dos/timeunit/timeunit.pp
index b864d0c1df..027146f4d0 100644
--- a/packages/ptc/src/dos/timeunit/timeunit.pp
+++ b/packages/ptc/src/dos/timeunit/timeunit.pp
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2010 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2010, 2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MODE objfpc}
@@ -110,32 +110,32 @@ Label
 
 Asm
   mov CpuFlags, 0
-  pushf
+  pushfd
   pop eax
   mov ecx, eax
   xor eax, 40000h
   push eax
-  popf
-  pushf
+  popfd
+  pushfd
   pop eax
   xor eax, ecx
   jz nocpuid
   push ecx
-  popf
+  popfd
   mov eax, ecx
   xor eax, 200000h
   push eax
-  popf
-  pushf
+  popfd
+  pushfd
   pop eax
   xor eax, ecx
   je nocpuid
 
-  pusha
+  pushad
   mov eax, 1
   cpuid
   mov CpuFlags, edx
-  popa
+  popad
 
 nocpuid:
 end;
diff --git a/packages/ptc/src/dos/vesa/vesa.pp b/packages/ptc/src/dos/vesa/vesa.pp
index ffde68d740..18f8105d08 100644
--- a/packages/ptc/src/dos/vesa/vesa.pp
+++ b/packages/ptc/src/dos/vesa/vesa.pp
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MODE objfpc}{$H+}
@@ -298,7 +298,7 @@ function LFBNearPtrAccessPtr: Pointer;
 implementation
 
 uses
-  go32fix;
+  go32;
 
 type
   TVBEInfoBlock = packed record
diff --git a/packages/ptc/src/dos/vesa/vesaconsoled.inc b/packages/ptc/src/dos/vesa/vesaconsoled.inc
index 69b3db6637..79b5ca36e2 100644
--- a/packages/ptc/src/dos/vesa/vesaconsoled.inc
+++ b/packages/ptc/src/dos/vesa/vesaconsoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/vesa/vesaconsolei.inc b/packages/ptc/src/dos/vesa/vesaconsolei.inc
index 5414ab1615..f9f3e6e8ab 100644
--- a/packages/ptc/src/dos/vesa/vesaconsolei.inc
+++ b/packages/ptc/src/dos/vesa/vesaconsolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MACRO ON}
diff --git a/packages/ptc/src/dos/vga/vga.pp b/packages/ptc/src/dos/vga/vga.pp
index c05acec7c4..fc6ecfb306 100644
--- a/packages/ptc/src/dos/vga/vga.pp
+++ b/packages/ptc/src/dos/vga/vga.pp
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MODE objfpc}
@@ -66,7 +66,7 @@ procedure fakemode_load(src: PByte; wvr: Boolean);
 implementation
 
 uses
-  go32fix;
+  go32;
 
 var
   RealRegs: TRealRegs;
diff --git a/packages/ptc/src/dos/vga/vgaconsoled.inc b/packages/ptc/src/dos/vga/vgaconsoled.inc
index f73fe200ab..5341260523 100644
--- a/packages/ptc/src/dos/vga/vgaconsoled.inc
+++ b/packages/ptc/src/dos/vga/vgaconsoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/dos/vga/vgaconsolei.inc b/packages/ptc/src/dos/vga/vgaconsolei.inc
index 234a3b8e65..6ec2523497 100644
--- a/packages/ptc/src/dos/vga/vgaconsolei.inc
+++ b/packages/ptc/src/dos/vga/vgaconsolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MACRO ON}
diff --git a/packages/ptc/src/ptc.pp b/packages/ptc/src/ptc.pp
index 40b25dbcd1..b9399e3179 100644
--- a/packages/ptc/src/ptc.pp
+++ b/packages/ptc/src/ptc.pp
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MODE objfpc}
@@ -69,7 +69,7 @@ uses
 {$ENDIF FPDOC}
 
 const
-  PTCPAS_VERSION = 'PTCPas 0.99.14.1';
+  PTCPAS_VERSION = 'PTCPas 0.99.15';
 
 type
   PUint8  = ^Uint8;
@@ -117,7 +117,7 @@ implementation
 
 {$IFDEF GO32V2}
 uses
-  textfx2, vesa, vga, cga, timeunit, crt, go32fix, mouse33h;
+  textfx2, vesa, vga, cga, timeunit, crt, go32, mouse33h;
 {$ENDIF GO32V2}
 
 {$IF defined(WIN32) OR defined(WIN64)}
@@ -150,6 +150,9 @@ uses
     {$IFDEF ENABLE_X11_EXTENSION_GLX}
     , glx
     {$ENDIF ENABLE_X11_EXTENSION_GLX}
+    {$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+    , XI2, XInput2
+    {$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
   {$ENDIF X11}
   {$IFDEF COCOA}
     , CocoaAll
diff --git a/packages/ptc/src/ptclaz.lpi b/packages/ptc/src/ptclaz.lpi
new file mode 100644
index 0000000000..b2e9374ee1
--- /dev/null
+++ b/packages/ptc/src/ptclaz.lpi
@@ -0,0 +1,240 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ptclaz"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="45">
+      <Unit0>
+        <Filename Value="ptclaz.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="ptc.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ptc"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="core/aread.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="core/areai.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="core/baseconsoled.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="core/baseconsolei.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="core/basesurfaced.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="core/basesurfacei.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="core/cleard.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="core/cleari.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="core/clipperd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="core/clipperi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="core/closeeventd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="core/closeeventi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="core/colord.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="core/colori.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="core/consoled.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="core/consolei.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="core/copyd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="core/copyi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="core/coreimplementation.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="core/coreinterface.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="core/errord.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="core/errori.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="core/eventd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="core/eventi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="core/formatd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="core/formati.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="core/keyeventd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="core/keyeventi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="core/log.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="core/moded.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit31>
+      <Unit32>
+        <Filename Value="core/modei.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit32>
+      <Unit33>
+        <Filename Value="core/mouseeventd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="core/mouseeventi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="core/openglattributesd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="core/openglattributesi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="core/paletted.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit37>
+      <Unit38>
+        <Filename Value="core/palettei.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit38>
+      <Unit39>
+        <Filename Value="core/resizeeventd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit39>
+      <Unit40>
+        <Filename Value="core/resizeeventi.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit40>
+      <Unit41>
+        <Filename Value="core/surfaced.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit41>
+      <Unit42>
+        <Filename Value="core/surfacei.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit42>
+      <Unit43>
+        <Filename Value="core/timerd.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit43>
+      <Unit44>
+        <Filename Value="core/timeri.inc"/>
+        <IsPartOfProject Value="True"/>
+      </Unit44>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="ptclaz"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/packages/ptc/src/ptclaz.lpr b/packages/ptc/src/ptclaz.lpr
new file mode 100644
index 0000000000..b42a815625
--- /dev/null
+++ b/packages/ptc/src/ptclaz.lpr
@@ -0,0 +1,6 @@
+program ptclaz;
+uses
+  ptc;
+begin
+end.
+
diff --git a/packages/ptc/src/ptcpas.cfg b/packages/ptc/src/ptcpas.cfg
index 9c8c439bf1..cbf57ca833 100644
--- a/packages/ptc/src/ptcpas.cfg
+++ b/packages/ptc/src/ptcpas.cfg
@@ -122,3 +122,9 @@
 #dga2
 #dga2 on
 #dga2 off
+#xinput2
+#xinput2 on
+#xinput2 off
+#xshm
+#xshm on
+#xshm off
diff --git a/packages/ptc/src/ptcwrapper/ptceventqueue.pp b/packages/ptc/src/ptcwrapper/ptceventqueue.pp
index 35c8185a91..6fefd17852 100644
--- a/packages/ptc/src/ptcwrapper/ptceventqueue.pp
+++ b/packages/ptc/src/ptcwrapper/ptceventqueue.pp
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 unit ptceventqueue;
diff --git a/packages/ptc/src/ptcwrapper/ptcwrapper.pp b/packages/ptc/src/ptcwrapper/ptcwrapper.pp
index ccce6146bb..6f4c5c9ff5 100644
--- a/packages/ptc/src/ptcwrapper/ptcwrapper.pp
+++ b/packages/ptc/src/ptcwrapper/ptcwrapper.pp
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 unit ptcwrapper;
diff --git a/packages/ptc/src/win32/base/win32cursor.inc b/packages/ptc/src/win32/base/win32cursor.inc
index 64e91f72bc..2fd58ecd7a 100644
--- a/packages/ptc/src/win32/base/win32cursor.inc
+++ b/packages/ptc/src/win32/base/win32cursor.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWin32Cursor.Create;
diff --git a/packages/ptc/src/win32/base/win32cursord.inc b/packages/ptc/src/win32/base/win32cursord.inc
index e39f8abbf6..02603b6d7c 100644
--- a/packages/ptc/src/win32/base/win32cursord.inc
+++ b/packages/ptc/src/win32/base/win32cursord.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/base/win32cursormoded.inc b/packages/ptc/src/win32/base/win32cursormoded.inc
index b5faea69e3..0ab3370904 100644
--- a/packages/ptc/src/win32/base/win32cursormoded.inc
+++ b/packages/ptc/src/win32/base/win32cursormoded.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/base/win32event.inc b/packages/ptc/src/win32/base/win32event.inc
index 55a5403783..8169dfd605 100644
--- a/packages/ptc/src/win32/base/win32event.inc
+++ b/packages/ptc/src/win32/base/win32event.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWin32Event.Create;
diff --git a/packages/ptc/src/win32/base/win32eventd.inc b/packages/ptc/src/win32/base/win32eventd.inc
index d6c2661b33..fe64227846 100644
--- a/packages/ptc/src/win32/base/win32eventd.inc
+++ b/packages/ptc/src/win32/base/win32eventd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/base/win32hook.inc b/packages/ptc/src/win32/base/win32hook.inc
index 605551b1b4..aeaefc353e 100644
--- a/packages/ptc/src/win32/base/win32hook.inc
+++ b/packages/ptc/src/win32/base/win32hook.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -104,7 +104,10 @@ begin
   if result = 0 then
   begin
     { call original window procedure }
-    Result := CallWindowProc(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam);
+    if IsWindowUnicode(hwnd) then
+      Result := CallWindowProcW(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam)
+    else
+      Result := CallWindowProcA(WNDPROC(lookup^.wndproc), hwnd, msg, wParam, lParam);
   end;
 
   { leave monitor }
@@ -189,7 +192,10 @@ begin
 {$ENDIF}
 
     { set window procedure to hook procedure }
-    SetWindowLongPtr(AWindow, GWLP_WNDPROC, PtrInt(@TWin32Hook_hook));
+    if IsWindowUnicode(AWindow) then
+      SetWindowLongPtrW(AWindow, GWLP_WNDPROC, PtrInt(@TWin32Hook_hook))
+    else
+      SetWindowLongPtrA(AWindow, GWLP_WNDPROC, PtrInt(@TWin32Hook_hook));
   end;
 
   { leave monitor }
@@ -236,7 +242,10 @@ begin
       if TWin32Hook_m_registry[index].count = 0 then
       begin
         { restore original window procedure }
-        SetWindowLongPtr(AWindow, GWLP_WNDPROC, TWin32Hook_m_registry[i].wndproc);
+        if IsWindowUnicode(AWindow) then
+          SetWindowLongPtrW(AWindow, GWLP_WNDPROC, TWin32Hook_m_registry[i].wndproc)
+        else
+          SetWindowLongPtrA(AWindow, GWLP_WNDPROC, TWin32Hook_m_registry[i].wndproc);
 
         { remove this lookup (quite inefficient for high count...) }
         for i := index to TWin32Hook_Count - 2 do
diff --git a/packages/ptc/src/win32/base/win32hookd.inc b/packages/ptc/src/win32/base/win32hookd.inc
index 12cd920b33..e10efa2784 100644
--- a/packages/ptc/src/win32/base/win32hookd.inc
+++ b/packages/ptc/src/win32/base/win32hookd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/base/win32kbd.inc b/packages/ptc/src/win32/base/win32kbd.inc
index 7bba157817..73eba3c7b1 100644
--- a/packages/ptc/src/win32/base/win32kbd.inc
+++ b/packages/ptc/src/win32/base/win32kbd.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWin32Keyboard.Create(AWindow: HWND; AThread: DWord; AMultithreaded: Boolean; AEventQueue: TEventQueue);
@@ -38,11 +38,6 @@ begin
   FMonitor := TWin32Monitor.Create;
   FEvent := TWin32Event.Create;
 
-  { setup defaults }
-  FAlt := False;
-  FShift := False;
-  FControl := False;
-
   { setup data }
   FEventQueue := AEventQueue;
   FMultithreaded := AMultithreaded;
@@ -71,9 +66,15 @@ begin
 end;
 
 function TWin32Keyboard.WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT;
+const
+  {$warning move this to the windows unit! }
+  MAPVK_VK_TO_CHAR = 2;
+  MAPVK_VK_TO_VSC = 0;
+  MAPVK_VSC_TO_VK = 1;
+  MAPVK_VSC_TO_VK_EX = 3;
 var
   i: Integer;
-  scancode: Integer;
+  scancode: UINT;
   KeyStateArray: array [0..255] of Byte;
   AsciiBuf: Word;
   press: Boolean;
@@ -81,6 +82,10 @@ var
   TranslatedCharacters, TranslatedWideCharacters: Integer;
   WideStr: WideString;
   KeyCode: Integer;
+  ScanCodeB: Byte;
+  ExtendedKey, DeadKey: Boolean;
+  ModifierKeys: TPTCModifierKeys;
+  tmpUINT: UINT;
 begin
   Result := 0;
   { check enabled flag }
@@ -91,19 +96,55 @@ begin
   if (message = WM_KEYDOWN) or (message = WM_KEYUP) or (message = WM_SYSKEYDOWN) or (message = WM_SYSKEYUP) then
   begin
     press := (message = WM_KEYDOWN) or (message = WM_SYSKEYDOWN);
+    ScanCodeB := Byte(lParam shr 16);
+    ExtendedKey := (lParam and (1 shl 24)) <> 0;
+
+    ModifierKeys := [];
 
     { update modifiers }
-    if wParam = VK_MENU then
-      { alt }
-      FAlt := press
-    else
-      if wParam = VK_SHIFT then
-        { shift }
-        FShift := press
-      else
-        if wParam = VK_CONTROL then
-          { control }
-          FControl := press;
+    { dead key? }
+    DeadKey := (MapVirtualKey(wParam, MAPVK_VK_TO_CHAR) and $80000000) <> 0;
+    if DeadKey then
+      Include(ModifierKeys, pmkDeadKey);
+    { alt }
+    if (GetKeyState(VK_MENU) and $8000) <> 0 then
+      Include(ModifierKeys, pmkAlt);
+    { shift }
+    if (GetKeyState(VK_SHIFT) and $8000) <> 0 then
+      Include(ModifierKeys, pmkShift);
+    { control }
+    if (GetKeyState(VK_CONTROL) and $8000) <> 0 then
+      Include(ModifierKeys, pmkControl);
+    { left/right alt }
+    if (GetKeyState(VK_LMENU) and $8000) <> 0 then
+      Include(ModifierKeys, pmkLeftAlt);
+    if (GetKeyState(VK_RMENU) and $8000) <> 0 then
+      Include(ModifierKeys, pmkRightAlt);
+    { left/right shift }
+    if (GetKeyState(VK_LSHIFT) and $8000) <> 0 then
+      Include(ModifierKeys, pmkLeftShift);
+    if (GetKeyState(VK_RSHIFT) and $8000) <> 0 then
+      Include(ModifierKeys, pmkRightShift);
+    { left/right control }
+    if (GetKeyState(VK_LCONTROL) and $8000) <> 0 then
+      Include(ModifierKeys, pmkLeftControl);
+    if (GetKeyState(VK_RCONTROL) and $8000) <> 0 then
+      Include(ModifierKeys, pmkRightControl);
+    { num lock }
+    if (GetKeyState(VK_NUMLOCK) and $8000) <> 0 then
+      Include(ModifierKeys, pmkNumLockPressed);
+    if (GetKeyState(VK_NUMLOCK) and 1) <> 0 then
+      Include(ModifierKeys, pmkNumLockActive);
+    { caps lock }
+    if (GetKeyState(VK_CAPITAL) and $8000) <> 0 then
+      Include(ModifierKeys, pmkCapsLockPressed);
+    if (GetKeyState(VK_CAPITAL) and 1) <> 0 then
+      Include(ModifierKeys, pmkCapsLockActive);
+    { scroll lock }
+    if (GetKeyState(VK_SCROLL) and $8000) <> 0 then
+      Include(ModifierKeys, pmkScrollLockPressed);
+    if (GetKeyState(VK_SCROLL) and 1) <> 0 then
+      Include(ModifierKeys, pmkScrollLockActive);
 
     { enter monitor if multithreaded }
     if FMultithreaded then
@@ -114,25 +155,66 @@ begin
     if GetKeyboardState(@KeyStateArray) then
     begin
       scancode := (lParam shr 16) and $FF;
-      {todo: ToUnicode (Windows NT)}
-      TranslatedCharacters := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0);
-      if (TranslatedCharacters = 1) or (TranslatedCharacters = 2) then
+      if not press then
+        scancode := scancode or $8000;
+      if IsWindowUnicode(hWnd) then
       begin
-        TranslatedWideCharacters := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @AsciiBuf, TranslatedCharacters, nil, 0);
-        if TranslatedWideCharacters <> 0 then
+        SetLength(WideStr, 16);
+        TranslatedWideCharacters := ToUnicode(wParam, scancode, @KeyStateArray, @WideStr[1], Length(WideStr), 0);
+        if TranslatedWideCharacters <> -1 then
+          SetLength(WideStr, TranslatedWideCharacters)
+        else
+          WideStr := '';
+      end
+      else
+      begin
+        TranslatedCharacters := ToAscii(wParam, scancode, @KeyStateArray, @AsciiBuf, 0);
+        if TranslatedCharacters > 0 then
         begin
+          TranslatedWideCharacters := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @AsciiBuf, TranslatedCharacters, nil, 0);
           SetLength(WideStr, TranslatedWideCharacters);
-          MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @AsciiBuf, TranslatedCharacters, @WideStr[1], TranslatedWideCharacters);
-
-          if Length(WideStr) = 1 then
-            uni := Ord(WideStr[1]);
-        end;
+          if TranslatedWideCharacters <> 0 then
+            MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, @AsciiBuf, TranslatedCharacters, @WideStr[1], TranslatedWideCharacters);
+        end
+        else
+          WideStr := '';
       end;
+      if Length(WideStr) = 1 then
+        uni := Ord(WideStr[1]);
     end;
 
     KeyCode := wParam;
     if wParam = VK_RETURN then
+    begin
       KeyCode := PTCKEY_ENTER;
+      if ExtendedKey then
+        Include(ModifierKeys, pmkNumPadKey);
+    end;
+    if wParam = VK_SHIFT then
+    begin
+      tmpUINT := MapVirtualKey(ScanCodeB, MAPVK_VSC_TO_VK_EX);
+      if tmpUINT <> 0 then
+      begin
+        { Windows NT 4.0/2000+ }
+        if tmpUINT = VK_RSHIFT then
+          Include(ModifierKeys, pmkRightKey);
+      end
+      else
+      begin
+        { Windows 98 }
+        if ScanCodeB = 54 then
+          Include(ModifierKeys, pmkRightKey);
+      end;
+    end;
+    if ExtendedKey and (wParam in [VK_MENU,VK_CONTROL]) then
+      Include(ModifierKeys, pmkRightKey);
+    if not ExtendedKey and
+      (wParam in [VK_LEFT,VK_RIGHT,VK_UP,VK_DOWN,VK_INSERT,VK_DELETE,
+                  VK_HOME,VK_END,VK_PRIOR,VK_NEXT]) then
+      Include(ModifierKeys, pmkNumPadKey);
+    if wParam in [VK_CLEAR,VK_NUMPAD0..VK_NUMPAD9,VK_DECIMAL,VK_DIVIDE,
+                  VK_MULTIPLY,VK_SUBTRACT,VK_ADD,VK_NUMLOCK] then
+      Include(ModifierKeys, pmkNumPadKey);
     if wParam = VK_INSERT then
       KeyCode := PTCKEY_INSERT;
     if wParam = VK_DELETE then
@@ -141,11 +223,23 @@ begin
       KeyCode := PTCKEY_COMMA;
     if wParam = VK_OEM_PERIOD then
       KeyCode := PTCKEY_PERIOD;
+    if wParam = VK_OEM_PLUS then
+      KeyCode := PTCKEY_EQUALS;
+    if wParam = VK_OEM_4 then
+      KeyCode := PTCKEY_OPENBRACKET;
+    if wParam = VK_OEM_6 then
+      KeyCode := PTCKEY_CLOSEBRACKET;
+    if wParam = VK_OEM_5 then
+      KeyCode := PTCKEY_BACKSLASH;
+    if wParam = VK_OEM_1 then
+      KeyCode := PTCKEY_SEMICOLON;
+    if wParam = VK_OEM_2 then
+      KeyCode := PTCKEY_SLASH;
 
     { handle key repeat count }
     for i := 1 to lParam and $FFFF do
       { create and insert key object }
-      FEventQueue.AddEvent(TPTCKeyEvent.Create(KeyCode, uni, FAlt, FShift, FControl, press));
+      FEventQueue.AddEvent(TPTCKeyEvent.Create(KeyCode, uni, ModifierKeys, press));
 
     { check multithreaded flag }
     if FMultithreaded then
@@ -157,18 +251,4 @@ begin
       FMonitor.Leave;
     end;
   end;
-(*  else
-    if message = WM_KEYUP then
-      { update modifiers }
-      if wParam = VK_MENU then
-        { alt up }
-        m_alt := False
-      else
-        if wParam = VK_SHIFT then
-          { shift up }
-          m_shift := False
-        else
-          if wParam = VK_CONTROL then
-            { control up }
-            m_control := False;*)
 end;
diff --git a/packages/ptc/src/win32/base/win32kbdd.inc b/packages/ptc/src/win32/base/win32kbdd.inc
index 6b117d0cd0..f6b39edb4f 100644
--- a/packages/ptc/src/win32/base/win32kbdd.inc
+++ b/packages/ptc/src/win32/base/win32kbdd.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2009, 2010  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2009, 2010, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -42,11 +42,6 @@ type
     { flag data }
     FEnabled: Boolean;
 
-    { modifiers }
-    FAlt: Boolean;
-    FShift: Boolean;
-    FControl: Boolean;
-
     { window procedure }
     function WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT; override;
   public
diff --git a/packages/ptc/src/win32/base/win32monitor.inc b/packages/ptc/src/win32/base/win32monitor.inc
index d27e7b083a..9f1adc941e 100644
--- a/packages/ptc/src/win32/base/win32monitor.inc
+++ b/packages/ptc/src/win32/base/win32monitor.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 { $DEFINE __DISABLE_MULTITHREADING__}
diff --git a/packages/ptc/src/win32/base/win32monitord.inc b/packages/ptc/src/win32/base/win32monitord.inc
index 1b7c4b4ef5..f836a5dded 100644
--- a/packages/ptc/src/win32/base/win32monitord.inc
+++ b/packages/ptc/src/win32/base/win32monitord.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/base/win32moused.inc b/packages/ptc/src/win32/base/win32moused.inc
index 3ada122e88..05f45009a1 100644
--- a/packages/ptc/src/win32/base/win32moused.inc
+++ b/packages/ptc/src/win32/base/win32moused.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2007, 2009, 2010, 2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2007, 2009, 2010, 2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -62,6 +62,7 @@ type
 
     procedure SetWindowArea(AWindowX1, AWindowY1, AWindowX2, AWindowY2: Integer);
     procedure SetConsoleSize(AConsoleWidth, AConsoleHeight: Integer);
+    function MoveMouseTo(X, Y: Integer): Boolean;
 
     { control }
     procedure Enable;
diff --git a/packages/ptc/src/win32/base/win32mousei.inc b/packages/ptc/src/win32/base/win32mousei.inc
index 221e8f0997..30ade9e8bc 100644
--- a/packages/ptc/src/win32/base/win32mousei.inc
+++ b/packages/ptc/src/win32/base/win32mousei.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2007, 2009, 2010, 2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2007, 2009, 2010, 2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWin32Mouse.Create(AWindow: HWND; AThread: DWord; AMultithreaded: Boolean; AEventQueue: TEventQueue;
@@ -73,18 +73,48 @@ begin
   FEnabled := False;
 end;
 
+function TWin32Mouse.MoveMouseTo(X, Y: Integer): Boolean;
+var
+  WindowRect: RECT;
+  pt: TPOINT;
+begin
+  if (X < 0) or (X >= FConsoleWidth) or (Y <= 0) or (Y >= FConsoleHeight) then
+    exit(False);
+
+  if not FFullScreen then
+  begin
+    if not GetClientRect(FWindow, WindowRect) then
+      exit(False);
+
+    FWindowX1 := WindowRect.left;
+    FWindowY1 := WindowRect.top;
+    FWindowX2 := WindowRect.right - 1;
+    FWindowY2 := WindowRect.bottom - 1;
+  end;
+
+  pt.X := X * (FWindowX2 - FWindowX1) div (FConsoleWidth - 1) + FWindowX1;
+  pt.Y := Y * (FWindowY2 - FWindowY1) div (FConsoleHeight - 1) + FWindowY1;
+
+  if not ClientToScreen(FWindow, pt) then
+    exit(False);
+
+  Result := SetCursorPos(pt.X, pt.Y);
+end;
+
 function TWin32Mouse.WndProc(hWnd: HWND; message: DWord; wParam: WPARAM; lParam: LPARAM): LRESULT;
 var
   fwKeys: Integer;
-  xPos, yPos: Integer;
-  LButton, MButton, RButton: Boolean;
+  CurPos: POINT;
+  LButton, MButton, RButton, XButton1, XButton2: Boolean;
   TranslatedXPos, TranslatedYPos: Integer;
   PTCMouseButtonState: TPTCMouseButtonState;
   WindowRect: RECT;
+  ScrollAmount: Integer;
 
   button: TPTCMouseButton;
   before, after: Boolean;
   cstate: TPTCMouseButtonState;
+  I: Integer;
 begin
   Result := 0;
   { check enabled flag }
@@ -94,15 +124,27 @@ begin
   if (message = WM_MOUSEMOVE) or
      (message = WM_LBUTTONDOWN) or (message = WM_LBUTTONUP) or (message = WM_LBUTTONDBLCLK) or
      (message = WM_MBUTTONDOWN) or (message = WM_MBUTTONUP) or (message = WM_MBUTTONDBLCLK) or
-     (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_RBUTTONDBLCLK) then
+     (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_RBUTTONDBLCLK) or
+     (message = WM_XBUTTONDOWN) or (message = WM_XBUTTONUP) or (message = WM_XBUTTONDBLCLK) or
+     (message = WM_MOUSEWHEEL) or (message = WM_MOUSEHWHEEL) then
   begin
-    fwKeys := wParam; {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT}
-    xPos := lParam and $FFFF;
-    yPos := (lParam shr 16) and $FFFF;
+    fwKeys := Word(wParam); {MK_LBUTTON or MK_MBUTTON or MK_RBUTTON or MK_CONTROL or MK_SHIFT}
+    CurPos.x := GET_X_LPARAM(lParam);
+    CurPos.y := GET_Y_LPARAM(lParam);
+
+    if (message = WM_MOUSEWHEEL) or (message = WM_MOUSEHWHEEL) then
+    begin
+      ScrollAmount := SmallInt(wParam shr 16);
+      { for WM_MOUSEWHEEL and WM_MOUSEHWHEEL, windows returns cursor position in
+        screen coordinates, instead of client coordinates, so convert them }
+      ScreenToClient(hWnd, CurPos);
+    end;
 
     LButton := (fwKeys and MK_LBUTTON) <> 0;
     MButton := (fwKeys and MK_MBUTTON) <> 0;
     RButton := (fwKeys and MK_RBUTTON) <> 0;
+    XButton1 := (fwKeys and MK_XBUTTON1) <> 0;
+    XButton2 := (fwKeys and MK_XBUTTON2) <> 0;
 
     if not FFullScreen then
     begin
@@ -114,16 +156,16 @@ begin
       FWindowY2 := WindowRect.bottom - 1;
     end;
 
-    if (xPos >= FWindowX1) and (yPos >= FWindowY1) and
-       (xPos <= FWindowX2) and (yPos <= FWindowY2) then
+    if (CurPos.x >= FWindowX1) and (CurPos.y >= FWindowY1) and
+       (CurPos.x <= FWindowX2) and (CurPos.y <= FWindowY2) then
     begin
       if FWindowX2 <> FWindowX1 then
-        TranslatedXPos := (xPos - FWindowX1) * (FConsoleWidth  - 1) div (FWindowX2 - FWindowX1)
+        TranslatedXPos := (CurPos.x - FWindowX1) * (FConsoleWidth  - 1) div (FWindowX2 - FWindowX1)
       else { avoid div by zero }
         TranslatedXPos := 0;
 
       if FWindowY2 <> FWindowY1 then
-        TranslatedYPos := (yPos - FWindowY1) * (FConsoleHeight - 1) div (FWindowY2 - FWindowY1)
+        TranslatedYPos := (CurPos.y - FWindowY1) * (FConsoleHeight - 1) div (FWindowY2 - FWindowY1)
       else { avoid div by zero }
         TranslatedYPos := 0;
 
@@ -141,12 +183,14 @@ begin
         PTCMouseButtonState := []
       else
         PTCMouseButtonState := [PTCMouseButton1];
-
       if RButton then
         PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
-
       if MButton then
         PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
+      if XButton1 then
+        PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton8];
+      if XButton2 then
+        PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton9];
 
       if not FPreviousMousePositionSaved then
       begin
@@ -180,6 +224,34 @@ begin
           end;
       end;
 
+      { scroll wheel? }
+      if (message = WM_MOUSEWHEEL) and (Abs(ScrollAmount) >= WHEEL_DELTA) then
+        if ScrollAmount > 0 then
+          for I := 1 to ScrollAmount div WHEEL_DELTA do
+          begin
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate + [PTCMouseButton4], True, PTCMouseButton4));
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, PTCMouseButton4));
+          end
+        else
+          for I := 1 to Abs(ScrollAmount) div WHEEL_DELTA do
+          begin
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate + [PTCMouseButton5], True, PTCMouseButton5));
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, PTCMouseButton5));
+          end;
+      if (message = WM_MOUSEHWHEEL) and (Abs(ScrollAmount) >= WHEEL_DELTA) then
+        if ScrollAmount > 0 then
+          for I := 1 to ScrollAmount div WHEEL_DELTA do
+          begin
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate + [PTCMouseButton7], True, PTCMouseButton7));
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, PTCMouseButton7));
+          end
+        else
+          for I := 1 to Abs(ScrollAmount) div WHEEL_DELTA do
+          begin
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate + [PTCMouseButton6], True, PTCMouseButton6));
+            FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(TranslatedXPos, TranslatedYPos, 0, 0, cstate, False, PTCMouseButton6));
+          end;
+
       FPreviousMouseX := TranslatedXPos;
       FPreviousMouseY := TranslatedYPos;
       FPreviousMouseButtonState := PTCMouseButtonState;
diff --git a/packages/ptc/src/win32/base/win32resized.inc b/packages/ptc/src/win32/base/win32resized.inc
index 44726d9bdc..13551777d6 100644
--- a/packages/ptc/src/win32/base/win32resized.inc
+++ b/packages/ptc/src/win32/base/win32resized.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/base/win32resizei.inc b/packages/ptc/src/win32/base/win32resizei.inc
index ab59d86638..ceb6268c2f 100644
--- a/packages/ptc/src/win32/base/win32resizei.inc
+++ b/packages/ptc/src/win32/base/win32resizei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWin32Resize.Create(AWindow: HWND; AThread: DWord; AEventQueue: TEventQueue);
diff --git a/packages/ptc/src/win32/base/win32window.inc b/packages/ptc/src/win32/base/win32window.inc
index 2dc6401841..b65aabdb4b 100644
--- a/packages/ptc/src/win32/base/win32window.inc
+++ b/packages/ptc/src/win32/base/win32window.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2012  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2012, 2016, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$ifdef VER2_6}
@@ -46,6 +46,8 @@ begin
   defaults;
   FWindow := window;
   FManaged := False;
+  FIsUnicode := IsWindowUnicode(window);
+  LOG('IsUnicode', IsUnicode);
 end;
 
 function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; forward;
@@ -59,33 +61,73 @@ var
   rectangle: RECT;
   display_width, display_height: Integer;
   wc: WNDCLASSEXA;
+  wcw: WNDCLASSEXW;
+  WinVer: OSVERSIONINFO;
+  AWndClassW, ATitleW: WideString;
 begin
   LOG('creating managed window');
   Defaults;
   FMultithreaded := AMultithreaded;
   try
+    FillChar(WinVer, SizeOf(WinVer), 0);
+    WinVer.dwOSVersionInfoSize := SizeOf(WinVer);
+    if not GetVersionEx(WinVer) then
+      raise TPTCError.Create('GetVersionEx failed');
+    { Win32s on Windows 3.1 and Win32 on Windows 95/98/ME don't support unicode }
+    FIsUnicode := (WinVer.dwPlatformId <> VER_PLATFORM_WIN32s) and
+      (WinVer.dwPlatformId <> VER_PLATFORM_WIN32_WINDOWS);
+    LOG('IsUnicode', IsUnicode);
+
     FInterceptClose := AInterceptClose;
     program_instance := GetModuleHandle(nil);
 {    library_instance := program_instance;}
-    wc.cbSize := SizeOf(wc);
-    wc.hInstance := program_instance;
-    wc.lpszClassName := PChar(AWndClass);
-    wc.style := AClassStyle;
-    wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
-    wc.hIconSm := 0;
-    wc.lpszMenuName := nil;
-    wc.cbClsExtra := 0;
-    wc.cbWndExtra := 0;
-    wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
-    if AMultithreaded then
-      wc.lpfnWndProc := @WndProcMultiThreaded
-    else
-      wc.lpfnWndProc := @WndProcSingleThreaded;
-    if ACursor then
-      wc.hCursor := LoadCursor(0, IDC_ARROW)
+    if IsUnicode then
+    begin
+      AWndClassW := AWndClass;
+      ATitleW := ATitle;
+
+      wcw.cbSize := SizeOf(wcw);
+      wcw.hInstance := program_instance;
+      wcw.lpszClassName := PWideChar(AWndClassW);
+      wcw.style := AClassStyle;
+      wcw.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
+      wcw.hIconSm := 0;
+      wcw.lpszMenuName := nil;
+      wcw.cbClsExtra := 0;
+      wcw.cbWndExtra := 0;
+      wcw.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
+      if AMultithreaded then
+        wcw.lpfnWndProc := @WndProcMultiThreaded
+      else
+        wcw.lpfnWndProc := @WndProcSingleThreaded;
+      if ACursor then
+        wcw.hCursor := LoadCursorW(0, PWideChar(IDC_ARROW))
+      else
+        wcw.hCursor := 0;
+      RegisterClassExW(wcw);
+    end
     else
-      wc.hCursor := 0;
-    RegisterClassExA(wc);
+    begin
+      wc.cbSize := SizeOf(wc);
+      wc.hInstance := program_instance;
+      wc.lpszClassName := PChar(AWndClass);
+      wc.style := AClassStyle;
+      wc.hIcon := 0{LoadIcon(library_instance, 'IDI_PTC_ICON')};
+      wc.hIconSm := 0;
+      wc.lpszMenuName := nil;
+      wc.cbClsExtra := 0;
+      wc.cbWndExtra := 0;
+      wc.hbrBackground := 0;{(HBRUSH) GetStockObject(BLACK_BRUSH)}
+      if AMultithreaded then
+        wc.lpfnWndProc := @WndProcMultiThreaded
+      else
+        wc.lpfnWndProc := @WndProcSingleThreaded;
+      if ACursor then
+        wc.hCursor := LoadCursorA(0, IDC_ARROW)
+      else
+        wc.hCursor := 0;
+      RegisterClassExA(wc);
+    end;
     with rectangle do
     begin
       left := 0;
@@ -117,7 +159,10 @@ begin
     end
     else
     begin
-      FWindow := CreateWindowExA(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, Self);
+      if IsUnicode then
+        FWindow := CreateWindowExW(FExtra, PWideChar(AWndClassW), PWideChar(ATitleW), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, Self)
+      else
+        FWindow := CreateWindowExA(FExtra, PChar(FName), PChar(FTitle), FStyle, FX, FY, FWidth, FHeight, 0, 0, 0, Self);
       if not IsWindow(FWindow) then
         raise TPTCError.Create('could not create window');
       ShowWindow(FWindow, FShow);
@@ -140,16 +185,20 @@ end;
 procedure TWin32Window.Cursor(AFlag: Boolean);
 begin
   if AFlag then
-  begin
-//    SetClassLong(FWindow, GCL_HCURSOR, LoadCursor(0, IDC_ARROW));
-    SetClassLongPtr(FWindow, GCLP_HCURSOR, LoadCursor(0, IDC_ARROW));
-  end
+    if IsUnicode then
+      SetClassLongPtrW(FWindow, GCLP_HCURSOR, LoadCursorW(0, PWideChar(IDC_ARROW)))
+    else
+      SetClassLongPtrA(FWindow, GCLP_HCURSOR, LoadCursorA(0, IDC_ARROW))
   else
-  begin
-//    SetClassLong(FWindow, GCL_HCURSOR, 0);
-    SetClassLongPtr(FWindow, GCLP_HCURSOR, 0);
-  end;
-  SendMessage(FWindow, WM_SETCURSOR, 0, 0);
+    if IsUnicode then
+      SetClassLongPtrW(FWindow, GCLP_HCURSOR, 0)
+    else
+      SetClassLongPtrA(FWindow, GCLP_HCURSOR, 0);
+
+  if IsUnicode then
+    SendMessageW(FWindow, WM_SETCURSOR, 0, 0)
+  else
+    SendMessageA(FWindow, WM_SETCURSOR, 0, 0);
 end;
 
 procedure TWin32Window.ConfineCursor(AFlag: Boolean);
@@ -216,18 +265,43 @@ begin
     { updated to pump all window messages, and not just for our FWindow;
       this fixes keyboard layout switching and maybe other bugs and side effects...
       Seems like Windows wants everything pumped :) }
+
+    { TranslateMessage isn't called, because it's incompatible with the
+      ToAscii/ToUnicode functions, which we use for translating keys to
+      characters. Both ToAscii/ToUnicode and TranslateMessage modify the kernel
+      key state, in such a way, which assumes that only one of these functions
+      is called per key event, so when both are called, they kill the dead key
+      support (because the dead key pressed state is toggled twice or something
+      like that). TODO: maybe we should call TranslateMessage for windows, which
+      aren't managed by us? }
     if AWaitForMessage then
     begin
-      GetMessage(message, {FWindow}0, 0, 0);
-      TranslateMessage(message);
-      DispatchMessage(message);
-    end
-    else
-      while PeekMessage(message, {FWindow}0, 0, 0, PM_REMOVE) do
+      if IsUnicode then
       begin
-        TranslateMessage(message);
-        DispatchMessage(message);
+        GetMessageW(message, {FWindow}0, 0, 0);
+        //TranslateMessage(message);
+        DispatchMessageW(message);
+      end
+      else
+      begin
+        GetMessageA(message, {FWindow}0, 0, 0);
+        //TranslateMessage(message);
+        DispatchMessageA(message);
       end;
+    end
+    else
+      if IsUnicode then
+        while PeekMessageW(message, {FWindow}0, 0, 0, PM_REMOVE) do
+        begin
+          //TranslateMessage(message);
+          DispatchMessageW(message);
+        end
+      else
+        while PeekMessageA(message, {FWindow}0, 0, 0, PM_REMOVE) do
+        begin
+          //TranslateMessage(message);
+          DispatchMessageA(message);
+        end;
   end
   else
     Sleep(0);
@@ -251,7 +325,10 @@ begin
       begin
         pCreate := PCREATESTRUCT(lParam);
         WindowObject := TWin32Window(pCreate^.lpCreateParams);
-        SetWindowLongPtr(hWnd, GWLP_USERDATA, LONG_PTR(WindowObject));
+        if IsWindowUnicode(hWnd) then
+          SetWindowLongPtrW(hWnd, GWLP_USERDATA, LONG_PTR(WindowObject))
+        else
+          SetWindowLongPtrA(hWnd, GWLP_USERDATA, LONG_PTR(WindowObject));
         Result := WindowObject.WMCreate(hWnd, message, wParam, lParam);
       end;
     WM_DESTROY:
@@ -259,22 +336,35 @@ begin
         WindowObject := TWin32Window(GetWindowLongPtr(hWnd, GWLP_USERDATA));
         Result := WindowObject.WMDestroy(hWnd, message, wParam, lParam);
       end;
+    WM_MOUSEMOVE,
+    WM_LBUTTONDOWN, WM_LBUTTONUP, WM_LBUTTONDBLCLK,
+    WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK,
+    WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK,
+    WM_XBUTTONDOWN, WM_XBUTTONUP, WM_XBUTTONDBLCLK,
+    WM_MOUSEWHEEL, WM_MOUSEHWHEEL:
+      Result := 0;
     WM_SYSCOMMAND:
       begin
         { this fixes the pausing of the application when the Alt or F10 key is pressed }
         if wParam = SC_KEYMENU then
-	  Result := 0
-	else
-          Result := DefWindowProcA(hWnd, message, wParam, lParam);
+          Result := 0
+        else
+          if IsWindowUnicode(hWnd) then
+            Result := DefWindowProcW(hWnd, message, wParam, lParam)
+          else
+            Result := DefWindowProcA(hWnd, message, wParam, lParam);
       end;
     WM_SETCURSOR: begin
       if (LOWORD(lParam) = HTCLIENT) and (GetClassLongPtr(hWnd, GCLP_HCURSOR) = 0) then
       begin
         SetCursor(0);
-	Result := 1;
+        Result := 1;
       end
       else
-        Result := DefWindowProcA(hWnd, message, wParam, lParam);
+        if IsWindowUnicode(hWnd) then
+          Result := DefWindowProcW(hWnd, message, wParam, lParam)
+        else
+          Result := DefWindowProcA(hWnd, message, wParam, lParam);
     end;
     WM_CLOSE: begin
       LOG('TWin32Window WM_CLOSE');
@@ -285,7 +375,10 @@ begin
         Halt(0);
     end;
     else
-      Result := DefWindowProcA(hWnd, message, wParam, lParam);
+      if IsWindowUnicode(hWnd) then
+        Result := DefWindowProcW(hWnd, message, wParam, lParam)
+      else
+        Result := DefWindowProcA(hWnd, message, wParam, lParam);
   end;
 end;
 
@@ -297,18 +390,24 @@ begin
       begin
         { this fixes the pausing of the application when the Alt or F10 key is pressed }
         if wParam = SC_KEYMENU then
-	  Result := 0
-	else
-          Result := DefWindowProcA(hWnd, message, wParam, lParam);
+          Result := 0
+        else
+          if IsWindowUnicode(hWnd) then
+            Result := DefWindowProcW(hWnd, message, wParam, lParam)
+          else
+            Result := DefWindowProcA(hWnd, message, wParam, lParam);
       end;
     WM_SETCURSOR: begin
       if (LOWORD(lParam) = HTCLIENT) and (GetClassLongPtr(hWnd, GCLP_HCURSOR) = 0) then
       begin
         SetCursor(0);
-	Result := 1;
+        Result := 1;
       end
       else
-        Result := DefWindowProcA(hWnd, message, wParam, lParam);
+        if IsWindowUnicode(hWnd) then
+          Result := DefWindowProcW(hWnd, message, wParam, lParam)
+        else
+          Result := DefWindowProcA(hWnd, message, wParam, lParam);
     end;
     WM_DESTROY: begin
       LOG('TWin32Window WM_DESTROY');
@@ -319,7 +418,10 @@ begin
       Halt(0);
     end;
     else
-      Result := DefWindowProcA(hWnd, message, wParam, lParam);
+      if IsWindowUnicode(hWnd) then
+        Result := DefWindowProcW(hWnd, message, wParam, lParam)
+      else
+        Result := DefWindowProcA(hWnd, message, wParam, lParam);
   end;
 end;
 
@@ -406,10 +508,16 @@ end;
 
 function TWin32Window.WMCreate(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
 begin
-  Result := DefWindowProcA(hWnd, uMsg, wParam, lParam);
+  if IsUnicode then
+    Result := DefWindowProcW(hWnd, uMsg, wParam, lParam)
+  else
+    Result := DefWindowProcA(hWnd, uMsg, wParam, lParam);
 end;
 
 function TWin32Window.WMDestroy(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
 begin
-  Result := DefWindowProcA(hWnd, uMsg, wParam, lParam);
+  if IsUnicode then
+    Result := DefWindowProcW(hWnd, uMsg, wParam, lParam)
+  else
+    Result := DefWindowProcA(hWnd, uMsg, wParam, lParam);
 end;
diff --git a/packages/ptc/src/win32/base/win32windowd.inc b/packages/ptc/src/win32/base/win32windowd.inc
index 8ccf5622da..8fd986ae92 100644
--- a/packages/ptc/src/win32/base/win32windowd.inc
+++ b/packages/ptc/src/win32/base/win32windowd.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009, 2010, 2012, 2017  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -48,6 +48,7 @@ type
     FMultithreaded: Boolean;
     FCursorConfineInEffect: Boolean;
     FInterceptClose: Boolean;
+    FIsUnicode: Boolean;
 
 {    class function WndProcSingleThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
     class function WndProcMultiThreaded(hWnd: HWND; message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;}
@@ -73,4 +74,5 @@ type
     property Managed: Boolean read FManaged;
     property Multithreaded: Boolean read FMultithreaded;
     property InterceptClose: Boolean read FInterceptClose write FInterceptClose;
+    property IsUnicode: Boolean read FIsUnicode;
   end;
diff --git a/packages/ptc/src/win32/directx/p_ddraw.pp b/packages/ptc/src/win32/directx/p_ddraw.pp
index 19c58ea4fb..a50791db80 100644
--- a/packages/ptc/src/win32/directx/p_ddraw.pp
+++ b/packages/ptc/src/win32/directx/p_ddraw.pp
@@ -2967,7 +2967,7 @@ const
 (*
  * DirectDraw supports deinterlacing of overlay surfaces
  *)
-  DDFXCAPS_OVERLAYDEINTERLACE		= $20000000;
+  DDFXCAPS_OVERLAYDEINTERLACE     = $20000000;
 
 (*
  * Driver can do alpha blending for blits.
diff --git a/packages/ptc/src/win32/directx/p_dinput.pp b/packages/ptc/src/win32/directx/p_dinput.pp
new file mode 100644
index 0000000000..64d32bc7c1
--- /dev/null
+++ b/packages/ptc/src/win32/directx/p_dinput.pp
@@ -0,0 +1,4829 @@
+(****************************************************************************
+ *
+ *  Copyright (C) 1996-2002 Microsoft Corporation.  All Rights Reserved.
+ *
+ *  File:       dinput.h
+ *  Content:    DirectInput include file
+ *
+ ****************************************************************************)
+
+unit p_dinput;
+
+{$MODE objfpc}{$H+}
+{$MACRO on}
+{$PACKRECORDS c}
+
+{$MODESWITCH NESTEDCOMMENTS-}
+
+interface
+
+uses
+  windows;
+
+//#ifndef __DINPUT_INCLUDED__
+//#define __DINPUT_INCLUDED__
+//
+//#include <winapifamily.h>
+//
+//#ifndef DIJ_RINGZERO
+//
+//#ifdef _WIN32
+//#define COM_NO_WINDOWS_H
+//#include <objbase.h>
+//#endif
+//
+//#endif /* DIJ_RINGZERO */
+//
+//#ifdef __cplusplus
+//extern "C" {
+//#endif
+//
+//
+//#pragma region Desktop Family
+//#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP)
+
+
+
+
+
+(*
+ *  To build applications for older versions of DirectInput
+ *
+ *  #define DIRECTINPUT_VERSION [ 0x0300 | 0x0500 | 0x0700 ]
+ *
+ *  before #include <dinput.h>.  By default, #include <dinput.h>
+ *  will produce a DirectX 8-compatible header file.
+ *
+ *)
+
+{$DEFINE DIRECTINPUT_HEADER_VERSION:=$0800}
+{$IFNDEF DIRECTINPUT_VERSION}
+{$DEFINE DIRECTINPUT_VERSION:=DIRECTINPUT_HEADER_VERSION}
+//#pragma message(__FILE__ ": DIRECTINPUT_VERSION undefined. Defaulting to version 0x0800")
+{$ENDIF}
+
+//#ifndef DIJ_RINGZERO
+
+(****************************************************************************
+ *
+ *      Class IDs
+ *
+ ****************************************************************************)
+
+const
+  CLSID_DirectInput       : TGuid = '{25E609E0-B259-11CF-BFC7-444553540000}';
+  CLSID_DirectInputDevice : TGuid = '{25E609E1-B259-11CF-BFC7-444553540000}';
+
+  CLSID_DirectInput8      : TGuid = '{25E609E4-B259-11CF-BFC7-444553540000}';
+  CLSID_DirectInputDevice8: TGuid = '{25E609E5-B259-11CF-BFC7-444553540000}';
+
+(****************************************************************************
+ *
+ *      Interfaces
+ *
+ ****************************************************************************)
+
+  IID_IDirectInputA       : TIID = '{89521360-AA8A-11CF-BFC7-444553540000}';
+  IID_IDirectInputW       : TIID = '{89521361-AA8A-11CF-BFC7-444553540000}';
+  IID_IDirectInput2A      : TIID = '{5944E662-AA8A-11CF-BFC7-444553540000}';
+  IID_IDirectInput2W      : TIID = '{5944E663-AA8A-11CF-BFC7-444553540000}';
+  IID_IDirectInput7A      : TIID = '{9A4CB684-236D-11D3-8E9D-00C04F6844AE}';
+  IID_IDirectInput7W      : TIID = '{9A4CB685-236D-11D3-8E9D-00C04F6844AE}';
+  IID_IDirectInput8A      : TIID = '{BF798030-483A-4DA2-AA99-5D64ED369700}';
+  IID_IDirectInput8W      : TIID = '{BF798031-483A-4DA2-AA99-5D64ED369700}';
+  IID_IDirectInputDeviceA : TIID = '{5944E680-C92E-11CF-BFC7-444553540000}';
+  IID_IDirectInputDeviceW : TIID = '{5944E681-C92E-11CF-BFC7-444553540000}';
+  IID_IDirectInputDevice2A: TIID = '{5944E682-C92E-11CF-BFC7-444553540000}';
+  IID_IDirectInputDevice2W: TIID = '{5944E683-C92E-11CF-BFC7-444553540000}';
+  IID_IDirectInputDevice7A: TIID = '{57D7C6BC-2356-11D3-8E9D-00C04F6844AE}';
+  IID_IDirectInputDevice7W: TIID = '{57D7C6BD-2356-11D3-8E9D-00C04F6844AE}';
+  IID_IDirectInputDevice8A: TIID = '{54D41080-DC15-4833-A41B-748F73A38179}';
+  IID_IDirectInputDevice8W: TIID = '{54D41081-DC15-4833-A41B-748F73A38179}';
+  IID_IDirectInputEffect  : TIID = '{E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35}';
+
+(****************************************************************************
+ *
+ *      Predefined object types
+ *
+ ****************************************************************************)
+
+  GUID_XAxis  : TGuid = '{A36D02E0-C9F3-11CF-BFC7-444553540000}';
+  GUID_YAxis  : TGuid = '{A36D02E1-C9F3-11CF-BFC7-444553540000}';
+  GUID_ZAxis  : TGuid = '{A36D02E2-C9F3-11CF-BFC7-444553540000}';
+  GUID_RxAxis : TGuid = '{A36D02F4-C9F3-11CF-BFC7-444553540000}';
+  GUID_RyAxis : TGuid = '{A36D02F5-C9F3-11CF-BFC7-444553540000}';
+  GUID_RzAxis : TGuid = '{A36D02E3-C9F3-11CF-BFC7-444553540000}';
+  GUID_Slider : TGuid = '{A36D02E4-C9F3-11CF-BFC7-444553540000}';
+
+  GUID_Button : TGuid = '{A36D02F0-C9F3-11CF-BFC7-444553540000}';
+  GUID_Key    : TGuid = '{55728220-D33C-11CF-BFC7-444553540000}';
+
+  GUID_POV    : TGuid = '{A36D02F2-C9F3-11CF-BFC7-444553540000}';
+
+  GUID_Unknown: TGuid = '{A36D02F3-C9F3-11CF-BFC7-444553540000}';
+
+(****************************************************************************
+ *
+ *      Predefined product GUIDs
+ *
+ ****************************************************************************)
+
+  GUID_SysMouse      : TGuid = '{6F1D2B60-D5A0-11CF-BFC7-444553540000}';
+  GUID_SysKeyboard   : TGuid = '{6F1D2B61-D5A0-11CF-BFC7-444553540000}';
+  GUID_Joystick      : TGuid = '{6F1D2B70-D5A0-11CF-BFC7-444553540000}';
+  GUID_SysMouseEm    : TGuid = '{6F1D2B80-D5A0-11CF-BFC7-444553540000}';
+  GUID_SysMouseEm2   : TGuid = '{6F1D2B81-D5A0-11CF-BFC7-444553540000}';
+  GUID_SysKeyboardEm : TGuid = '{6F1D2B82-D5A0-11CF-BFC7-444553540000}';
+  GUID_SysKeyboardEm2: TGuid = '{6F1D2B83-D5A0-11CF-BFC7-444553540000}';
+
+(****************************************************************************
+ *
+ *      Predefined force feedback effects
+ *
+ ****************************************************************************)
+
+  GUID_ConstantForce: TGuid = '{13541C20-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_RampForce    : TGuid = '{13541C21-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Square       : TGuid = '{13541C22-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Sine         : TGuid = '{13541C23-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Triangle     : TGuid = '{13541C24-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_SawtoothUp   : TGuid = '{13541C25-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_SawtoothDown : TGuid = '{13541C26-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Spring       : TGuid = '{13541C27-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Damper       : TGuid = '{13541C28-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Inertia      : TGuid = '{13541C29-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_Friction     : TGuid = '{13541C2A-8E33-11D0-9AD0-00A0C9A06E35}';
+  GUID_CustomForce  : TGuid = '{13541C2B-8E33-11D0-9AD0-00A0C9A06E35}';
+
+//#endif /* DIJ_RINGZERO */
+
+(****************************************************************************
+ *
+ *      Interfaces and Structures...
+ *
+ ****************************************************************************)
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+
+(****************************************************************************
+ *
+ *      IDirectInputEffect
+ *
+ ****************************************************************************)
+
+  DIEFT_ALL                = $00000000;
+
+  DIEFT_CONSTANTFORCE      = $00000001;
+  DIEFT_RAMPFORCE          = $00000002;
+  DIEFT_PERIODIC           = $00000003;
+  DIEFT_CONDITION          = $00000004;
+  DIEFT_CUSTOMFORCE        = $00000005;
+  DIEFT_HARDWARE           = $000000FF;
+  DIEFT_FFATTACK           = $00000200;
+  DIEFT_FFFADE             = $00000400;
+  DIEFT_SATURATION         = $00000800;
+  DIEFT_POSNEGCOEFFICIENTS = $00001000;
+  DIEFT_POSNEGSATURATION   = $00002000;
+  DIEFT_DEADBAND           = $00004000;
+  DIEFT_STARTDELAY         = $00008000;
+//#define DIEFT_GETTYPE(n)            LOBYTE(n)
+type
+  DIEFT_GETTYPE            = byte;
+
+const
+  DI_DEGREES               = 100;
+  DI_FFNOMINALMAX          = 10000;
+  DI_SECONDS               = 1000000;
+
+type
+  LPCDICONSTANTFORCE = ^TDICONSTANTFORCE;
+  PCDICONSTANTFORCE = ^TDICONSTANTFORCE;
+  LPDICONSTANTFORCE = ^TDICONSTANTFORCE;
+  PDICONSTANTFORCE = ^TDICONSTANTFORCE;
+  TDICONSTANTFORCE = record
+    lMagnitude: LONG;
+  end;
+
+  LPCDIRAMPFORCE = ^TDIRAMPFORCE;
+  PCDIRAMPFORCE = ^TDIRAMPFORCE;
+  LPDIRAMPFORCE = ^TDIRAMPFORCE;
+  PDIRAMPFORCE = ^TDIRAMPFORCE;
+  TDIRAMPFORCE = record
+    lStart: LONG;
+    lEnd  : LONG;
+  end;
+
+  LPCDIPERIODIC = ^TDIPERIODIC;
+  PCDIPERIODIC = ^TDIPERIODIC;
+  LPDIPERIODIC = ^TDIPERIODIC;
+  PDIPERIODIC = ^TDIPERIODIC;
+  TDIPERIODIC = record
+    dwMagnitude: DWORD;
+    lOffset: LONG;
+    dwPhase: DWORD;
+    dwPeriod: DWORD;
+  end;
+
+  LPCDICONDITION = ^TDICONDITION;
+  PCDICONDITION = ^TDICONDITION;
+  LPDICONDITION = ^TDICONDITION;
+  PDICONDITION = ^TDICONDITION;
+  TDICONDITION = record
+    lOffset: LONG;
+    lPositiveCoefficient: LONG;
+    lNegativeCoefficient: LONG;
+    dwPositiveSaturation: DWORD;
+    dwNegativeSaturation: DWORD;
+    lDeadBand: LONG;
+  end;
+
+  LPCDICUSTOMFORCE = ^TDICUSTOMFORCE;
+  PCDICUSTOMFORCE = ^TDICUSTOMFORCE;
+  LPDICUSTOMFORCE = ^TDICUSTOMFORCE;
+  PDICUSTOMFORCE = ^TDICUSTOMFORCE;
+  TDICUSTOMFORCE = record
+    cChannels: DWORD;
+    dwSamplePeriod: DWORD;
+    cSamples: DWORD;
+    rglForceData: LPLONG
+  end;
+
+
+  LPCDIENVELOPE = ^TDIENVELOPE;
+  PCDIENVELOPE = ^TDIENVELOPE;
+  LPDIENVELOPE = ^TDIENVELOPE;
+  PDIENVELOPE = ^TDIENVELOPE;
+  TDIENVELOPE = record
+    dwSize: DWORD;            { sizeof(DIENVELOPE)   }
+    dwAttackLevel: DWORD;
+    dwAttackTime: DWORD;      { Microseconds         }
+    dwFadeLevel: DWORD;
+    dwFadeTime: DWORD;        { Microseconds         }
+  end;
+
+
+{ This structure is defined for DirectX 5.0 compatibility }
+  LPCDIEFFECT_DX5 = ^TDIEFFECT_DX5;
+  PCDIEFFECT_DX5 = ^TDIEFFECT_DX5;
+  LPDIEFFECT_DX5 = ^TDIEFFECT_DX5;
+  PDIEFFECT_DX5 = ^TDIEFFECT_DX5;
+  TDIEFFECT_DX5 = record
+    dwSize: DWORD;                   { sizeof(DIEFFECT_DX5) }
+    dwFlags: DWORD;                  { DIEFF_*              }
+    dwDuration: DWORD;               { Microseconds         }
+    dwSamplePeriod: DWORD;           { Microseconds         }
+    dwGain: DWORD;
+    dwTriggerButton: DWORD;          { or DIEB_NOTRIGGER    }
+    dwTriggerRepeatInterval: DWORD;  { Microseconds         }
+    cAxes: DWORD;                    { Number of axes       }
+    rgdwAxes: LPDWORD;               { Array of axes        }
+    rglDirection: LPLONG;            { Array of directions  }
+    lpEnvelope: LPDIENVELOPE;        { Optional             }
+    cbTypeSpecificParams: DWORD;     { Size of params       }
+    lpvTypeSpecificParams: LPVOID;   { Pointer to params    }
+  end;
+
+  LPCDIEFFECT = ^TDIEFFECT;
+  PCDIEFFECT = ^TDIEFFECT;
+  LPDIEFFECT = ^TDIEFFECT;
+  PDIEFFECT = ^TDIEFFECT;
+  TDIEFFECT = record
+    dwSize: DWORD;                   { sizeof(DIEFFECT)     }
+    dwFlags: DWORD;                  { DIEFF_*              }
+    dwDuration: DWORD;               { Microseconds         }
+    dwSamplePeriod: DWORD;           { Microseconds         }
+    dwGain: DWORD;
+    dwTriggerButton: DWORD;          { or DIEB_NOTRIGGER    }
+    dwTriggerRepeatInterval: DWORD;  { Microseconds         }
+    cAxes: DWORD;                    { Number of axes       }
+    rgdwAxes: LPDWORD;               { Array of axes        }
+    rglDirection: LPLONG;            { Array of directions  }
+    lpEnvelope: LPDIENVELOPE;        { Optional             }
+    cbTypeSpecificParams: DWORD;     { Size of params       }
+    lpvTypeSpecificParams: LPVOID;   { Pointer to params    }
+{$IF DIRECTINPUT_VERSION >= $0600}
+    dwStartDelay: DWORD;             { Microseconds         }
+{$ENDIF} { DIRECTINPUT_VERSION >= $0600 }
+  end;
+  LPDIEFFECT_DX6 = LPDIEFFECT;
+  TDIEFFECT_DX6 = TDIEFFECT;
+
+
+{$IF DIRECTINPUT_VERSION >= $0700}
+//#ifndef DIJ_RINGZERO
+  LPCDIFILEEFFECT= ^TDIFILEEFFECT;
+  PCDIFILEEFFECT= ^TDIFILEEFFECT;
+  LPDIFILEEFFECT = ^TDIFILEEFFECT;
+  PDIFILEEFFECT = ^TDIFILEEFFECT;
+  TDIFILEEFFECT = record
+    dwSize: DWORD;
+    GuidEffect: GUID;
+    lpDiEffect: LPCDIEFFECT;
+    szFriendlyName: array [0..MAX_PATH-1] of CHAR;
+  end;
+//typedef BOOL (FAR PASCAL * LPDIENUMEFFECTSINFILECALLBACK)(LPCDIFILEEFFECT , LPVOID);
+  LPDIENUMEFFECTSINFILECALLBACK = function(lpDiFileEf: LPCDIFILEEFFECT; pvRef: LPVOID): BOOL; stdcall;
+//#endif /* DIJ_RINGZERO */
+{$ENDIF} { DIRECTINPUT_VERSION >= $0700 }
+
+const
+  DIEFF_OBJECTIDS             = $00000001;
+  DIEFF_OBJECTOFFSETS         = $00000002;
+  DIEFF_CARTESIAN             = $00000010;
+  DIEFF_POLAR                 = $00000020;
+  DIEFF_SPHERICAL             = $00000040;
+
+  DIEP_DURATION               = $00000001;
+  DIEP_SAMPLEPERIOD           = $00000002;
+  DIEP_GAIN                   = $00000004;
+  DIEP_TRIGGERBUTTON          = $00000008;
+  DIEP_TRIGGERREPEATINTERVAL  = $00000010;
+  DIEP_AXES                   = $00000020;
+  DIEP_DIRECTION              = $00000040;
+  DIEP_ENVELOPE               = $00000080;
+  DIEP_TYPESPECIFICPARAMS     = $00000100;
+{$IF DIRECTINPUT_VERSION >= 0x0600}
+  DIEP_STARTDELAY             = $00000200;
+  DIEP_ALLPARAMS_DX5          = $000001FF;
+  DIEP_ALLPARAMS              = $000003FF;
+{$ELSE} { DIRECTINPUT_VERSION < 0x0600 }
+  DIEP_ALLPARAMS              = $000001FF;
+{$ENDIF} { DIRECTINPUT_VERSION < 0x0600 }
+  DIEP_START                  = $20000000;
+  DIEP_NORESTART              = $40000000;
+  DIEP_NODOWNLOAD             = $80000000;
+  DIEB_NOTRIGGER              = $FFFFFFFF;
+
+  DIES_SOLO                   = $00000001;
+  DIES_NODOWNLOAD             = $80000000;
+
+  DIEGES_PLAYING              = $00000001;
+  DIEGES_EMULATED             = $00000002;
+
+type
+  LPDIEFFESCAPE = ^TDIEFFESCAPE;
+  PDIEFFESCAPE = ^TDIEFFESCAPE;
+  TDIEFFESCAPE = record
+    dwSize: DWORD;
+    dwCommand: DWORD;
+    lpvInBuffer: LPVOID;
+    cbInBuffer: DWORD;
+    lpvOutBuffer: LPVOID;
+    cbOutBuffer: DWORD;
+  end;
+
+//#ifndef DIJ_RINGZERO
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputEffect
+
+//DECLARE_INTERFACE_(IDirectInputEffect, IUnknown)
+type
+  IDirectInputEffect = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputEffect methods ***)
+    function Initialize(hinst: HINST; dwVersion: DWORD; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function GetEffectGuid(pguid: LPGUID): HRESULT; stdcall;
+    function GetParameters(peff: LPDIEFFECT; dwFlags: DWORD): HRESULT; stdcall;
+    function SetParameters(peff: LPCDIEFFECT; dwFlags: DWORD): HRESULT; stdcall;
+    function Start(dwIterations, dwFlags: DWORD): HRESULT; stdcall;
+    function Stop: HRESULT; stdcall;
+    function GetEffectStatus(pdwFlags: LPDWORD): HRESULT; stdcall;
+    function Download: HRESULT; stdcall;
+    function Unload: HRESULT; stdcall;
+    function Escape(pesc: LPDIEFFESCAPE): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputEffect *LPDIRECTINPUTEFFECT;
+  LPDIRECTINPUTEFFECT = IDirectInputEffect;
+
+{#if !defined(__cplusplus) || defined(CINTERFACE)
+#define IDirectInputEffect_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+#define IDirectInputEffect_AddRef(p) (p)->lpVtbl->AddRef(p)
+#define IDirectInputEffect_Release(p) (p)->lpVtbl->Release(p)
+#define IDirectInputEffect_Initialize(p,a,b,c) (p)->lpVtbl->Initialize(p,a,b,c)
+#define IDirectInputEffect_GetEffectGuid(p,a) (p)->lpVtbl->GetEffectGuid(p,a)
+#define IDirectInputEffect_GetParameters(p,a,b) (p)->lpVtbl->GetParameters(p,a,b)
+#define IDirectInputEffect_SetParameters(p,a,b) (p)->lpVtbl->SetParameters(p,a,b)
+#define IDirectInputEffect_Start(p,a,b) (p)->lpVtbl->Start(p,a,b)
+#define IDirectInputEffect_Stop(p) (p)->lpVtbl->Stop(p)
+#define IDirectInputEffect_GetEffectStatus(p,a) (p)->lpVtbl->GetEffectStatus(p,a)
+#define IDirectInputEffect_Download(p) (p)->lpVtbl->Download(p)
+#define IDirectInputEffect_Unload(p) (p)->lpVtbl->Unload(p)
+#define IDirectInputEffect_Escape(p,a) (p)->lpVtbl->Escape(p,a)
+#else
+#define IDirectInputEffect_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+#define IDirectInputEffect_AddRef(p) (p)->AddRef()
+#define IDirectInputEffect_Release(p) (p)->Release()
+#define IDirectInputEffect_Initialize(p,a,b,c) (p)->Initialize(a,b,c)
+#define IDirectInputEffect_GetEffectGuid(p,a) (p)->GetEffectGuid(a)
+#define IDirectInputEffect_GetParameters(p,a,b) (p)->GetParameters(a,b)
+#define IDirectInputEffect_SetParameters(p,a,b) (p)->SetParameters(a,b)
+#define IDirectInputEffect_Start(p,a,b) (p)->Start(a,b)
+#define IDirectInputEffect_Stop(p) (p)->Stop()
+#define IDirectInputEffect_GetEffectStatus(p,a) (p)->GetEffectStatus(a)
+#define IDirectInputEffect_Download(p) (p)->Download()
+#define IDirectInputEffect_Unload(p) (p)->Unload()
+#define IDirectInputEffect_Escape(p,a) (p)->Escape(a)
+#endif}
+
+//#endif /* DIJ_RINGZERO */
+
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+
+(****************************************************************************
+ *
+ *      IDirectInputDevice
+ *
+ ****************************************************************************)
+
+{$IF DIRECTINPUT_VERSION <= $700}
+const
+  DIDEVTYPE_DEVICE   = 1;
+  DIDEVTYPE_MOUSE    = 2;
+  DIDEVTYPE_KEYBOARD = 3;
+  DIDEVTYPE_JOYSTICK = 4;
+
+{$ELSE}
+const
+  DI8DEVCLASS_ALL          = 0;
+  DI8DEVCLASS_DEVICE       = 1;
+  DI8DEVCLASS_POINTER      = 2;
+  DI8DEVCLASS_KEYBOARD     = 3;
+  DI8DEVCLASS_GAMECTRL     = 4;
+
+  DI8DEVTYPE_DEVICE        = $11;
+  DI8DEVTYPE_MOUSE         = $12;
+  DI8DEVTYPE_KEYBOARD      = $13;
+  DI8DEVTYPE_JOYSTICK      = $14;
+  DI8DEVTYPE_GAMEPAD       = $15;
+  DI8DEVTYPE_DRIVING       = $16;
+  DI8DEVTYPE_FLIGHT        = $17;
+  DI8DEVTYPE_1STPERSON     = $18;
+  DI8DEVTYPE_DEVICECTRL    = $19;
+  DI8DEVTYPE_SCREENPOINTER = $1A;
+  DI8DEVTYPE_REMOTE        = $1B;
+  DI8DEVTYPE_SUPPLEMENTAL  = $1C;
+{$ENDIF} { DIRECTINPUT_VERSION <= 0x700 }
+
+const
+  DIDEVTYPE_HID            = $00010000;
+
+{$IF DIRECTINPUT_VERSION <= $700}
+const
+  DIDEVTYPEMOUSE_UNKNOWN        = 1;
+  DIDEVTYPEMOUSE_TRADITIONAL    = 2;
+  DIDEVTYPEMOUSE_FINGERSTICK    = 3;
+  DIDEVTYPEMOUSE_TOUCHPAD       = 4;
+  DIDEVTYPEMOUSE_TRACKBALL      = 5;
+
+  DIDEVTYPEKEYBOARD_UNKNOWN     =  0;
+  DIDEVTYPEKEYBOARD_PCXT        =  1;
+  DIDEVTYPEKEYBOARD_OLIVETTI    =  2;
+  DIDEVTYPEKEYBOARD_PCAT        =  3;
+  DIDEVTYPEKEYBOARD_PCENH       =  4;
+  DIDEVTYPEKEYBOARD_NOKIA1050   =  5;
+  DIDEVTYPEKEYBOARD_NOKIA9140   =  6;
+  DIDEVTYPEKEYBOARD_NEC98       =  7;
+  DIDEVTYPEKEYBOARD_NEC98LAPTOP =  8;
+  DIDEVTYPEKEYBOARD_NEC98106    =  9;
+  DIDEVTYPEKEYBOARD_JAPAN106    = 10;
+  DIDEVTYPEKEYBOARD_JAPANAX     = 11;
+  DIDEVTYPEKEYBOARD_J3100       = 12;
+
+  DIDEVTYPEJOYSTICK_UNKNOWN     = 1;
+  DIDEVTYPEJOYSTICK_TRADITIONAL = 2;
+  DIDEVTYPEJOYSTICK_FLIGHTSTICK = 3;
+  DIDEVTYPEJOYSTICK_GAMEPAD     = 4;
+  DIDEVTYPEJOYSTICK_RUDDER      = 5;
+  DIDEVTYPEJOYSTICK_WHEEL       = 6;
+  DIDEVTYPEJOYSTICK_HEADTRACKER = 7;
+
+{$ELSE}
+const
+  DI8DEVTYPEMOUSE_UNKNOWN                       = 1;
+  DI8DEVTYPEMOUSE_TRADITIONAL                   = 2;
+  DI8DEVTYPEMOUSE_FINGERSTICK                   = 3;
+  DI8DEVTYPEMOUSE_TOUCHPAD                      = 4;
+  DI8DEVTYPEMOUSE_TRACKBALL                     = 5;
+  DI8DEVTYPEMOUSE_ABSOLUTE                      = 6;
+
+  DI8DEVTYPEKEYBOARD_UNKNOWN                    =  0;
+  DI8DEVTYPEKEYBOARD_PCXT                       =  1;
+  DI8DEVTYPEKEYBOARD_OLIVETTI                   =  2;
+  DI8DEVTYPEKEYBOARD_PCAT                       =  3;
+  DI8DEVTYPEKEYBOARD_PCENH                      =  4;
+  DI8DEVTYPEKEYBOARD_NOKIA1050                  =  5;
+  DI8DEVTYPEKEYBOARD_NOKIA9140                  =  6;
+  DI8DEVTYPEKEYBOARD_NEC98                      =  7;
+  DI8DEVTYPEKEYBOARD_NEC98LAPTOP                =  8;
+  DI8DEVTYPEKEYBOARD_NEC98106                   =  9;
+  DI8DEVTYPEKEYBOARD_JAPAN106                   = 10;
+  DI8DEVTYPEKEYBOARD_JAPANAX                    = 11;
+  DI8DEVTYPEKEYBOARD_J3100                      = 12;
+
+  DI8DEVTYPE_LIMITEDGAMESUBTYPE                 = 1;
+
+  DI8DEVTYPEJOYSTICK_LIMITED                    = DI8DEVTYPE_LIMITEDGAMESUBTYPE;
+  DI8DEVTYPEJOYSTICK_STANDARD                   = 2;
+
+  DI8DEVTYPEGAMEPAD_LIMITED                     = DI8DEVTYPE_LIMITEDGAMESUBTYPE;
+  DI8DEVTYPEGAMEPAD_STANDARD                    = 2;
+  DI8DEVTYPEGAMEPAD_TILT                        = 3;
+
+  DI8DEVTYPEDRIVING_LIMITED                     = DI8DEVTYPE_LIMITEDGAMESUBTYPE;
+  DI8DEVTYPEDRIVING_COMBINEDPEDALS              = 2;
+  DI8DEVTYPEDRIVING_DUALPEDALS                  = 3;
+  DI8DEVTYPEDRIVING_THREEPEDALS                 = 4;
+  DI8DEVTYPEDRIVING_HANDHELD                    = 5;
+
+  DI8DEVTYPEFLIGHT_LIMITED                      = DI8DEVTYPE_LIMITEDGAMESUBTYPE;
+  DI8DEVTYPEFLIGHT_STICK                        = 2;
+  DI8DEVTYPEFLIGHT_YOKE                         = 3;
+  DI8DEVTYPEFLIGHT_RC                           = 4;
+
+  DI8DEVTYPE1STPERSON_LIMITED                   = DI8DEVTYPE_LIMITEDGAMESUBTYPE;
+  DI8DEVTYPE1STPERSON_UNKNOWN                   = 2;
+  DI8DEVTYPE1STPERSON_SIXDOF                    = 3;
+  DI8DEVTYPE1STPERSON_SHOOTER                   = 4;
+
+  DI8DEVTYPESCREENPTR_UNKNOWN                   = 2;
+  DI8DEVTYPESCREENPTR_LIGHTGUN                  = 3;
+  DI8DEVTYPESCREENPTR_LIGHTPEN                  = 4;
+  DI8DEVTYPESCREENPTR_TOUCH                     = 5;
+
+  DI8DEVTYPEREMOTE_UNKNOWN                      = 2;
+
+  DI8DEVTYPEDEVICECTRL_UNKNOWN                  = 2;
+  DI8DEVTYPEDEVICECTRL_COMMSSELECTION           = 3;
+  DI8DEVTYPEDEVICECTRL_COMMSSELECTION_HARDWIRED = 4;
+
+  DI8DEVTYPESUPPLEMENTAL_UNKNOWN                =  2;
+  DI8DEVTYPESUPPLEMENTAL_2NDHANDCONTROLLER      =  3;
+  DI8DEVTYPESUPPLEMENTAL_HEADTRACKER            =  4;
+  DI8DEVTYPESUPPLEMENTAL_HANDTRACKER            =  5;
+  DI8DEVTYPESUPPLEMENTAL_SHIFTSTICKGATE         =  6;
+  DI8DEVTYPESUPPLEMENTAL_SHIFTER                =  7;
+  DI8DEVTYPESUPPLEMENTAL_THROTTLE               =  8;
+  DI8DEVTYPESUPPLEMENTAL_SPLITTHROTTLE          =  9;
+  DI8DEVTYPESUPPLEMENTAL_COMBINEDPEDALS         = 10;
+  DI8DEVTYPESUPPLEMENTAL_DUALPEDALS             = 11;
+  DI8DEVTYPESUPPLEMENTAL_THREEPEDALS            = 12;
+  DI8DEVTYPESUPPLEMENTAL_RUDDERPEDALS           = 13;
+{$ENDIF} { DIRECTINPUT_VERSION <= $700 }
+
+//#define GET_DIDEVICE_TYPE(dwDevType)    LOBYTE(dwDevType)
+type
+  GET_DIDEVICE_TYPE = byte;
+//#define GET_DIDEVICE_SUBTYPE(dwDevType) HIBYTE(dwDevType)
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+{ This structure is defined for DirectX 3.0 compatibility }
+type
+  LPDIDEVCAPS_DX3 = ^TDIDEVCAPS_DX3;
+  PDIDEVCAPS_DX3 = ^TDIDEVCAPS_DX3;
+  TDIDEVCAPS_DX3 = record
+    dwSize: DWORD;
+    dwFlags: DWORD;
+    dwDevType: DWORD;
+    dwAxes: DWORD;
+    dwButtons: DWORD;
+    dwPOVs: DWORD;
+  end;
+{$ENDIF} { DIRECTINPUT_VERSION >= 0x0500 }
+
+  LPDIDEVCAPS = ^TDIDEVCAPS;
+  PDIDEVCAPS = ^TDIDEVCAPS;
+  TDIDEVCAPS = record
+    dwSize: DWORD;
+    dwFlags: DWORD;
+    dwDevType: DWORD;
+    dwAxes: DWORD;
+    dwButtons: DWORD;
+    dwPOVs: DWORD;
+{$IF DIRECTINPUT_VERSION >= $0500}
+    dwFFSamplePeriod: DWORD;
+    dwFFMinTimeResolution: DWORD;
+    dwFirmwareRevision: DWORD;
+    dwHardwareRevision: DWORD;
+    dwFFDriverVersion: DWORD;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+  end;
+
+const
+  DIDC_ATTACHED           = $00000001;
+  DIDC_POLLEDDEVICE       = $00000002;
+  DIDC_EMULATED           = $00000004;
+  DIDC_POLLEDDATAFORMAT   = $00000008;
+{$IF DIRECTINPUT_VERSION >= $0500}
+  DIDC_FORCEFEEDBACK      = $00000100;
+  DIDC_FFATTACK           = $00000200;
+  DIDC_FFFADE             = $00000400;
+  DIDC_SATURATION         = $00000800;
+  DIDC_POSNEGCOEFFICIENTS = $00001000;
+  DIDC_POSNEGSATURATION   = $00002000;
+  DIDC_DEADBAND           = $00004000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+  DIDC_STARTDELAY         = $00008000;
+{$IF DIRECTINPUT_VERSION >= $050a}
+  DIDC_ALIAS              = $00010000;
+  DIDC_PHANTOM            = $00020000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+{$IF DIRECTINPUT_VERSION >= $0800}
+  DIDC_HIDDEN             = $00040000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+  DIDFT_ALL             = $00000000;
+
+  DIDFT_RELAXIS         = $00000001;
+  DIDFT_ABSAXIS         = $00000002;
+  DIDFT_AXIS            = $00000003;
+
+  DIDFT_PSHBUTTON       = $00000004;
+  DIDFT_TGLBUTTON       = $00000008;
+  DIDFT_BUTTON          = $0000000C;
+
+  DIDFT_POV             = $00000010;
+  DIDFT_COLLECTION      = $00000040;
+  DIDFT_NODATA          = $00000080;
+
+  DIDFT_ANYINSTANCE     = $00FFFF00;
+  DIDFT_INSTANCEMASK    = DIDFT_ANYINSTANCE;
+  //DIDFT_MAKEINSTANCE(n) ((WORD)(n) << 8)
+  //DIDFT_GETTYPE(n)     LOBYTE(n)
+type
+  DIDFT_GETTYPE = byte;
+  //DIDFT_GETINSTANCE(n) LOWORD((n) >> 8)
+const
+  DIDFT_FFACTUATOR      = $01000000;
+  DIDFT_FFEFFECTTRIGGER = $02000000;
+{$IF DIRECTINPUT_VERSION >= $050a}
+  DIDFT_OUTPUT          = $10000000;
+  DIDFT_VENDORDEFINED   = $04000000;
+  DIDFT_ALIAS           = $08000000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+
+//  DIDFT_ENUMCOLLECTION(n) ((WORD)(n) << 8)
+  DIDFT_NOCOLLECTION      = $00FFFF00;
+
+//#ifndef DIJ_RINGZERO
+
+type
+  LPCDIOBJECTDATAFORMAT = ^TDIOBJECTDATAFORMAT;
+  PCDIOBJECTDATAFORMAT = ^TDIOBJECTDATAFORMAT;
+  LPDIOBJECTDATAFORMAT = ^TDIOBJECTDATAFORMAT;
+  PDIOBJECTDATAFORMAT = ^TDIOBJECTDATAFORMAT;
+  TDIOBJECTDATAFORMAT = record
+    pguid: PGuid; {const GUID *}
+    dwOfs: DWORD;
+    dwType: DWORD;
+    dwFlags: DWORD;
+  end;
+
+  LPCDIDATAFORMAT = ^TDIDATAFORMAT;
+  PCDIDATAFORMAT = ^TDIDATAFORMAT;
+  LPDIDATAFORMAT = ^TDIDATAFORMAT;
+  PDIDATAFORMAT = ^TDIDATAFORMAT;
+  TDIDATAFORMAT = record
+    dwSize: DWORD;
+    dwObjSize: DWORD;
+    dwFlags: DWORD;
+    dwDataSize: DWORD;
+    dwNumObjs: DWORD;
+    rgodf: LPDIOBJECTDATAFORMAT;
+  end;
+
+const
+  DIDF_ABSAXIS = $00000001;
+  DIDF_RELAXIS = $00000002;
+
+//#ifdef __cplusplus
+//extern "C" {
+//#endif
+//extern const DIDATAFORMAT c_dfDIMouse;
+var
+  c_dfDIMouse: TDIDATAFORMAT; cvar; external;
+
+{$IF DIRECTINPUT_VERSION >= $0700}
+//extern const DIDATAFORMAT c_dfDIMouse2;
+  c_dfDIMouse2: TDIDATAFORMAT; cvar; external;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0700 }
+
+//extern const DIDATAFORMAT c_dfDIKeyboard;
+  c_dfDIKeyboard: TDIDATAFORMAT; cvar; external;
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+//extern const DIDATAFORMAT c_dfDIJoystick;
+  c_dfDIJoystick: TDIDATAFORMAT; cvar; external;
+//extern const DIDATAFORMAT c_dfDIJoystick2;
+  c_dfDIJoystick2: TDIDATAFORMAT; cvar; external;
+{$ENDIF} { DIRECTINPUT_VERSION >= 0x0500 }
+
+//#ifdef __cplusplus
+//};
+//#endif
+
+
+{$IF DIRECTINPUT_VERSION > $0700}
+
+//#pragma warning(push)
+//#pragma warning(disable:4201)   // Nameless union / struct when compiled for C.
+
+type
+  LPDIACTIONA = ^TDIACTIONA;
+  PDIACTIONA = ^TDIACTIONA;
+  TDIACTIONA = record
+    uAppData: UINT_PTR;
+    dwSemantic: DWORD;
+    dwFlags: DWORD;  {OPTIONAL}
+    case Integer of
+      0: (
+        lptszActionName: LPCSTR;  {OPTIONAL}
+        guidInstance: GUID;  {OPTIONAL}
+        dwObjID: DWORD;  {OPTIONAL}
+        dwHow: DWORD; {OPTIONAL}
+      );
+      1: (
+        uResIdString: UINT  {OPTIONAL}
+      );
+  end;
+  LPDIACTIONW = ^TDIACTIONW;
+  PDIACTIONW = ^TDIACTIONW;
+  TDIACTIONW = record
+    uAppData: UINT_PTR;
+    dwSemantic: DWORD;
+    dwFlags: DWORD;  {OPTIONAL}
+    case Integer of
+      0: (
+        lptszActionName: LPCWSTR;  {OPTIONAL}
+        guidInstance: GUID;  {OPTIONAL}
+        dwObjID: DWORD;  {OPTIONAL}
+        dwHow: DWORD; {OPTIONAL}
+      );
+      1: (
+        uResIdString: UINT;  {OPTIONAL}
+      );
+  end;
+{$IFDEF UNICODE}
+  TDIACTION = TDIACTIONW;
+  LPDIACTION = LPDIACTIONW;
+  PDIACTION = PDIACTIONW;
+{$ELSE}
+  TDIACTION = TDIACTIONA;
+  LPDIACTION = LPDIACTIONA;
+  PDIACTION = PDIACTIONA;
+{$ENDIF} // UNICODE
+
+  LPCDIACTIONA = ^TDIACTIONA;
+  PCDIACTIONA = ^TDIACTIONA;
+  LPCDIACTIONW = ^TDIACTIONW;
+  PCDIACTIONW = ^TDIACTIONW;
+{$IFDEF UNICODE}
+  LPCDIACTION = LPCDIACTIONW;
+  PCDIACTION = PCDIACTIONW;
+{$ELSE}
+  LPCDIACTION = LPCDIACTIONA;
+  PCDIACTION = PCDIACTIONA;
+{$ENDIF} // UNICODE
+
+//#pragma warning(pop)
+
+const
+  DIA_FORCEFEEDBACK = $00000001;
+  DIA_APPMAPPED     = $00000002;
+  DIA_APPNOMAP      = $00000004;
+  DIA_NORANGE       = $00000008;
+  DIA_APPFIXED      = $00000010;
+
+  DIAH_UNMAPPED     = $00000000;
+  DIAH_USERCONFIG   = $00000001;
+  DIAH_APPREQUESTED = $00000002;
+  DIAH_HWAPP        = $00000004;
+  DIAH_HWDEFAULT    = $00000008;
+  DIAH_DEFAULT      = $00000020;
+  DIAH_ERROR        = $80000000;
+
+type
+  LPDIACTIONFORMATA = ^TDIACTIONFORMATA;
+  PDIACTIONFORMATA = ^TDIACTIONFORMATA;
+  TDIACTIONFORMATA = record
+    dwSize: DWORD;
+    dwActionSize: DWORD;
+    dwDataSize: DWORD;
+    dwNumActions: DWORD;
+    rgoAction: LPDIACTIONA;
+    guidActionMap: GUID;
+    dwGenre: DWORD;
+    dwBufferSize: DWORD;
+    lAxisMin: LONG;  {OPTIONAL}
+    lAxisMax: LONG;  {OPTIONAL}
+    hInstString: HINST;  {OPTIONAL}
+    ftTimeStamp: FILETIME;
+    dwCRC: DWORD;
+    tszActionMap: array [0..MAX_PATH-1] of CHAR;
+  end;
+  LPDIACTIONFORMATW = ^TDIACTIONFORMATW;
+  PDIACTIONFORMATW = ^TDIACTIONFORMATW;
+  TDIACTIONFORMATW = record
+    dwSize: DWORD;
+    dwActionSize: DWORD;
+    dwDataSize: DWORD;
+    dwNumActions: DWORD;
+    rgoAction: LPDIACTIONW;
+    guidActionMap: GUID;
+    dwGenre: DWORD;
+    dwBufferSize: DWORD;
+    lAxisMin: LONG;  {OPTIONAL}
+    lAxisMax: LONG;  {OPTIONAL}
+    hInstString: HINST;  {OPTIONAL}
+    ftTimeStamp: FILETIME;
+    dwCRC: DWORD;
+    tszActionMap: array [0..MAX_PATH-1] of WCHAR;
+  end;
+{$IFDEF UNICODE}
+  TDIACTIONFORMAT = TDIACTIONFORMATW;
+  LPDIACTIONFORMAT = LPDIACTIONFORMATW;
+  PDIACTIONFORMAT = PDIACTIONFORMATW;
+{$ELSE}
+  TDIACTIONFORMAT = TDIACTIONFORMATA;
+  LPDIACTIONFORMAT = LPDIACTIONFORMATA;
+  PDIACTIONFORMAT = PDIACTIONFORMATA;
+{$ENDIF} // UNICODE
+  LPCDIACTIONFORMATA = ^TDIACTIONFORMATA;
+  PCDIACTIONFORMATA = ^TDIACTIONFORMATA;
+  LPCDIACTIONFORMATW = ^TDIACTIONFORMATW;
+  PCDIACTIONFORMATW = ^TDIACTIONFORMATW;
+{$IFDEF UNICODE}
+  LPCDIACTIONFORMAT = LPCDIACTIONFORMATW;
+  PCDIACTIONFORMAT = PCDIACTIONFORMATW;
+{$ELSE}
+  LPCDIACTIONFORMAT = LPCDIACTIONFORMATA;
+  PCDIACTIONFORMAT = PCDIACTIONFORMATA;
+{$ENDIF} // UNICODE
+
+const
+  DIAFTS_NEWDEVICELOW     = $FFFFFFFF;
+  DIAFTS_NEWDEVICEHIGH    = $FFFFFFFF;
+  DIAFTS_UNUSEDDEVICELOW  = $00000000;
+  DIAFTS_UNUSEDDEVICEHIGH = $00000000;
+
+  DIDBAM_DEFAULT          = $00000000;
+  DIDBAM_PRESERVE         = $00000001;
+  DIDBAM_INITIALIZE       = $00000002;
+  DIDBAM_HWDEFAULTS       = $00000004;
+
+  DIDSAM_DEFAULT          = $00000000;
+  DIDSAM_NOUSER           = $00000001;
+  DIDSAM_FORCESAVE        = $00000002;
+
+  DICD_DEFAULT            = $00000000;
+  DICD_EDIT               = $00000001;
+
+(*
+ * The following definition is normally defined in d3dtypes.h
+ *)
+{$IFNDEF D3DCOLOR_DEFINED}
+type
+  D3DCOLOR = DWORD;
+{$DEFINE D3DCOLOR_DEFINED}
+{$ENDIF}
+
+  LPCDICOLORSET = ^TDICOLORSET;
+  PCDICOLORSET = ^TDICOLORSET;
+  LPDICOLORSET = ^TDICOLORSET;
+  PDICOLORSET = ^TDICOLORSET;
+  TDICOLORSET = record
+    dwSize: DWORD;
+    cTextFore: D3DCOLOR;
+    cTextHighlight: D3DCOLOR;
+    cCalloutLine: D3DCOLOR;
+    cCalloutHighlight: D3DCOLOR;
+    cBorder: D3DCOLOR;
+    cControlFill: D3DCOLOR;
+    cHighlightFill: D3DCOLOR;
+    cAreaFill: D3DCOLOR;
+  end;
+
+
+  LPDICONFIGUREDEVICESPARAMSA = ^TDICONFIGUREDEVICESPARAMSA;
+  PDICONFIGUREDEVICESPARAMSA = ^TDICONFIGUREDEVICESPARAMSA;
+  TDICONFIGUREDEVICESPARAMSA = record
+    dwSize: DWORD;
+    dwcUsers: DWORD;
+    lptszUserNames: LPSTR;
+    dwcFormats: DWORD;
+    lprgFormats: LPDIACTIONFORMATA;
+    hwnd: HWND;
+    dics: TDICOLORSET;
+    lpUnkDDSTarget: {IUnknown FAR *}IUnknown;
+  end;
+  LPDICONFIGUREDEVICESPARAMSW = ^TDICONFIGUREDEVICESPARAMSW;
+  PDICONFIGUREDEVICESPARAMSW = ^TDICONFIGUREDEVICESPARAMSW;
+  TDICONFIGUREDEVICESPARAMSW = record
+    dwSize: DWORD;
+    dwcUsers: DWORD;
+    lptszUserNames: LPWSTR;
+    dwcFormats: DWORD;
+    lprgFormats: LPDIACTIONFORMATW;
+    hwnd: HWND;
+    dics: TDICOLORSET;
+    lpUnkDDSTarget: {IUnknown FAR *}IUnknown;
+  end;
+{$IFDEF UNICODE}
+  TDICONFIGUREDEVICESPARAMS = TDICONFIGUREDEVICESPARAMSW;
+  LPDICONFIGUREDEVICESPARAMS = LPDICONFIGUREDEVICESPARAMSW;
+  PDICONFIGUREDEVICESPARAMS = PDICONFIGUREDEVICESPARAMSW;
+{$ELSE}
+  TDICONFIGUREDEVICESPARAMS = TDICONFIGUREDEVICESPARAMSA;
+  LPDICONFIGUREDEVICESPARAMS = LPDICONFIGUREDEVICESPARAMSA;
+  PDICONFIGUREDEVICESPARAMS = PDICONFIGUREDEVICESPARAMSA;
+{$ENDIF} // UNICODE
+  LPCDICONFIGUREDEVICESPARAMSA = ^TDICONFIGUREDEVICESPARAMSA;
+  PCDICONFIGUREDEVICESPARAMSA = ^TDICONFIGUREDEVICESPARAMSA;
+  LPCDICONFIGUREDEVICESPARAMSW = ^TDICONFIGUREDEVICESPARAMSW;
+  PCDICONFIGUREDEVICESPARAMSW = ^TDICONFIGUREDEVICESPARAMSW;
+{$IFDEF UNICODE}
+  LPCDICONFIGUREDEVICESPARAMS = LPCDICONFIGUREDEVICESPARAMSW;
+  PCDICONFIGUREDEVICESPARAMS = PCDICONFIGUREDEVICESPARAMSW;
+{$ELSE}
+  LPCDICONFIGUREDEVICESPARAMS = LPCDICONFIGUREDEVICESPARAMSA;
+  PCDICONFIGUREDEVICESPARAMS = PCDICONFIGUREDEVICESPARAMSA;
+{$ENDIF} // UNICODE
+
+
+const
+  DIDIFT_CONFIGURATION = $00000001;
+  DIDIFT_OVERLAY       = $00000002;
+
+  DIDAL_CENTERED      = $00000000;
+  DIDAL_LEFTALIGNED   = $00000001;
+  DIDAL_RIGHTALIGNED  = $00000002;
+  DIDAL_MIDDLE        = $00000000;
+  DIDAL_TOPALIGNED    = $00000004;
+  DIDAL_BOTTOMALIGNED = $00000008;
+
+type
+  LPDIDEVICEIMAGEINFOA = ^TDIDEVICEIMAGEINFOA;
+  PDIDEVICEIMAGEINFOA = ^TDIDEVICEIMAGEINFOA;
+  TDIDEVICEIMAGEINFOA = record
+    tszImagePath: array [0..MAX_PATH-1] of CHAR;
+    dwFlags: DWORD;
+    // These are valid if DIDIFT_OVERLAY is present in dwFlags.
+    dwViewID: DWORD;
+    rcOverlay: RECT;
+    dwObjID: DWORD;
+    dwcValidPts: DWORD;
+    rgptCalloutLine: array [0..4] of POINT;
+    rcCalloutRect: RECT;
+    dwTextAlign: DWORD;
+  end;
+  LPDIDEVICEIMAGEINFOW = ^TDIDEVICEIMAGEINFOW;
+  PDIDEVICEIMAGEINFOW = ^TDIDEVICEIMAGEINFOW;
+  TDIDEVICEIMAGEINFOW = record
+    tszImagePath: array [0..MAX_PATH-1] of WCHAR;
+    dwFlags: DWORD;
+    // These are valid if DIDIFT_OVERLAY is present in dwFlags.
+    dwViewID: DWORD;
+    rcOverlay: RECT;
+    dwObjID: DWORD;
+    dwcValidPts: DWORD;
+    rgptCalloutLine: array [0..4] of POINT;
+    rcCalloutRect: RECT;
+    dwTextAlign: DWORD;
+  end;
+{$IFDEF UNICODE}
+  TDIDEVICEIMAGEINFO = TDIDEVICEIMAGEINFOW;
+  LPDIDEVICEIMAGEINFO = LPDIDEVICEIMAGEINFOW;
+  PDIDEVICEIMAGEINFO = PDIDEVICEIMAGEINFOW;
+{$ELSE}
+  TDIDEVICEIMAGEINFO = TDIDEVICEIMAGEINFOA;
+  LPDIDEVICEIMAGEINFO = LPDIDEVICEIMAGEINFOA;
+  PDIDEVICEIMAGEINFO = PDIDEVICEIMAGEINFOA;
+{$ENDIF} // UNICODE
+  LPCDIDEVICEIMAGEINFOA = ^TDIDEVICEIMAGEINFOA;
+  PCDIDEVICEIMAGEINFOA = ^TDIDEVICEIMAGEINFOA;
+  LPCDIDEVICEIMAGEINFOW = ^TDIDEVICEIMAGEINFOW;
+  PCDIDEVICEIMAGEINFOW = ^TDIDEVICEIMAGEINFOW;
+{$IFDEF UNICODE}
+  LPCDIDEVICEIMAGEINFO = LPCDIDEVICEIMAGEINFOW;
+  PCDIDEVICEIMAGEINFO = PCDIDEVICEIMAGEINFOW;
+{$ELSE}
+  LPCDIDEVICEIMAGEINFO = LPCDIDEVICEIMAGEINFOA;
+  PCDIDEVICEIMAGEINFO = PCDIDEVICEIMAGEINFOA;
+{$ENDIF} // UNICODE
+
+  LPDIDEVICEIMAGEINFOHEADERA = ^TDIDEVICEIMAGEINFOHEADERA;
+  PDIDEVICEIMAGEINFOHEADERA = ^TDIDEVICEIMAGEINFOHEADERA;
+  TDIDEVICEIMAGEINFOHEADERA = record
+    dwSize: DWORD;
+    dwSizeImageInfo: DWORD;
+    dwcViews: DWORD;
+    dwcButtons: DWORD;
+    dwcAxes: DWORD;
+    dwcPOVs: DWORD;
+    dwBufferSize: DWORD;
+    dwBufferUsed: DWORD;
+    lprgImageInfoArray: LPDIDEVICEIMAGEINFOA;
+  end;
+  LPDIDEVICEIMAGEINFOHEADERW = ^TDIDEVICEIMAGEINFOHEADERW;
+  PDIDEVICEIMAGEINFOHEADERW = ^TDIDEVICEIMAGEINFOHEADERW;
+  TDIDEVICEIMAGEINFOHEADERW = record
+    dwSize: DWORD;
+    dwSizeImageInfo: DWORD;
+    dwcViews: DWORD;
+    dwcButtons: DWORD;
+    dwcAxes: DWORD;
+    dwcPOVs: DWORD;
+    dwBufferSize: DWORD;
+    dwBufferUsed: DWORD;
+    lprgImageInfoArray: LPDIDEVICEIMAGEINFOW;
+  end;
+{$IFDEF UNICODE}
+  TDIDEVICEIMAGEINFOHEADER = TDIDEVICEIMAGEINFOHEADERW;
+  LPDIDEVICEIMAGEINFOHEADER = LPDIDEVICEIMAGEINFOHEADERW;
+  PDIDEVICEIMAGEINFOHEADER = PDIDEVICEIMAGEINFOHEADERW;
+{$ELSE}
+  TDIDEVICEIMAGEINFOHEADER = TDIDEVICEIMAGEINFOHEADERA;
+  LPDIDEVICEIMAGEINFOHEADER = LPDIDEVICEIMAGEINFOHEADERA;
+  PDIDEVICEIMAGEINFOHEADER = PDIDEVICEIMAGEINFOHEADERA;
+{$ENDIF} // UNICODE
+  LPCDIDEVICEIMAGEINFOHEADERA = ^TDIDEVICEIMAGEINFOHEADERA;
+  PCDIDEVICEIMAGEINFOHEADERA = ^TDIDEVICEIMAGEINFOHEADERA;
+  LPCDIDEVICEIMAGEINFOHEADERW = ^TDIDEVICEIMAGEINFOHEADERW;
+  PCDIDEVICEIMAGEINFOHEADERW = ^TDIDEVICEIMAGEINFOHEADERW;
+{$IFDEF UNICODE}
+  LPCDIDEVICEIMAGEINFOHEADER = LPCDIDEVICEIMAGEINFOHEADERW;
+  PCDIDEVICEIMAGEINFOHEADER = PCDIDEVICEIMAGEINFOHEADERW;
+{$ELSE}
+  LPCDIDEVICEIMAGEINFOHEADER = LPCDIDEVICEIMAGEINFOHEADERA;
+  PCDIDEVICEIMAGEINFOHEADER = PCDIDEVICEIMAGEINFOHEADERA;
+{$ENDIF} // UNICODE
+
+{$ENDIF} { DIRECTINPUT_VERSION > $0700 }
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+{ These structures are defined for DirectX 3.0 compatibility }
+
+type
+  LPDIDEVICEOBJECTINSTANCE_DX3A = ^TDIDEVICEOBJECTINSTANCE_DX3A;
+  PDIDEVICEOBJECTINSTANCE_DX3A = ^TDIDEVICEOBJECTINSTANCE_DX3A;
+  TDIDEVICEOBJECTINSTANCE_DX3A = record
+    dwSize: DWORD;
+    guidType: GUID;
+    dwOfs: DWORD;
+    dwType: DWORD;
+    dwFlags: DWORD;
+    tszName: array [0..MAX_PATH-1] of CHAR;
+  end;
+  LPDIDEVICEOBJECTINSTANCE_DX3W = ^TDIDEVICEOBJECTINSTANCE_DX3W;
+  PDIDEVICEOBJECTINSTANCE_DX3W = ^TDIDEVICEOBJECTINSTANCE_DX3W;
+  TDIDEVICEOBJECTINSTANCE_DX3W = record
+    dwSize: DWORD;
+    guidType: GUID;
+    dwOfs: DWORD;
+    dwType: DWORD;
+    dwFlags: DWORD;
+    tszName: array [0..MAX_PATH-1] of WCHAR;
+  end;
+{$IFDEF UNICODE}
+  TDIDEVICEOBJECTINSTANCE_DX3 = TDIDEVICEOBJECTINSTANCE_DX3W;
+  LPDIDEVICEOBJECTINSTANCE_DX3 = LPDIDEVICEOBJECTINSTANCE_DX3W;
+  PDIDEVICEOBJECTINSTANCE_DX3 = PDIDEVICEOBJECTINSTANCE_DX3W;
+{$ELSE}
+  TDIDEVICEOBJECTINSTANCE_DX3 = TDIDEVICEOBJECTINSTANCE_DX3A;
+  LPDIDEVICEOBJECTINSTANCE_DX3 = LPDIDEVICEOBJECTINSTANCE_DX3A;
+  PDIDEVICEOBJECTINSTANCE_DX3 = PDIDEVICEOBJECTINSTANCE_DX3A;
+{$ENDIF} // UNICODE
+  LPCDIDEVICEOBJECTINSTANCE_DX3A = ^TDIDEVICEOBJECTINSTANCE_DX3A;
+  LPCDIDEVICEOBJECTINSTANCE_DX3W = ^TDIDEVICEOBJECTINSTANCE_DX3W;
+  LPCDIDEVICEOBJECTINSTANCE_DX3 = ^TDIDEVICEOBJECTINSTANCE_DX3;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+
+  LPDIDEVICEOBJECTINSTANCEA = ^TDIDEVICEOBJECTINSTANCEA;
+  PDIDEVICEOBJECTINSTANCEA = ^TDIDEVICEOBJECTINSTANCEA;
+  TDIDEVICEOBJECTINSTANCEA = record
+    dwSize: DWORD;
+    guidType: GUID;
+    dwOfs: DWORD;
+    dwType: DWORD;
+    dwFlags: DWORD;
+    tszName: array [0..MAX_PATH-1] of CHAR;
+{$IF DIRECTINPUT_VERSION >= $0500}
+    dwFFMaxForce: DWORD;
+    dwFFForceResolution: DWORD;
+    wCollectionNumber: WORD;
+    wDesignatorIndex: WORD;
+    wUsagePage: WORD;
+    wUsage: WORD;
+    dwDimension: DWORD;
+    wExponent: WORD;
+    wReportId: WORD;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+  end;
+  LPDIDEVICEOBJECTINSTANCEW = ^TDIDEVICEOBJECTINSTANCEW;
+  PDIDEVICEOBJECTINSTANCEW = ^TDIDEVICEOBJECTINSTANCEW;
+  TDIDEVICEOBJECTINSTANCEW = record
+    dwSize: DWORD;
+    guidType: GUID;
+    dwOfs: DWORD;
+    dwType: DWORD;
+    dwFlags: DWORD;
+    tszName: array [0..MAX_PATH-1] of WCHAR;
+{$IF DIRECTINPUT_VERSION >= $0500}
+    dwFFMaxForce: DWORD;
+    dwFFForceResolution: DWORD;
+    wCollectionNumber: WORD;
+    wDesignatorIndex: WORD;
+    wUsagePage: WORD;
+    wUsage: WORD;
+    dwDimension: DWORD;
+    wExponent: WORD;
+    wReportId: WORD;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+  end;
+{$IFDEF UNICODE}
+  TDIDEVICEOBJECTINSTANCE = TDIDEVICEOBJECTINSTANCEW;
+  LPDIDEVICEOBJECTINSTANCE = LPDIDEVICEOBJECTINSTANCEW;
+  PDIDEVICEOBJECTINSTANCE = PDIDEVICEOBJECTINSTANCEW;
+{$ELSE}
+  TDIDEVICEOBJECTINSTANCE = TDIDEVICEOBJECTINSTANCEA;
+  LPDIDEVICEOBJECTINSTANCE = LPDIDEVICEOBJECTINSTANCEA;
+  PDIDEVICEOBJECTINSTANCE = PDIDEVICEOBJECTINSTANCEA;
+{$ENDIF} // UNICODE
+  LPCDIDEVICEOBJECTINSTANCEA = ^TDIDEVICEOBJECTINSTANCEA;
+  PCDIDEVICEOBJECTINSTANCEA = ^TDIDEVICEOBJECTINSTANCEA;
+  LPCDIDEVICEOBJECTINSTANCEW = ^TDIDEVICEOBJECTINSTANCEW;
+  PCDIDEVICEOBJECTINSTANCEW = ^TDIDEVICEOBJECTINSTANCEW;
+  LPCDIDEVICEOBJECTINSTANCE = ^TDIDEVICEOBJECTINSTANCE;
+  PCDIDEVICEOBJECTINSTANCE = ^TDIDEVICEOBJECTINSTANCE;
+
+  LPDIENUMDEVICEOBJECTSCALLBACKA = function(lpddoi: LPCDIDEVICEOBJECTINSTANCEA; pvRef: LPVOID): BOOL; stdcall;
+  LPDIENUMDEVICEOBJECTSCALLBACKW = function(lpddoi: LPCDIDEVICEOBJECTINSTANCEW; pvRef: LPVOID): BOOL; stdcall;
+{$IFDEF UNICODE}
+  LPDIENUMDEVICEOBJECTSCALLBACK = LPDIENUMDEVICEOBJECTSCALLBACKW;
+{$ELSE}
+  LPDIENUMDEVICEOBJECTSCALLBACK = LPDIENUMDEVICEOBJECTSCALLBACKA;
+{$ENDIF} // !UNICODE
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+const
+  DIDOI_FFACTUATOR      = $00000001;
+  DIDOI_FFEFFECTTRIGGER = $00000002;
+  DIDOI_POLLED          = $00008000;
+  DIDOI_ASPECTPOSITION  = $00000100;
+  DIDOI_ASPECTVELOCITY  = $00000200;
+  DIDOI_ASPECTACCEL     = $00000300;
+  DIDOI_ASPECTFORCE     = $00000400;
+  DIDOI_ASPECTMASK      = $00000F00;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+{$IF DIRECTINPUT_VERSION >= $050a}
+  DIDOI_GUIDISUSAGE     = $00010000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+
+type
+  LPCDIPROPHEADER = ^TDIPROPHEADER;
+  PCDIPROPHEADER = ^TDIPROPHEADER;
+  LPDIPROPHEADER = ^TDIPROPHEADER;
+  PDIPROPHEADER = ^TDIPROPHEADER;
+  TDIPROPHEADER = record
+    dwSize: DWORD;
+    dwHeaderSize: DWORD;
+    dwObj: DWORD;
+    dwHow: DWORD;
+  end;
+
+const
+  DIPH_DEVICE           = 0;
+  DIPH_BYOFFSET         = 1;
+  DIPH_BYID             = 2;
+{$IF DIRECTINPUT_VERSION >= $050a}
+  DIPH_BYUSAGE          = 3;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+
+//#if(DIRECTINPUT_VERSION >= 0x050a)
+//#define DIMAKEUSAGEDWORD(UsagePage, Usage) \
+//                                (DWORD)MAKELONG(Usage, UsagePage)
+//#endif /* DIRECTINPUT_VERSION >= 0x050a */
+
+type
+  LPCDIPROPDWORD = ^TDIPROPDWORD;
+  PCDIPROPDWORD = ^TDIPROPDWORD;
+  LPDIPROPDWORD = ^TDIPROPDWORD;
+  PDIPROPDWORD = ^TDIPROPDWORD;
+  TDIPROPDWORD = record
+    diph: TDIPROPHEADER;
+    dwData: DWORD;
+  end;
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+  LPCDIPROPPOINTER = ^TDIPROPPOINTER;
+  PCDIPROPPOINTER = ^TDIPROPPOINTER;
+  LPDIPROPPOINTER = ^TDIPROPPOINTER;
+  PDIPROPPOINTER = ^TDIPROPPOINTER;
+  TDIPROPPOINTER = record
+    diph: TDIPROPHEADER;
+    uData: UINT_PTR;
+  end;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+  LPCDIPROPRANGE = ^TDIPROPRANGE;
+  PCDIPROPRANGE = ^TDIPROPRANGE;
+  LPDIPROPRANGE = ^TDIPROPRANGE;
+  PDIPROPRANGE = ^TDIPROPRANGE;
+  TDIPROPRANGE = record
+    diph: TDIPROPHEADER;
+    lMin: LONG;
+    lMax: LONG;
+  end;
+
+const
+  DIPROPRANGE_NOMIN     = LONG($80000000);
+  DIPROPRANGE_NOMAX     = LONG($7FFFFFFF);
+
+{$IF DIRECTINPUT_VERSION >= $050a}
+type
+  LPCDIPROPCAL = ^TDIPROPCAL;
+  PCDIPROPCAL = ^TDIPROPCAL;
+  LPDIPROPCAL = ^TDIPROPCAL;
+  PDIPROPCAL = ^TDIPROPCAL;
+  TDIPROPCAL = record
+    diph: TDIPROPHEADER;
+    lMin: LONG;
+    lCenter: LONG;
+    lMax: LONG;
+  end;
+
+  LPCDIPROPCALPOV = ^TDIPROPCALPOV;
+  PCDIPROPCALPOV = ^TDIPROPCALPOV;
+  LPDIPROPCALPOV = ^TDIPROPCALPOV;
+  PDIPROPCALPOV = ^TDIPROPCALPOV;
+  TDIPROPCALPOV = record
+    diph: TDIPROPHEADER;
+    lMin: array [0..4] of LONG;
+    lMax: array [0..4] of LONG;
+  end;
+
+  LPCDIPROPGUIDANDPATH = ^TDIPROPGUIDANDPATH;
+  PCDIPROPGUIDANDPATH = ^TDIPROPGUIDANDPATH;
+  LPDIPROPGUIDANDPATH = ^TDIPROPGUIDANDPATH;
+  PDIPROPGUIDANDPATH = ^TDIPROPGUIDANDPATH;
+  TDIPROPGUIDANDPATH = record
+    diph: TDIPROPHEADER;
+    guidClass: GUID;
+    wszPath: array [0..MAX_PATH-1] of WCHAR;
+  end;
+
+  LPCDIPROPSTRING = ^TDIPROPSTRING;
+  PCDIPROPSTRING = ^TDIPROPSTRING;
+  LPDIPROPSTRING = ^TDIPROPSTRING;
+  PDIPROPSTRING = ^TDIPROPSTRING;
+  TDIPROPSTRING = record
+    diph: TDIPROPHEADER;
+    wsz: array [0..MAX_PATH-1] of WCHAR;
+  end;
+
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+const
+  MAXCPOINTSNUM        = 8;
+
+type
+  PCPOINT = ^TCPOINT;
+  TCPOINT = record
+    lP: LONG;      // raw value
+    dwLog: DWORD;  // logical_value / max_logical_value * 10000
+  end;
+
+  LPCDIPROPCPOINTS = ^TDIPROPCPOINTS;
+  PCDIPROPCPOINTS = ^TDIPROPCPOINTS;
+  LPDIPROPCPOINTS = ^TDIPROPCPOINTS;
+  PDIPROPCPOINTS = ^TDIPROPCPOINTS;
+  TDIPROPCPOINTS = record
+    diph: TDIPROPHEADER;
+    dwCPointsNum: DWORD;
+    cp: array [0..MAXCPOINTSNUM-1] of TCPOINT;
+  end;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+
+//#ifdef __cplusplus
+//#define MAKEDIPROP(prop)    (*(const GUID * )(prop))
+//#else
+//#define MAKEDIPROP(prop)    ((REFGUID)(prop))
+//#endif
+
+var
+//#define DIPROP_BUFFERSIZE       MAKEDIPROP(1)
+  DIPROP_BUFFERSIZE: TGuid absolute 1;
+
+//#define DIPROP_AXISMODE         MAKEDIPROP(2)
+  DIPROP_AXISMODE: TGuid absolute 2;
+
+const
+  DIPROPAXISMODE_ABS    = 0;
+  DIPROPAXISMODE_REL    = 1;
+
+var
+//#define DIPROP_GRANULARITY      MAKEDIPROP(3)
+  DIPROP_GRANULARITY: TGuid absolute 3;
+
+//#define DIPROP_RANGE            MAKEDIPROP(4)
+  DIPROP_RANGE: TGuid absolute 4;
+
+//#define DIPROP_DEADZONE         MAKEDIPROP(5)
+  DIPROP_DEADZONE: TGuid absolute 5;
+
+//#define DIPROP_SATURATION       MAKEDIPROP(6)
+  DIPROP_SATURATION: TGuid absolute 6;
+
+//#define DIPROP_FFGAIN           MAKEDIPROP(7)
+  DIPROP_FFGAIN: TGuid absolute 7;
+
+//#define DIPROP_FFLOAD           MAKEDIPROP(8)
+  DIPROP_FFLOAD: TGuid absolute 8;
+
+//#define DIPROP_AUTOCENTER       MAKEDIPROP(9)
+  DIPROP_AUTOCENTER: TGuid absolute 9;
+
+const
+  DIPROPAUTOCENTER_OFF  = 0;
+  DIPROPAUTOCENTER_ON   = 1;
+
+var
+//#define DIPROP_CALIBRATIONMODE  MAKEDIPROP(10)
+  DIPROP_CALIBRATIONMODE: TGuid absolute 10;
+
+const
+  DIPROPCALIBRATIONMODE_COOKED  = 0;
+  DIPROPCALIBRATIONMODE_RAW     = 1;
+
+{$IF DIRECTINPUT_VERSION >= $050a}
+var
+//#define DIPROP_CALIBRATION      MAKEDIPROP(11)
+  DIPROP_CALIBRATION: TGuid absolute 11;
+
+//#define DIPROP_GUIDANDPATH      MAKEDIPROP(12)
+  DIPROP_GUIDANDPATH: TGuid absolute 12;
+
+//#define DIPROP_INSTANCENAME     MAKEDIPROP(13)
+  DIPROP_INSTANCENAME: TGuid absolute 13;
+
+//#define DIPROP_PRODUCTNAME      MAKEDIPROP(14)
+  DIPROP_PRODUCTNAME: TGuid absolute 14;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+
+{$IF DIRECTINPUT_VERSION >= $05b2}
+var
+//#define DIPROP_JOYSTICKID       MAKEDIPROP(15)
+  DIPROP_JOYSTICKID: TGuid absolute 15;
+
+//#define DIPROP_GETPORTDISPLAYNAME       MAKEDIPROP(16)
+  DIPROP_GETPORTDISPLAYNAME: TGuid absolute 16;
+
+{$ENDIF} { DIRECTINPUT_VERSION >= $05b2 }
+
+{$IF DIRECTINPUT_VERSION >= $0700}
+var
+//#define DIPROP_PHYSICALRANGE            MAKEDIPROP(18)
+  DIPROP_PHYSICALRANGE: TGuid absolute 18;
+
+//#define DIPROP_LOGICALRANGE             MAKEDIPROP(19)
+  DIPROP_LOGICALRANGE: TGuid absolute 19;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0700 }
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+//#define DIPROP_KEYNAME                     MAKEDIPROP(20)
+  DIPROP_KEYNAME: TGuid absolute 20;
+
+//#define DIPROP_CPOINTS                 MAKEDIPROP(21)
+  DIPROP_CPOINTS: TGuid absolute 21;
+
+//#define DIPROP_APPDATA       MAKEDIPROP(22)
+  DIPROP_APPDATA: TGuid absolute 22;
+
+//#define DIPROP_SCANCODE      MAKEDIPROP(23)
+  DIPROP_SCANCODE: TGuid absolute 23;
+
+//#define DIPROP_VIDPID           MAKEDIPROP(24)
+  DIPROP_VIDPID: TGuid absolute 24;
+
+//#define DIPROP_USERNAME         MAKEDIPROP(25)
+  DIPROP_USERNAME: TGuid absolute 25;
+
+//#define DIPROP_TYPENAME         MAKEDIPROP(26)
+  DIPROP_TYPENAME: TGuid absolute 26;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+
+type
+  LPCDIDEVICEOBJECTDATA_DX = ^TDIDEVICEOBJECTDATA_DX3;
+  PCDIDEVICEOBJECTDATA_DX = ^TDIDEVICEOBJECTDATA_DX3;
+  LPDIDEVICEOBJECTDATA_DX3 = ^TDIDEVICEOBJECTDATA_DX3;
+  PDIDEVICEOBJECTDATA_DX3 = ^TDIDEVICEOBJECTDATA_DX3;
+  TDIDEVICEOBJECTDATA_DX3 = record
+    dwOfs: DWORD;
+    dwData: DWORD;
+    dwTimeStamp: DWORD;
+    dwSequence: DWORD;
+  end;
+
+  LPCDIDEVICEOBJECTDATA = ^TDIDEVICEOBJECTDATA;
+  PCDIDEVICEOBJECTDATA = ^TDIDEVICEOBJECTDATA;
+  LPDIDEVICEOBJECTDATA = ^TDIDEVICEOBJECTDATA;
+  PDIDEVICEOBJECTDATA = ^TDIDEVICEOBJECTDATA;
+  TDIDEVICEOBJECTDATA = record
+    dwOfs: DWORD;
+    dwData: DWORD;
+    dwTimeStamp: DWORD;
+    dwSequence: DWORD;
+{$IF DIRECTINPUT_VERSION >= $0800}
+    uAppData: UINT_PTR;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+  end;
+
+const
+  DIGDD_PEEK        = $00000001;
+
+//#define DISEQUENCE_COMPARE(dwSequence1, cmp, dwSequence2) \
+//                        ((int)((dwSequence1) - (dwSequence2)) cmp 0)
+const
+  DISCL_EXCLUSIVE    = $00000001;
+  DISCL_NONEXCLUSIVE = $00000002;
+  DISCL_FOREGROUND   = $00000004;
+  DISCL_BACKGROUND   = $00000008;
+  DISCL_NOWINKEY     = $00000010;
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+{ These structures are defined for DirectX 3.0 compatibility }
+
+type
+  LPDIDEVICEINSTANCE_DX3A = ^TDIDEVICEINSTANCE_DX3A;
+  PDIDEVICEINSTANCE_DX3A = ^TDIDEVICEINSTANCE_DX3A;
+  TDIDEVICEINSTANCE_DX3A = record
+    dwSize: DWORD;
+    guidInstance: GUID;
+    guidProduct: GUID;
+    dwDevType: DWORD;
+    tszInstanceName: array [0..MAX_PATH-1] of CHAR;
+    tszProductName: array [0..MAX_PATH-1] of CHAR;
+  end;
+  LPDIDEVICEINSTANCE_DX3W = ^TDIDEVICEINSTANCE_DX3W;
+  PDIDEVICEINSTANCE_DX3W = ^TDIDEVICEINSTANCE_DX3W;
+  TDIDEVICEINSTANCE_DX3W = record
+    dwSize: DWORD;
+    guidInstance: GUID;
+    guidProduct: GUID;
+    dwDevType: DWORD;
+    tszInstanceName: array [0..MAX_PATH-1] of WCHAR;
+    tszProductName: array [0..MAX_PATH-1] of WCHAR;
+  end;
+{$IFDEF UNICODE}
+  TDIDEVICEINSTANCE_DX3 = TDIDEVICEINSTANCE_DX3W;
+  LPDIDEVICEINSTANCE_DX3 = LPDIDEVICEINSTANCE_DX3W;
+  PDIDEVICEINSTANCE_DX3 = PDIDEVICEINSTANCE_DX3W;
+{$ELSE}
+  TDIDEVICEINSTANCE_DX3 = TDIDEVICEINSTANCE_DX3A;
+  LPDIDEVICEINSTANCE_DX3 = LPDIDEVICEINSTANCE_DX3A;
+  PDIDEVICEINSTANCE_DX3 = PDIDEVICEINSTANCE_DX3A;
+{$ENDIF} // UNICODE
+  LPCDIDEVICEINSTANCE_DX3A = ^TDIDEVICEINSTANCE_DX3A;
+  PCDIDEVICEINSTANCE_DX3A = ^TDIDEVICEINSTANCE_DX3A;
+  LPCDIDEVICEINSTANCE_DX3W = ^TDIDEVICEINSTANCE_DX3W;
+  PCDIDEVICEINSTANCE_DX3W = ^TDIDEVICEINSTANCE_DX3W;
+  LPCDIDEVICEINSTANCE_DX3 = ^TDIDEVICEINSTANCE_DX3;
+  PCDIDEVICEINSTANCE_DX3 = ^TDIDEVICEINSTANCE_DX3;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+
+  LPDIDEVICEINSTANCEA = ^TDIDEVICEINSTANCEA;
+  PDIDEVICEINSTANCEA = ^TDIDEVICEINSTANCEA;
+  TDIDEVICEINSTANCEA = record
+    dwSize: DWORD;
+    guidInstance: GUID;
+    guidProduct: GUID;
+    dwDevType: DWORD;
+    tszInstanceName: array [0..MAX_PATH-1] of CHAR;
+    tszProductName: array [0..MAX_PATH-1] of CHAR;
+{$IF DIRECTINPUT_VERSION >= $0500}
+    guidFFDriver: GUID;
+    wUsagePage: WORD;
+    wUsage: WORD;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+  end;
+  LPDIDEVICEINSTANCEW = ^TDIDEVICEINSTANCEW;
+  PDIDEVICEINSTANCEW = ^TDIDEVICEINSTANCEW;
+  TDIDEVICEINSTANCEW = record
+    dwSize: DWORD;
+    guidInstance: GUID;
+    guidProduct: GUID;
+    dwDevType: DWORD;
+    tszInstanceName: array [0..MAX_PATH-1] of WCHAR;
+    tszProductName: array [0..MAX_PATH-1] of WCHAR;
+{$IF DIRECTINPUT_VERSION >= $0500}
+    guidFFDriver: GUID;
+    wUsagePage: WORD;
+    wUsage: WORD;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+  end;
+{$IFDEF UNICODE}
+  TDIDEVICEINSTANCE = TDIDEVICEINSTANCEW;
+  LPDIDEVICEINSTANCE = LPDIDEVICEINSTANCEW;
+  PDIDEVICEINSTANCE = PDIDEVICEINSTANCEW;
+{$ELSE}
+  TDIDEVICEINSTANCE = TDIDEVICEINSTANCEA;
+  LPDIDEVICEINSTANCE = LPDIDEVICEINSTANCEA;
+  PDIDEVICEINSTANCE = PDIDEVICEINSTANCEA;
+{$ENDIF} // UNICODE
+
+  LPCDIDEVICEINSTANCEA = ^TDIDEVICEINSTANCEA;
+  PCDIDEVICEINSTANCEA = ^TDIDEVICEINSTANCEA;
+  LPCDIDEVICEINSTANCEW = ^TDIDEVICEINSTANCEW;
+  PCDIDEVICEINSTANCEW = ^TDIDEVICEINSTANCEW;
+  LPCDIDEVICEINSTANCE = ^TDIDEVICEINSTANCE;
+  PCDIDEVICEINSTANCE = ^TDIDEVICEINSTANCE;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDeviceW
+
+  IDirectInputDeviceW = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDeviceW methods ***)
+    function GetCapabilities(lpDIDevCaps: LPDIDEVCAPS): HRESULT; stdcall;
+    function EnumObjects(lpCallback: LPDIENUMDEVICEOBJECTSCALLBACKW; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPDIPROPHEADER): HRESULT; stdcall;
+    function SetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPCDIPROPHEADER): HRESULT; stdcall;
+    function Acquire: HRESULT; stdcall;
+    function Unacquire: HRESULT; stdcall;
+    function GetDeviceState(cbData: DWORD; lpvData: LPVOID): HRESULT; stdcall;
+    function GetDeviceData(cbObjectData: DWORD; rgdod: LPDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; dwFlags: DWORD): HRESULT; stdcall;
+    function SetDataFormat(lpdf: LPCDIDATAFORMAT): HRESULT; stdcall;
+    function SetEventNotification(hEvent: HANDLE): HRESULT; stdcall;
+    function SetCooperativeLevel(hwnd: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function GetObjectInfo(pdidoi: LPDIDEVICEOBJECTINSTANCEW; dwObj: DWORD; dwHow: DWORD): HRESULT; stdcall;
+    function GetDeviceInfo(pdidi: LPDIDEVICEINSTANCEW): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDeviceW *LPDIRECTINPUTDEVICEW;
+  LPDIRECTINPUTDEVICEW = IDirectInputDeviceW;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDeviceA
+
+  IDirectInputDeviceA = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDeviceA methods ***)
+    function GetCapabilities(lpDIDevCaps: LPDIDEVCAPS): HRESULT; stdcall;
+    function EnumObjects(lpCallback: LPDIENUMDEVICEOBJECTSCALLBACKA; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPDIPROPHEADER): HRESULT; stdcall;
+    function SetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPCDIPROPHEADER): HRESULT; stdcall;
+    function Acquire: HRESULT; stdcall;
+    function Unacquire: HRESULT; stdcall;
+    function GetDeviceState(cbData: DWORD; lpvData: LPVOID): HRESULT; stdcall;
+    function GetDeviceData(cbObjectData: DWORD; rgdod: LPDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; dwFlags: DWORD): HRESULT; stdcall;
+    function SetDataFormat(lpdf: LPCDIDATAFORMAT): HRESULT; stdcall;
+    function SetEventNotification(hEvent: HANDLE): HRESULT; stdcall;
+    function SetCooperativeLevel(hwnd: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function GetObjectInfo(pdidoi: LPDIDEVICEOBJECTINSTANCEA; dwObj: DWORD; dwHow: DWORD): HRESULT; stdcall;
+    function GetDeviceInfo(pdidi: LPDIDEVICEINSTANCEA): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDeviceA *LPDIRECTINPUTDEVICEA;
+  LPDIRECTINPUTDEVICEA = IDirectInputDeviceA;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInputDevice: TIID = '{5944E681-C92E-11CF-BFC7-444553540000}'{IID_IDirectInputDeviceW};
+type
+  IDirectInputDevice = IDirectInputDeviceW;
+{$ELSE}
+const
+  IID_IDirectInputDevice: TIID = '{5944E680-C92E-11CF-BFC7-444553540000}'{IID_IDirectInputDeviceA};
+type
+  IDirectInputDevice = IDirectInputDeviceA;
+{$ENDIF}
+//typedef struct IDirectInputDevice *LPDIRECTINPUTDEVICE;
+  LPDIRECTINPUTDEVICE = IDirectInputDevice;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInputDevice_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInputDevice_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInputDevice_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInputDevice_GetCapabilities(p,a) (p)->lpVtbl->GetCapabilities(p,a)
+//#define IDirectInputDevice_EnumObjects(p,a,b,c) (p)->lpVtbl->EnumObjects(p,a,b,c)
+//#define IDirectInputDevice_GetProperty(p,a,b) (p)->lpVtbl->GetProperty(p,a,b)
+//#define IDirectInputDevice_SetProperty(p,a,b) (p)->lpVtbl->SetProperty(p,a,b)
+//#define IDirectInputDevice_Acquire(p) (p)->lpVtbl->Acquire(p)
+//#define IDirectInputDevice_Unacquire(p) (p)->lpVtbl->Unacquire(p)
+//#define IDirectInputDevice_GetDeviceState(p,a,b) (p)->lpVtbl->GetDeviceState(p,a,b)
+//#define IDirectInputDevice_GetDeviceData(p,a,b,c,d) (p)->lpVtbl->GetDeviceData(p,a,b,c,d)
+//#define IDirectInputDevice_SetDataFormat(p,a) (p)->lpVtbl->SetDataFormat(p,a)
+//#define IDirectInputDevice_SetEventNotification(p,a) (p)->lpVtbl->SetEventNotification(p,a)
+//#define IDirectInputDevice_SetCooperativeLevel(p,a,b) (p)->lpVtbl->SetCooperativeLevel(p,a,b)
+//#define IDirectInputDevice_GetObjectInfo(p,a,b,c) (p)->lpVtbl->GetObjectInfo(p,a,b,c)
+//#define IDirectInputDevice_GetDeviceInfo(p,a) (p)->lpVtbl->GetDeviceInfo(p,a)
+//#define IDirectInputDevice_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInputDevice_Initialize(p,a,b,c) (p)->lpVtbl->Initialize(p,a,b,c)
+//#else
+//#define IDirectInputDevice_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInputDevice_AddRef(p) (p)->AddRef()
+//#define IDirectInputDevice_Release(p) (p)->Release()
+//#define IDirectInputDevice_GetCapabilities(p,a) (p)->GetCapabilities(a)
+//#define IDirectInputDevice_EnumObjects(p,a,b,c) (p)->EnumObjects(a,b,c)
+//#define IDirectInputDevice_GetProperty(p,a,b) (p)->GetProperty(a,b)
+//#define IDirectInputDevice_SetProperty(p,a,b) (p)->SetProperty(a,b)
+//#define IDirectInputDevice_Acquire(p) (p)->Acquire()
+//#define IDirectInputDevice_Unacquire(p) (p)->Unacquire()
+//#define IDirectInputDevice_GetDeviceState(p,a,b) (p)->GetDeviceState(a,b)
+//#define IDirectInputDevice_GetDeviceData(p,a,b,c,d) (p)->GetDeviceData(a,b,c,d)
+//#define IDirectInputDevice_SetDataFormat(p,a) (p)->SetDataFormat(a)
+//#define IDirectInputDevice_SetEventNotification(p,a) (p)->SetEventNotification(a)
+//#define IDirectInputDevice_SetCooperativeLevel(p,a,b) (p)->SetCooperativeLevel(a,b)
+//#define IDirectInputDevice_GetObjectInfo(p,a,b,c) (p)->GetObjectInfo(a,b,c)
+//#define IDirectInputDevice_GetDeviceInfo(p,a) (p)->GetDeviceInfo(a)
+//#define IDirectInputDevice_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInputDevice_Initialize(p,a,b,c) (p)->Initialize(a,b,c)
+//#endif
+
+//#endif /* DIJ_RINGZERO */
+
+
+{$IF DIRECTINPUT_VERSION >= $0500}
+
+const
+  DISFFC_RESET           = $00000001;
+  DISFFC_STOPALL         = $00000002;
+  DISFFC_PAUSE           = $00000004;
+  DISFFC_CONTINUE        = $00000008;
+  DISFFC_SETACTUATORSON  = $00000010;
+  DISFFC_SETACTUATORSOFF = $00000020;
+
+  DIGFFS_EMPTY           = $00000001;
+  DIGFFS_STOPPED         = $00000002;
+  DIGFFS_PAUSED          = $00000004;
+  DIGFFS_ACTUATORSON     = $00000010;
+  DIGFFS_ACTUATORSOFF    = $00000020;
+  DIGFFS_POWERON         = $00000040;
+  DIGFFS_POWEROFF        = $00000080;
+  DIGFFS_SAFETYSWITCHON  = $00000100;
+  DIGFFS_SAFETYSWITCHOFF = $00000200;
+  DIGFFS_USERFFSWITCHON  = $00000400;
+  DIGFFS_USERFFSWITCHOFF = $00000800;
+  DIGFFS_DEVICELOST      = $80000000;
+
+//#ifndef DIJ_RINGZERO
+
+type
+  LPDIEFFECTINFOA = ^TDIEFFECTINFOA;
+  PDIEFFECTINFOA = ^TDIEFFECTINFOA;
+  TDIEFFECTINFOA = record
+    dwSize: DWORD;
+    guid: GUID;
+    dwEffType: DWORD;
+    dwStaticParams: DWORD;
+    dwDynamicParams: DWORD;
+    tszName: array [0..MAX_PATH-1] of CHAR;
+  end;
+  LPDIEFFECTINFOW = ^TDIEFFECTINFOW;
+  PDIEFFECTINFOW = ^TDIEFFECTINFOW;
+  TDIEFFECTINFOW = record
+    dwSize: DWORD;
+    guid: GUID;
+    dwEffType: DWORD;
+    dwStaticParams: DWORD;
+    dwDynamicParams: DWORD;
+    tszName: array [0..MAX_PATH-1] of WCHAR;
+  end;
+{$IFDEF UNICODE}
+  TDIEFFECTINFO = TDIEFFECTINFOW;
+  LPDIEFFECTINFO = LPDIEFFECTINFOW;
+  PDIEFFECTINFO = PDIEFFECTINFOW;
+{$ELSE}
+  TDIEFFECTINFO = TDIEFFECTINFOA;
+  LPDIEFFECTINFO = LPDIEFFECTINFOA;
+  PDIEFFECTINFO = PDIEFFECTINFOA;
+{$ENDIF} // UNICODE
+  LPCDIEFFECTINFOA = ^TDIEFFECTINFOA;
+  PCDIEFFECTINFOA = ^TDIEFFECTINFOA;
+  LPCDIEFFECTINFOW = ^TDIEFFECTINFOW;
+  PCDIEFFECTINFOW = ^TDIEFFECTINFOW;
+  LPCDIEFFECTINFO = ^TDIEFFECTINFO;
+  PCDIEFFECTINFO = ^TDIEFFECTINFO;
+
+const
+  DISDD_CONTINUE        = $00000001;
+
+type
+  LPDIENUMEFFECTSCALLBACKA = function(pdei: LPCDIEFFECTINFOA; pvRef: LPVOID): BOOL; stdcall;
+  LPDIENUMEFFECTSCALLBACKW = function(pdei: LPCDIEFFECTINFOW; pvRef: LPVOID): BOOL; stdcall;
+{$IFDEF UNICODE}
+  LPDIENUMEFFECTSCALLBACK = LPDIENUMEFFECTSCALLBACKW;
+{$ELSE}
+  LPDIENUMEFFECTSCALLBACK = LPDIENUMEFFECTSCALLBACKA;
+{$ENDIF} // !UNICODE
+  LPDIENUMCREATEDEFFECTOBJECTSCALLBACK = function(peff: LPDIRECTINPUTEFFECT; pvRef: LPVOID): BOOL; stdcall;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDevice2W
+
+  IDirectInputDevice2W = interface(IDirectInputDeviceW)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDeviceW methods ***)
+    {STDMETHOD(GetCapabilities)(THIS_ LPDIDEVCAPS) PURE;
+    STDMETHOD(EnumObjects)(THIS_ LPDIENUMDEVICEOBJECTSCALLBACKW,LPVOID,DWORD) PURE;
+    STDMETHOD(GetProperty)(THIS_ REFGUID,LPDIPROPHEADER) PURE;
+    STDMETHOD(SetProperty)(THIS_ REFGUID,LPCDIPROPHEADER) PURE;
+    STDMETHOD(Acquire)(THIS) PURE;
+    STDMETHOD(Unacquire)(THIS) PURE;
+    STDMETHOD(GetDeviceState)(THIS_ DWORD,LPVOID) PURE;
+    STDMETHOD(GetDeviceData)(THIS_ DWORD,LPDIDEVICEOBJECTDATA,LPDWORD,DWORD) PURE;
+    STDMETHOD(SetDataFormat)(THIS_ LPCDIDATAFORMAT) PURE;
+    STDMETHOD(SetEventNotification)(THIS_ HANDLE) PURE;
+    STDMETHOD(SetCooperativeLevel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(GetObjectInfo)(THIS_ LPDIDEVICEOBJECTINSTANCEW,DWORD,DWORD) PURE;
+    STDMETHOD(GetDeviceInfo)(THIS_ LPDIDEVICEINSTANCEW) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD,REFGUID) PURE;}
+
+    (*** IDirectInputDevice2W methods ***)
+    function CreateEffect(const rguid: TGuid {REFGUID}; lpeff: LPCDIEFFECT; out ppdeff: IDirectInputEffect {LPDIRECTINPUTEFFECT *}; punkOuter: {LPUNKNOWN}IUnknown): HRESULT; stdcall;
+    function EnumEffects(lpCallback: LPDIENUMEFFECTSCALLBACKW; pvRef: LPVOID; dwEffType: DWORD): HRESULT; stdcall;
+    function GetEffectInfo(pdei: LPDIEFFECTINFOW; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function GetForceFeedbackState(pdwOut: LPDWORD): HRESULT; stdcall;
+    function SendForceFeedbackCommand(dwFlags: DWORD): HRESULT; stdcall;
+    function EnumCreatedEffectObjects(lpCallback: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK; pvRef: LPVOID; fl: DWORD): HRESULT; stdcall;
+    function Escape(pesc: LPDIEFFESCAPE): HRESULT; stdcall;
+    function Poll: HRESULT; stdcall;
+    function SendDeviceData(cbObjectData: DWORD; rgdod: LPCDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; fl: DWORD): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDevice2W *LPDIRECTINPUTDEVICE2W;
+  LPDIRECTINPUTDEVICE2W = IDirectInputDevice2W;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDevice2A
+
+  IDirectInputDevice2A = interface(IDirectInputDeviceA)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDeviceA methods ***)
+    {STDMETHOD(GetCapabilities)(THIS_ LPDIDEVCAPS) PURE;
+    STDMETHOD(EnumObjects)(THIS_ LPDIENUMDEVICEOBJECTSCALLBACKA,LPVOID,DWORD) PURE;
+    STDMETHOD(GetProperty)(THIS_ REFGUID,LPDIPROPHEADER) PURE;
+    STDMETHOD(SetProperty)(THIS_ REFGUID,LPCDIPROPHEADER) PURE;
+    STDMETHOD(Acquire)(THIS) PURE;
+    STDMETHOD(Unacquire)(THIS) PURE;
+    STDMETHOD(GetDeviceState)(THIS_ DWORD,LPVOID) PURE;
+    STDMETHOD(GetDeviceData)(THIS_ DWORD,LPDIDEVICEOBJECTDATA,LPDWORD,DWORD) PURE;
+    STDMETHOD(SetDataFormat)(THIS_ LPCDIDATAFORMAT) PURE;
+    STDMETHOD(SetEventNotification)(THIS_ HANDLE) PURE;
+    STDMETHOD(SetCooperativeLevel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(GetObjectInfo)(THIS_ LPDIDEVICEOBJECTINSTANCEA,DWORD,DWORD) PURE;
+    STDMETHOD(GetDeviceInfo)(THIS_ LPDIDEVICEINSTANCEA) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD,REFGUID) PURE;}
+
+    (*** IDirectInputDevice2A methods ***)
+    function CreateEffect(const rguid: TGuid {REFGUID}; lpeff: LPCDIEFFECT; out ppdeff: IDirectInputEffect {LPDIRECTINPUTEFFECT *}; punkOuter: {LPUNKNOWN}IUnknown): HRESULT; stdcall;
+    function EnumEffects(lpCallback: LPDIENUMEFFECTSCALLBACKA; pvRef: LPVOID; dwEffType: DWORD): HRESULT; stdcall;
+    function GetEffectInfo(pdei: LPDIEFFECTINFOA; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function GetForceFeedbackState(pdwOut: LPDWORD): HRESULT; stdcall;
+    function SendForceFeedbackCommand(dwFlags: DWORD): HRESULT; stdcall;
+    function EnumCreatedEffectObjects(lpCallback: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK; pvRef: LPVOID; fl: DWORD): HRESULT; stdcall;
+    function Escape(pesc: LPDIEFFESCAPE): HRESULT; stdcall;
+    function Poll: HRESULT; stdcall;
+    function SendDeviceData(cbObjectData: DWORD; rgdod: LPCDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; fl: DWORD): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDevice2A *LPDIRECTINPUTDEVICE2A;
+  LPDIRECTINPUTDEVICE2A = IDirectInputDevice2A;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInputDevice2: TIID = '{5944E683-C92E-11CF-BFC7-444553540000}'{IID_IDirectInputDevice2W};
+type
+  IDirectInputDevice2 = IDirectInputDevice2W;
+{$ELSE}
+const
+  IID_IDirectInputDevice2: TIID = '{5944E682-C92E-11CF-BFC7-444553540000}'{IID_IDirectInputDevice2A};
+type
+  IDirectInputDevice2 = IDirectInputDevice2A;
+{$ENDIF}
+//typedef struct IDirectInputDevice2 *LPDIRECTINPUTDEVICE2;
+  LPDIRECTINPUTDEVICE2 = IDirectInputDevice2;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInputDevice2_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInputDevice2_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInputDevice2_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInputDevice2_GetCapabilities(p,a) (p)->lpVtbl->GetCapabilities(p,a)
+//#define IDirectInputDevice2_EnumObjects(p,a,b,c) (p)->lpVtbl->EnumObjects(p,a,b,c)
+//#define IDirectInputDevice2_GetProperty(p,a,b) (p)->lpVtbl->GetProperty(p,a,b)
+//#define IDirectInputDevice2_SetProperty(p,a,b) (p)->lpVtbl->SetProperty(p,a,b)
+//#define IDirectInputDevice2_Acquire(p) (p)->lpVtbl->Acquire(p)
+//#define IDirectInputDevice2_Unacquire(p) (p)->lpVtbl->Unacquire(p)
+//#define IDirectInputDevice2_GetDeviceState(p,a,b) (p)->lpVtbl->GetDeviceState(p,a,b)
+//#define IDirectInputDevice2_GetDeviceData(p,a,b,c,d) (p)->lpVtbl->GetDeviceData(p,a,b,c,d)
+//#define IDirectInputDevice2_SetDataFormat(p,a) (p)->lpVtbl->SetDataFormat(p,a)
+//#define IDirectInputDevice2_SetEventNotification(p,a) (p)->lpVtbl->SetEventNotification(p,a)
+//#define IDirectInputDevice2_SetCooperativeLevel(p,a,b) (p)->lpVtbl->SetCooperativeLevel(p,a,b)
+//#define IDirectInputDevice2_GetObjectInfo(p,a,b,c) (p)->lpVtbl->GetObjectInfo(p,a,b,c)
+//#define IDirectInputDevice2_GetDeviceInfo(p,a) (p)->lpVtbl->GetDeviceInfo(p,a)
+//#define IDirectInputDevice2_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInputDevice2_Initialize(p,a,b,c) (p)->lpVtbl->Initialize(p,a,b,c)
+//#define IDirectInputDevice2_CreateEffect(p,a,b,c,d) (p)->lpVtbl->CreateEffect(p,a,b,c,d)
+//#define IDirectInputDevice2_EnumEffects(p,a,b,c) (p)->lpVtbl->EnumEffects(p,a,b,c)
+//#define IDirectInputDevice2_GetEffectInfo(p,a,b) (p)->lpVtbl->GetEffectInfo(p,a,b)
+//#define IDirectInputDevice2_GetForceFeedbackState(p,a) (p)->lpVtbl->GetForceFeedbackState(p,a)
+//#define IDirectInputDevice2_SendForceFeedbackCommand(p,a) (p)->lpVtbl->SendForceFeedbackCommand(p,a)
+//#define IDirectInputDevice2_EnumCreatedEffectObjects(p,a,b,c) (p)->lpVtbl->EnumCreatedEffectObjects(p,a,b,c)
+//#define IDirectInputDevice2_Escape(p,a) (p)->lpVtbl->Escape(p,a)
+//#define IDirectInputDevice2_Poll(p) (p)->lpVtbl->Poll(p)
+//#define IDirectInputDevice2_SendDeviceData(p,a,b,c,d) (p)->lpVtbl->SendDeviceData(p,a,b,c,d)
+//#else
+//#define IDirectInputDevice2_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInputDevice2_AddRef(p) (p)->AddRef()
+//#define IDirectInputDevice2_Release(p) (p)->Release()
+//#define IDirectInputDevice2_GetCapabilities(p,a) (p)->GetCapabilities(a)
+//#define IDirectInputDevice2_EnumObjects(p,a,b,c) (p)->EnumObjects(a,b,c)
+//#define IDirectInputDevice2_GetProperty(p,a,b) (p)->GetProperty(a,b)
+//#define IDirectInputDevice2_SetProperty(p,a,b) (p)->SetProperty(a,b)
+//#define IDirectInputDevice2_Acquire(p) (p)->Acquire()
+//#define IDirectInputDevice2_Unacquire(p) (p)->Unacquire()
+//#define IDirectInputDevice2_GetDeviceState(p,a,b) (p)->GetDeviceState(a,b)
+//#define IDirectInputDevice2_GetDeviceData(p,a,b,c,d) (p)->GetDeviceData(a,b,c,d)
+//#define IDirectInputDevice2_SetDataFormat(p,a) (p)->SetDataFormat(a)
+//#define IDirectInputDevice2_SetEventNotification(p,a) (p)->SetEventNotification(a)
+//#define IDirectInputDevice2_SetCooperativeLevel(p,a,b) (p)->SetCooperativeLevel(a,b)
+//#define IDirectInputDevice2_GetObjectInfo(p,a,b,c) (p)->GetObjectInfo(a,b,c)
+//#define IDirectInputDevice2_GetDeviceInfo(p,a) (p)->GetDeviceInfo(a)
+//#define IDirectInputDevice2_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInputDevice2_Initialize(p,a,b,c) (p)->Initialize(a,b,c)
+//#define IDirectInputDevice2_CreateEffect(p,a,b,c,d) (p)->CreateEffect(a,b,c,d)
+//#define IDirectInputDevice2_EnumEffects(p,a,b,c) (p)->EnumEffects(a,b,c)
+//#define IDirectInputDevice2_GetEffectInfo(p,a,b) (p)->GetEffectInfo(a,b)
+//#define IDirectInputDevice2_GetForceFeedbackState(p,a) (p)->GetForceFeedbackState(a)
+//#define IDirectInputDevice2_SendForceFeedbackCommand(p,a) (p)->SendForceFeedbackCommand(a)
+//#define IDirectInputDevice2_EnumCreatedEffectObjects(p,a,b,c) (p)->EnumCreatedEffectObjects(a,b,c)
+//#define IDirectInputDevice2_Escape(p,a) (p)->Escape(a)
+//#define IDirectInputDevice2_Poll(p) (p)->Poll()
+//#define IDirectInputDevice2_SendDeviceData(p,a,b,c,d) (p)->SendDeviceData(a,b,c,d)
+//#endif
+
+//#endif /* DIJ_RINGZERO */
+
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+
+{$IF DIRECTINPUT_VERSION >= $0700}
+const
+  DIFEF_DEFAULT             = $00000000;
+  DIFEF_INCLUDENONSTANDARD  = $00000001;
+  DIFEF_MODIFYIFNEEDED      = $00000010;
+
+//#ifndef DIJ_RINGZERO
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDevice7W
+
+type
+  IDirectInputDevice7W = interface(IDirectInputDevice2W)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDevice2W methods ***)
+    {STDMETHOD(GetCapabilities)(THIS_ LPDIDEVCAPS) PURE;
+    STDMETHOD(EnumObjects)(THIS_ LPDIENUMDEVICEOBJECTSCALLBACKW,LPVOID,DWORD) PURE;
+    STDMETHOD(GetProperty)(THIS_ REFGUID,LPDIPROPHEADER) PURE;
+    STDMETHOD(SetProperty)(THIS_ REFGUID,LPCDIPROPHEADER) PURE;
+    STDMETHOD(Acquire)(THIS) PURE;
+    STDMETHOD(Unacquire)(THIS) PURE;
+    STDMETHOD(GetDeviceState)(THIS_ DWORD,LPVOID) PURE;
+    STDMETHOD(GetDeviceData)(THIS_ DWORD,LPDIDEVICEOBJECTDATA,LPDWORD,DWORD) PURE;
+    STDMETHOD(SetDataFormat)(THIS_ LPCDIDATAFORMAT) PURE;
+    STDMETHOD(SetEventNotification)(THIS_ HANDLE) PURE;
+    STDMETHOD(SetCooperativeLevel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(GetObjectInfo)(THIS_ LPDIDEVICEOBJECTINSTANCEW,DWORD,DWORD) PURE;
+    STDMETHOD(GetDeviceInfo)(THIS_ LPDIDEVICEINSTANCEW) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD,REFGUID) PURE;
+    STDMETHOD(CreateEffect)(THIS_ REFGUID,LPCDIEFFECT,LPDIRECTINPUTEFFECT *,LPUNKNOWN) PURE;
+    STDMETHOD(EnumEffects)(THIS_ LPDIENUMEFFECTSCALLBACKW,LPVOID,DWORD) PURE;
+    STDMETHOD(GetEffectInfo)(THIS_ LPDIEFFECTINFOW,REFGUID) PURE;
+    STDMETHOD(GetForceFeedbackState)(THIS_ LPDWORD) PURE;
+    STDMETHOD(SendForceFeedbackCommand)(THIS_ DWORD) PURE;
+    STDMETHOD(EnumCreatedEffectObjects)(THIS_ LPDIENUMCREATEDEFFECTOBJECTSCALLBACK,LPVOID,DWORD) PURE;
+    STDMETHOD(Escape)(THIS_ LPDIEFFESCAPE) PURE;
+    STDMETHOD(Poll)(THIS) PURE;
+    STDMETHOD(SendDeviceData)(THIS_ DWORD,LPCDIDEVICEOBJECTDATA,LPDWORD,DWORD) PURE;}
+
+    (*** IDirectInputDevice7W methods ***)
+    function EnumEffectsInFile(lpszFileName: LPCWSTR; pec: LPDIENUMEFFECTSINFILECALLBACK; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function WriteEffectToFile(lpszFileName: LPCWSTR; dwEntries: DWORD; rgDiFileEft: LPDIFILEEFFECT; dwFlags: DWORD): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDevice7W *LPDIRECTINPUTDEVICE7W;
+  LPDIRECTINPUTDEVICE7W = IDirectInputDevice7W;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDevice7A
+
+  IDirectInputDevice7A = interface(IDirectInputDevice2A)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDevice2A methods ***)
+    {STDMETHOD(GetCapabilities)(THIS_ LPDIDEVCAPS) PURE;
+    STDMETHOD(EnumObjects)(THIS_ LPDIENUMDEVICEOBJECTSCALLBACKA,LPVOID,DWORD) PURE;
+    STDMETHOD(GetProperty)(THIS_ REFGUID,LPDIPROPHEADER) PURE;
+    STDMETHOD(SetProperty)(THIS_ REFGUID,LPCDIPROPHEADER) PURE;
+    STDMETHOD(Acquire)(THIS) PURE;
+    STDMETHOD(Unacquire)(THIS) PURE;
+    STDMETHOD(GetDeviceState)(THIS_ DWORD,LPVOID) PURE;
+    STDMETHOD(GetDeviceData)(THIS_ DWORD,LPDIDEVICEOBJECTDATA,LPDWORD,DWORD) PURE;
+    STDMETHOD(SetDataFormat)(THIS_ LPCDIDATAFORMAT) PURE;
+    STDMETHOD(SetEventNotification)(THIS_ HANDLE) PURE;
+    STDMETHOD(SetCooperativeLevel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(GetObjectInfo)(THIS_ LPDIDEVICEOBJECTINSTANCEA,DWORD,DWORD) PURE;
+    STDMETHOD(GetDeviceInfo)(THIS_ LPDIDEVICEINSTANCEA) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD,REFGUID) PURE;
+    STDMETHOD(CreateEffect)(THIS_ REFGUID,LPCDIEFFECT,LPDIRECTINPUTEFFECT *,LPUNKNOWN) PURE;
+    STDMETHOD(EnumEffects)(THIS_ LPDIENUMEFFECTSCALLBACKA,LPVOID,DWORD) PURE;
+    STDMETHOD(GetEffectInfo)(THIS_ LPDIEFFECTINFOA,REFGUID) PURE;
+    STDMETHOD(GetForceFeedbackState)(THIS_ LPDWORD) PURE;
+    STDMETHOD(SendForceFeedbackCommand)(THIS_ DWORD) PURE;
+    STDMETHOD(EnumCreatedEffectObjects)(THIS_ LPDIENUMCREATEDEFFECTOBJECTSCALLBACK,LPVOID,DWORD) PURE;
+    STDMETHOD(Escape)(THIS_ LPDIEFFESCAPE) PURE;
+    STDMETHOD(Poll)(THIS) PURE;
+    STDMETHOD(SendDeviceData)(THIS_ DWORD,LPCDIDEVICEOBJECTDATA,LPDWORD,DWORD) PURE;}
+
+    (*** IDirectInputDevice7A methods ***)
+    function EnumEffectsInFile(lpszFileName: LPCSTR; pec: LPDIENUMEFFECTSINFILECALLBACK; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function WriteEffectToFile(lpszFileName: LPCSTR; dwEntries: DWORD; rgDiFileEft: LPDIFILEEFFECT; dwFlags: DWORD): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDevice7A *LPDIRECTINPUTDEVICE7A;
+  LPDIRECTINPUTDEVICE7A = IDirectInputDevice7A;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInputDevice7: TIID = '{57D7C6BD-2356-11D3-8E9D-00C04F6844AE}'{IID_IDirectInputDevice7W};
+type
+  IDirectInputDevice7 = IDirectInputDevice7W;
+{$ELSE}
+const
+  IID_IDirectInputDevice7: TIID = '{57D7C6BC-2356-11D3-8E9D-00C04F6844AE}'{IID_IDirectInputDevice7A};
+type
+  IDirectInputDevice7 = IDirectInputDevice7A;
+{$ENDIF}
+//typedef struct IDirectInputDevice7 *LPDIRECTINPUTDEVICE7;
+  LPDIRECTINPUTDEVICE7 = IDirectInputDevice7;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInputDevice7_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInputDevice7_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInputDevice7_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInputDevice7_GetCapabilities(p,a) (p)->lpVtbl->GetCapabilities(p,a)
+//#define IDirectInputDevice7_EnumObjects(p,a,b,c) (p)->lpVtbl->EnumObjects(p,a,b,c)
+//#define IDirectInputDevice7_GetProperty(p,a,b) (p)->lpVtbl->GetProperty(p,a,b)
+//#define IDirectInputDevice7_SetProperty(p,a,b) (p)->lpVtbl->SetProperty(p,a,b)
+//#define IDirectInputDevice7_Acquire(p) (p)->lpVtbl->Acquire(p)
+//#define IDirectInputDevice7_Unacquire(p) (p)->lpVtbl->Unacquire(p)
+//#define IDirectInputDevice7_GetDeviceState(p,a,b) (p)->lpVtbl->GetDeviceState(p,a,b)
+//#define IDirectInputDevice7_GetDeviceData(p,a,b,c,d) (p)->lpVtbl->GetDeviceData(p,a,b,c,d)
+//#define IDirectInputDevice7_SetDataFormat(p,a) (p)->lpVtbl->SetDataFormat(p,a)
+//#define IDirectInputDevice7_SetEventNotification(p,a) (p)->lpVtbl->SetEventNotification(p,a)
+//#define IDirectInputDevice7_SetCooperativeLevel(p,a,b) (p)->lpVtbl->SetCooperativeLevel(p,a,b)
+//#define IDirectInputDevice7_GetObjectInfo(p,a,b,c) (p)->lpVtbl->GetObjectInfo(p,a,b,c)
+//#define IDirectInputDevice7_GetDeviceInfo(p,a) (p)->lpVtbl->GetDeviceInfo(p,a)
+//#define IDirectInputDevice7_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInputDevice7_Initialize(p,a,b,c) (p)->lpVtbl->Initialize(p,a,b,c)
+//#define IDirectInputDevice7_CreateEffect(p,a,b,c,d) (p)->lpVtbl->CreateEffect(p,a,b,c,d)
+//#define IDirectInputDevice7_EnumEffects(p,a,b,c) (p)->lpVtbl->EnumEffects(p,a,b,c)
+//#define IDirectInputDevice7_GetEffectInfo(p,a,b) (p)->lpVtbl->GetEffectInfo(p,a,b)
+//#define IDirectInputDevice7_GetForceFeedbackState(p,a) (p)->lpVtbl->GetForceFeedbackState(p,a)
+//#define IDirectInputDevice7_SendForceFeedbackCommand(p,a) (p)->lpVtbl->SendForceFeedbackCommand(p,a)
+//#define IDirectInputDevice7_EnumCreatedEffectObjects(p,a,b,c) (p)->lpVtbl->EnumCreatedEffectObjects(p,a,b,c)
+//#define IDirectInputDevice7_Escape(p,a) (p)->lpVtbl->Escape(p,a)
+//#define IDirectInputDevice7_Poll(p) (p)->lpVtbl->Poll(p)
+//#define IDirectInputDevice7_SendDeviceData(p,a,b,c,d) (p)->lpVtbl->SendDeviceData(p,a,b,c,d)
+//#define IDirectInputDevice7_EnumEffectsInFile(p,a,b,c,d) (p)->lpVtbl->EnumEffectsInFile(p,a,b,c,d)
+//#define IDirectInputDevice7_WriteEffectToFile(p,a,b,c,d) (p)->lpVtbl->WriteEffectToFile(p,a,b,c,d)
+//#else
+//#define IDirectInputDevice7_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInputDevice7_AddRef(p) (p)->AddRef()
+//#define IDirectInputDevice7_Release(p) (p)->Release()
+//#define IDirectInputDevice7_GetCapabilities(p,a) (p)->GetCapabilities(a)
+//#define IDirectInputDevice7_EnumObjects(p,a,b,c) (p)->EnumObjects(a,b,c)
+//#define IDirectInputDevice7_GetProperty(p,a,b) (p)->GetProperty(a,b)
+//#define IDirectInputDevice7_SetProperty(p,a,b) (p)->SetProperty(a,b)
+//#define IDirectInputDevice7_Acquire(p) (p)->Acquire()
+//#define IDirectInputDevice7_Unacquire(p) (p)->Unacquire()
+//#define IDirectInputDevice7_GetDeviceState(p,a,b) (p)->GetDeviceState(a,b)
+//#define IDirectInputDevice7_GetDeviceData(p,a,b,c,d) (p)->GetDeviceData(a,b,c,d)
+//#define IDirectInputDevice7_SetDataFormat(p,a) (p)->SetDataFormat(a)
+//#define IDirectInputDevice7_SetEventNotification(p,a) (p)->SetEventNotification(a)
+//#define IDirectInputDevice7_SetCooperativeLevel(p,a,b) (p)->SetCooperativeLevel(a,b)
+//#define IDirectInputDevice7_GetObjectInfo(p,a,b,c) (p)->GetObjectInfo(a,b,c)
+//#define IDirectInputDevice7_GetDeviceInfo(p,a) (p)->GetDeviceInfo(a)
+//#define IDirectInputDevice7_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInputDevice7_Initialize(p,a,b,c) (p)->Initialize(a,b,c)
+//#define IDirectInputDevice7_CreateEffect(p,a,b,c,d) (p)->CreateEffect(a,b,c,d)
+//#define IDirectInputDevice7_EnumEffects(p,a,b,c) (p)->EnumEffects(a,b,c)
+//#define IDirectInputDevice7_GetEffectInfo(p,a,b) (p)->GetEffectInfo(a,b)
+//#define IDirectInputDevice7_GetForceFeedbackState(p,a) (p)->GetForceFeedbackState(a)
+//#define IDirectInputDevice7_SendForceFeedbackCommand(p,a) (p)->SendForceFeedbackCommand(a)
+//#define IDirectInputDevice7_EnumCreatedEffectObjects(p,a,b,c) (p)->EnumCreatedEffectObjects(a,b,c)
+//#define IDirectInputDevice7_Escape(p,a) (p)->Escape(a)
+//#define IDirectInputDevice7_Poll(p) (p)->Poll()
+//#define IDirectInputDevice7_SendDeviceData(p,a,b,c,d) (p)->SendDeviceData(a,b,c,d)
+//#define IDirectInputDevice7_EnumEffectsInFile(p,a,b,c,d) (p)->EnumEffectsInFile(a,b,c,d)
+//#define IDirectInputDevice7_WriteEffectToFile(p,a,b,c,d) (p)->WriteEffectToFile(a,b,c,d)
+//#endif
+
+//#endif /* DIJ_RINGZERO */
+
+{$ENDIF} { DIRECTINPUT_VERSION >= $0700 }
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+
+//#ifndef DIJ_RINGZERO
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDevice8W
+
+type
+  IDirectInputDevice8W = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDevice8W methods ***)
+    function GetCapabilities(lpDIDevCaps: LPDIDEVCAPS): HRESULT; stdcall;
+    function EnumObjects(lpCallback: LPDIENUMDEVICEOBJECTSCALLBACKW; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPDIPROPHEADER): HRESULT; stdcall;
+    function SetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPCDIPROPHEADER): HRESULT; stdcall;
+    function Acquire: HRESULT; stdcall;
+    function Unacquire: HRESULT; stdcall;
+    function GetDeviceState(cbData: DWORD; lpvData: LPVOID): HRESULT; stdcall;
+    function GetDeviceData(cbObjectData: DWORD; rgdod: LPDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; dwFlags: DWORD): HRESULT; stdcall;
+    function SetDataFormat(lpdf: LPCDIDATAFORMAT): HRESULT; stdcall;
+    function SetEventNotification(hEvent: HANDLE): HRESULT; stdcall;
+    function SetCooperativeLevel(hwnd: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function GetObjectInfo(pdidoi: LPDIDEVICEOBJECTINSTANCEW; dwObj: DWORD; dwHow: DWORD): HRESULT; stdcall;
+    function GetDeviceInfo(pdidi: LPDIDEVICEINSTANCEW): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function CreateEffect(const rguid: TGuid {REFGUID}; lpeff: LPCDIEFFECT; out ppdeff: IDirectInputEffect {LPDIRECTINPUTEFFECT *}; punkOuter: {LPUNKNOWN}IUnknown): HRESULT; stdcall;
+    function EnumEffects(lpCallback: LPDIENUMEFFECTSCALLBACKW; pvRef: LPVOID; dwEffType: DWORD): HRESULT; stdcall;
+    function GetEffectInfo(pdei: LPDIEFFECTINFOW; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function GetForceFeedbackState(pdwOut: LPDWORD): HRESULT; stdcall;
+    function SendForceFeedbackCommand(dwFlags: DWORD): HRESULT; stdcall;
+    function EnumCreatedEffectObjects(lpCallback: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK; pvRef: LPVOID; fl: DWORD): HRESULT; stdcall;
+    function Escape(pesc: LPDIEFFESCAPE): HRESULT; stdcall;
+    function Poll: HRESULT; stdcall;
+    function SendDeviceData(cbObjectData: DWORD; rgdod: LPCDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; fl: DWORD): HRESULT; stdcall;
+    function EnumEffectsInFile(lpszFileName: LPCWSTR; pec: LPDIENUMEFFECTSINFILECALLBACK; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function WriteEffectToFile(lpszFileName: LPCWSTR; dwEntries: DWORD; rgDiFileEft: LPDIFILEEFFECT; dwFlags: DWORD): HRESULT; stdcall;
+    function BuildActionMap(lpdiaf: LPDIACTIONFORMATW; lpszUserName: LPCWSTR; dwFlags: DWORD): HRESULT; stdcall;
+    function SetActionMap(lpdiActionFormat: LPDIACTIONFORMATW; lptszUserName: LPCWSTR; dwFlags: DWORD): HRESULT; stdcall;
+    function GetImageInfo(lpdiDevImageInfoHeader: LPDIDEVICEIMAGEINFOHEADERW): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDevice8W *LPDIRECTINPUTDEVICE8W;
+  LPDIRECTINPUTDEVICE8W = IDirectInputDevice8W;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputDevice8A
+
+  IDirectInputDevice8A = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputDevice8A methods ***)
+    function GetCapabilities(lpDIDevCaps: LPDIDEVCAPS): HRESULT; stdcall;
+    function EnumObjects(lpCallback: LPDIENUMDEVICEOBJECTSCALLBACKA; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPDIPROPHEADER): HRESULT; stdcall;
+    function SetProperty(const rguidProp: TGuid {REFGUID}; pdiph: LPCDIPROPHEADER): HRESULT; stdcall;
+    function Acquire: HRESULT; stdcall;
+    function Unacquire: HRESULT; stdcall;
+    function GetDeviceState(cbData: DWORD; lpvData: LPVOID): HRESULT; stdcall;
+    function GetDeviceData(cbObjectData: DWORD; rgdod: LPDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; dwFlags: DWORD): HRESULT; stdcall;
+    function SetDataFormat(lpdf: LPCDIDATAFORMAT): HRESULT; stdcall;
+    function SetEventNotification(hEvent: HANDLE): HRESULT; stdcall;
+    function SetCooperativeLevel(hwnd: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function GetObjectInfo(pdidoi: LPDIDEVICEOBJECTINSTANCEA; dwObj: DWORD; dwHow: DWORD): HRESULT; stdcall;
+    function GetDeviceInfo(pdidi: LPDIDEVICEINSTANCEA): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function CreateEffect(const rguid: TGuid {REFGUID}; lpeff: LPCDIEFFECT;  out ppdeff: IDirectInputEffect {LPDIRECTINPUTEFFECT *}; punkOuter: {LPUNKNOWN}IUnknown): HRESULT; stdcall;
+    function EnumEffects(lpCallback: LPDIENUMEFFECTSCALLBACKA; pvRef: LPVOID; dwEffType: DWORD): HRESULT; stdcall;
+    function GetEffectInfo(pdei: LPDIEFFECTINFOA; const rguid: TGuid {REFGUID}): HRESULT; stdcall;
+    function GetForceFeedbackState(pdwOut: LPDWORD): HRESULT; stdcall;
+    function SendForceFeedbackCommand(dwFlags: DWORD): HRESULT; stdcall;
+    function EnumCreatedEffectObjects(lpCallback: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK; pvRef: LPVOID; fl: DWORD): HRESULT; stdcall;
+    function Escape(pesc: LPDIEFFESCAPE): HRESULT; stdcall;
+    function Poll: HRESULT; stdcall;
+    function SendDeviceData(cbObjectData: DWORD; rgdod: LPCDIDEVICEOBJECTDATA; pdwInOut: LPDWORD; fl: DWORD): HRESULT; stdcall;
+    function EnumEffectsInFile(lpszFileName: LPCSTR; pec: LPDIENUMEFFECTSINFILECALLBACK; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function WriteEffectToFile(lpszFileName: LPCSTR; dwEntries: DWORD; rgDiFileEft: LPDIFILEEFFECT; dwFlags: DWORD): HRESULT; stdcall;
+    function BuildActionMap(lpdiaf: LPDIACTIONFORMATA; lpszUserName: LPCSTR; dwFlags: DWORD): HRESULT; stdcall;
+    function SetActionMap(lpdiActionFormat: LPDIACTIONFORMATA; lptszUserName: LPCSTR; dwFlags: DWORD): HRESULT; stdcall;
+    function GetImageInfo(lpdiDevImageInfoHeader: LPDIDEVICEIMAGEINFOHEADERA): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputDevice8A *LPDIRECTINPUTDEVICE8A;
+  LPDIRECTINPUTDEVICE8A = IDirectInputDevice8A;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInputDevice8: TIID = '{54D41081-DC15-4833-A41B-748F73A38179}'{IID_IDirectInputDevice8W};
+type
+  IDirectInputDevice8 = IDirectInputDevice8W;
+{$ELSE}
+const
+  IID_IDirectInputDevice8: TIID = '{54D41080-DC15-4833-A41B-748F73A38179}'{IID_IDirectInputDevice8A};
+type
+  IDirectInputDevice8 = IDirectInputDevice8A;
+{$ENDIF}
+//typedef struct IDirectInputDevice8 *LPDIRECTINPUTDEVICE8;
+  LPDIRECTINPUTDEVICE8 = IDirectInputDevice8;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInputDevice8_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInputDevice8_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInputDevice8_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInputDevice8_GetCapabilities(p,a) (p)->lpVtbl->GetCapabilities(p,a)
+//#define IDirectInputDevice8_EnumObjects(p,a,b,c) (p)->lpVtbl->EnumObjects(p,a,b,c)
+//#define IDirectInputDevice8_GetProperty(p,a,b) (p)->lpVtbl->GetProperty(p,a,b)
+//#define IDirectInputDevice8_SetProperty(p,a,b) (p)->lpVtbl->SetProperty(p,a,b)
+//#define IDirectInputDevice8_Acquire(p) (p)->lpVtbl->Acquire(p)
+//#define IDirectInputDevice8_Unacquire(p) (p)->lpVtbl->Unacquire(p)
+//#define IDirectInputDevice8_GetDeviceState(p,a,b) (p)->lpVtbl->GetDeviceState(p,a,b)
+//#define IDirectInputDevice8_GetDeviceData(p,a,b,c,d) (p)->lpVtbl->GetDeviceData(p,a,b,c,d)
+//#define IDirectInputDevice8_SetDataFormat(p,a) (p)->lpVtbl->SetDataFormat(p,a)
+//#define IDirectInputDevice8_SetEventNotification(p,a) (p)->lpVtbl->SetEventNotification(p,a)
+//#define IDirectInputDevice8_SetCooperativeLevel(p,a,b) (p)->lpVtbl->SetCooperativeLevel(p,a,b)
+//#define IDirectInputDevice8_GetObjectInfo(p,a,b,c) (p)->lpVtbl->GetObjectInfo(p,a,b,c)
+//#define IDirectInputDevice8_GetDeviceInfo(p,a) (p)->lpVtbl->GetDeviceInfo(p,a)
+//#define IDirectInputDevice8_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInputDevice8_Initialize(p,a,b,c) (p)->lpVtbl->Initialize(p,a,b,c)
+//#define IDirectInputDevice8_CreateEffect(p,a,b,c,d) (p)->lpVtbl->CreateEffect(p,a,b,c,d)
+//#define IDirectInputDevice8_EnumEffects(p,a,b,c) (p)->lpVtbl->EnumEffects(p,a,b,c)
+//#define IDirectInputDevice8_GetEffectInfo(p,a,b) (p)->lpVtbl->GetEffectInfo(p,a,b)
+//#define IDirectInputDevice8_GetForceFeedbackState(p,a) (p)->lpVtbl->GetForceFeedbackState(p,a)
+//#define IDirectInputDevice8_SendForceFeedbackCommand(p,a) (p)->lpVtbl->SendForceFeedbackCommand(p,a)
+//#define IDirectInputDevice8_EnumCreatedEffectObjects(p,a,b,c) (p)->lpVtbl->EnumCreatedEffectObjects(p,a,b,c)
+//#define IDirectInputDevice8_Escape(p,a) (p)->lpVtbl->Escape(p,a)
+//#define IDirectInputDevice8_Poll(p) (p)->lpVtbl->Poll(p)
+//#define IDirectInputDevice8_SendDeviceData(p,a,b,c,d) (p)->lpVtbl->SendDeviceData(p,a,b,c,d)
+//#define IDirectInputDevice8_EnumEffectsInFile(p,a,b,c,d) (p)->lpVtbl->EnumEffectsInFile(p,a,b,c,d)
+//#define IDirectInputDevice8_WriteEffectToFile(p,a,b,c,d) (p)->lpVtbl->WriteEffectToFile(p,a,b,c,d)
+//#define IDirectInputDevice8_BuildActionMap(p,a,b,c) (p)->lpVtbl->BuildActionMap(p,a,b,c)
+//#define IDirectInputDevice8_SetActionMap(p,a,b,c) (p)->lpVtbl->SetActionMap(p,a,b,c)
+//#define IDirectInputDevice8_GetImageInfo(p,a) (p)->lpVtbl->GetImageInfo(p,a)
+//#else
+//#define IDirectInputDevice8_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInputDevice8_AddRef(p) (p)->AddRef()
+//#define IDirectInputDevice8_Release(p) (p)->Release()
+//#define IDirectInputDevice8_GetCapabilities(p,a) (p)->GetCapabilities(a)
+//#define IDirectInputDevice8_EnumObjects(p,a,b,c) (p)->EnumObjects(a,b,c)
+//#define IDirectInputDevice8_GetProperty(p,a,b) (p)->GetProperty(a,b)
+//#define IDirectInputDevice8_SetProperty(p,a,b) (p)->SetProperty(a,b)
+//#define IDirectInputDevice8_Acquire(p) (p)->Acquire()
+//#define IDirectInputDevice8_Unacquire(p) (p)->Unacquire()
+//#define IDirectInputDevice8_GetDeviceState(p,a,b) (p)->GetDeviceState(a,b)
+//#define IDirectInputDevice8_GetDeviceData(p,a,b,c,d) (p)->GetDeviceData(a,b,c,d)
+//#define IDirectInputDevice8_SetDataFormat(p,a) (p)->SetDataFormat(a)
+//#define IDirectInputDevice8_SetEventNotification(p,a) (p)->SetEventNotification(a)
+//#define IDirectInputDevice8_SetCooperativeLevel(p,a,b) (p)->SetCooperativeLevel(a,b)
+//#define IDirectInputDevice8_GetObjectInfo(p,a,b,c) (p)->GetObjectInfo(a,b,c)
+//#define IDirectInputDevice8_GetDeviceInfo(p,a) (p)->GetDeviceInfo(a)
+//#define IDirectInputDevice8_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInputDevice8_Initialize(p,a,b,c) (p)->Initialize(a,b,c)
+//#define IDirectInputDevice8_CreateEffect(p,a,b,c,d) (p)->CreateEffect(a,b,c,d)
+//#define IDirectInputDevice8_EnumEffects(p,a,b,c) (p)->EnumEffects(a,b,c)
+//#define IDirectInputDevice8_GetEffectInfo(p,a,b) (p)->GetEffectInfo(a,b)
+//#define IDirectInputDevice8_GetForceFeedbackState(p,a) (p)->GetForceFeedbackState(a)
+//#define IDirectInputDevice8_SendForceFeedbackCommand(p,a) (p)->SendForceFeedbackCommand(a)
+//#define IDirectInputDevice8_EnumCreatedEffectObjects(p,a,b,c) (p)->EnumCreatedEffectObjects(a,b,c)
+//#define IDirectInputDevice8_Escape(p,a) (p)->Escape(a)
+//#define IDirectInputDevice8_Poll(p) (p)->Poll()
+//#define IDirectInputDevice8_SendDeviceData(p,a,b,c,d) (p)->SendDeviceData(a,b,c,d)
+//#define IDirectInputDevice8_EnumEffectsInFile(p,a,b,c,d) (p)->EnumEffectsInFile(a,b,c,d)
+//#define IDirectInputDevice8_WriteEffectToFile(p,a,b,c,d) (p)->WriteEffectToFile(a,b,c,d)
+//#define IDirectInputDevice8_BuildActionMap(p,a,b,c) (p)->BuildActionMap(a,b,c)
+//#define IDirectInputDevice8_SetActionMap(p,a,b,c) (p)->SetActionMap(a,b,c)
+//#define IDirectInputDevice8_GetImageInfo(p,a) (p)->GetImageInfo(a)
+//#endif
+
+//#endif /* DIJ_RINGZERO */
+
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+(****************************************************************************
+ *
+ *      Mouse
+ *
+ ****************************************************************************)
+
+//#ifndef DIJ_RINGZERO
+
+type
+  LPDIMOUSESTATE = ^TDIMOUSESTATE;
+  PDIMOUSESTATE = ^TDIMOUSESTATE;
+  TDIMOUSESTATE = record
+    lX: LONG;
+    lY: LONG;
+    lZ: LONG;
+    rgbButtons: array [0..3] of BYTE;
+  end;
+
+{$IF DIRECTINPUT_VERSION >= $0700}
+  LPDIMOUSESTATE2 = ^TDIMOUSESTATE2;
+  PDIMOUSESTATE2 = ^TDIMOUSESTATE2;
+  TDIMOUSESTATE2 = record
+    lX: LONG;
+    lY: LONG;
+    lZ: LONG;
+    rgbButtons: array [0..7] of BYTE;
+  end;
+{$ENDIF}
+
+
+//const
+//  DIMOFS_X: LONG       =  Ofs(PDIMOUSESTATE(nil)^.lX); { FIELD_OFFSET(DIMOUSESTATE, lX)}
+{  DIMOFS_Y       =  FIELD_OFFSET(DIMOUSESTATE, lY);
+  DIMOFS_Z       =  FIELD_OFFSET(DIMOUSESTATE, lZ);
+  DIMOFS_BUTTON0 = (FIELD_OFFSET(DIMOUSESTATE, rgbButtons) + 0);
+  DIMOFS_BUTTON1 = (FIELD_OFFSET(DIMOUSESTATE, rgbButtons) + 1);
+  DIMOFS_BUTTON2 = (FIELD_OFFSET(DIMOUSESTATE, rgbButtons) + 2);
+  DIMOFS_BUTTON3 = (FIELD_OFFSET(DIMOUSESTATE, rgbButtons) + 3);}
+{$IF DIRECTINPUT_VERSION >= $0700}
+{  DIMOFS_BUTTON4 = (FIELD_OFFSET(DIMOUSESTATE2, rgbButtons) + 4);
+  DIMOFS_BUTTON5 = (FIELD_OFFSET(DIMOUSESTATE2, rgbButtons) + 5);
+  DIMOFS_BUTTON6 = (FIELD_OFFSET(DIMOUSESTATE2, rgbButtons) + 6);
+  DIMOFS_BUTTON7 = (FIELD_OFFSET(DIMOUSESTATE2, rgbButtons) + 7);}
+{$ENDIF}
+//#endif /* DIJ_RINGZERO */
+
+(****************************************************************************
+ *
+ *      Keyboard
+ *
+ ****************************************************************************)
+
+//#ifndef DIJ_RINGZERO
+
+(****************************************************************************
+ *
+ *      DirectInput keyboard scan codes
+ *
+ ****************************************************************************)
+//
+//    Copyright (C) Microsoft.  All rights reserved.
+//
+const
+  DIK_ESCAPE          = $01;
+  DIK_1               = $02;
+  DIK_2               = $03;
+  DIK_3               = $04;
+  DIK_4               = $05;
+  DIK_5               = $06;
+  DIK_6               = $07;
+  DIK_7               = $08;
+  DIK_8               = $09;
+  DIK_9               = $0A;
+  DIK_0               = $0B;
+  DIK_MINUS           = $0C;    { - on main keyboard }
+  DIK_EQUALS          = $0D;
+  DIK_BACK            = $0E;    { backspace }
+  DIK_TAB             = $0F;
+  DIK_Q               = $10;
+  DIK_W               = $11;
+  DIK_E               = $12;
+  DIK_R               = $13;
+  DIK_T               = $14;
+  DIK_Y               = $15;
+  DIK_U               = $16;
+  DIK_I               = $17;
+  DIK_O               = $18;
+  DIK_P               = $19;
+  DIK_LBRACKET        = $1A;
+  DIK_RBRACKET        = $1B;
+  DIK_RETURN          = $1C;    { Enter on main keyboard }
+  DIK_LCONTROL        = $1D;
+  DIK_A               = $1E;
+  DIK_S               = $1F;
+  DIK_D               = $20;
+  DIK_F               = $21;
+  DIK_G               = $22;
+  DIK_H               = $23;
+  DIK_J               = $24;
+  DIK_K               = $25;
+  DIK_L               = $26;
+  DIK_SEMICOLON       = $27;
+  DIK_APOSTROPHE      = $28;
+  DIK_GRAVE           = $29;    { accent grave }
+  DIK_LSHIFT          = $2A;
+  DIK_BACKSLASH       = $2B;
+  DIK_Z               = $2C;
+  DIK_X               = $2D;
+  DIK_C               = $2E;
+  DIK_V               = $2F;
+  DIK_B               = $30;
+  DIK_N               = $31;
+  DIK_M               = $32;
+  DIK_COMMA           = $33;
+  DIK_PERIOD          = $34;    { . on main keyboard }
+  DIK_SLASH           = $35;    { / on main keyboard }
+  DIK_RSHIFT          = $36;
+  DIK_MULTIPLY        = $37;    { * on numeric keypad }
+  DIK_LMENU           = $38;    { left Alt }
+  DIK_SPACE           = $39;
+  DIK_CAPITAL         = $3A;
+  DIK_F1              = $3B;
+  DIK_F2              = $3C;
+  DIK_F3              = $3D;
+  DIK_F4              = $3E;
+  DIK_F5              = $3F;
+  DIK_F6              = $40;
+  DIK_F7              = $41;
+  DIK_F8              = $42;
+  DIK_F9              = $43;
+  DIK_F10             = $44;
+  DIK_NUMLOCK         = $45;
+  DIK_SCROLL          = $46;    { Scroll Lock }
+  DIK_NUMPAD7         = $47;
+  DIK_NUMPAD8         = $48;
+  DIK_NUMPAD9         = $49;
+  DIK_SUBTRACT        = $4A;    { - on numeric keypad }
+  DIK_NUMPAD4         = $4B;
+  DIK_NUMPAD5         = $4C;
+  DIK_NUMPAD6         = $4D;
+  DIK_ADD             = $4E;    { + on numeric keypad }
+  DIK_NUMPAD1         = $4F;
+  DIK_NUMPAD2         = $50;
+  DIK_NUMPAD3         = $51;
+  DIK_NUMPAD0         = $52;
+  DIK_DECIMAL         = $53;    { . on numeric keypad }
+  DIK_OEM_102         = $56;    { <> or \| on RT 102-key keyboard (Non-U.S.) }
+  DIK_F11             = $57;
+  DIK_F12             = $58;
+  DIK_F13             = $64;    {                     (NEC PC98) }
+  DIK_F14             = $65;    {                     (NEC PC98) }
+  DIK_F15             = $66;    {                     (NEC PC98) }
+  DIK_KANA            = $70;    { (Japanese keyboard)            }
+  DIK_ABNT_C1         = $73;    { /? on Brazilian keyboard }
+  DIK_CONVERT         = $79;    { (Japanese keyboard)            }
+  DIK_NOCONVERT       = $7B;    { (Japanese keyboard)            }
+  DIK_YEN             = $7D;    { (Japanese keyboard)            }
+  DIK_ABNT_C2         = $7E;    { Numpad . on Brazilian keyboard }
+  DIK_NUMPADEQUALS    = $8D;    { = on numeric keypad (NEC PC98) }
+  DIK_PREVTRACK       = $90;    { Previous Track (DIK_CIRCUMFLEX on Japanese keyboard) }
+  DIK_AT              = $91;    {                     (NEC PC98) }
+  DIK_COLON           = $92;    {                     (NEC PC98) }
+  DIK_UNDERLINE       = $93;    {                     (NEC PC98) }
+  DIK_KANJI           = $94;    { (Japanese keyboard)            }
+  DIK_STOP            = $95;    {                     (NEC PC98) }
+  DIK_AX              = $96;    {                     (Japan AX) }
+  DIK_UNLABELED       = $97;    {                        (J3100) }
+  DIK_NEXTTRACK       = $99;    { Next Track }
+  DIK_NUMPADENTER     = $9C;    { Enter on numeric keypad }
+  DIK_RCONTROL        = $9D;
+  DIK_MUTE            = $A0;    { Mute }
+  DIK_CALCULATOR      = $A1;    { Calculator }
+  DIK_PLAYPAUSE       = $A2;    { Play / Pause }
+  DIK_MEDIASTOP       = $A4;    { Media Stop }
+  DIK_VOLUMEDOWN      = $AE;    { Volume - }
+  DIK_VOLUMEUP        = $B0;    { Volume + }
+  DIK_WEBHOME         = $B2;    { Web home }
+  DIK_NUMPADCOMMA     = $B3;    { , on numeric keypad (NEC PC98) }
+  DIK_DIVIDE          = $B5;    { / on numeric keypad }
+  DIK_SYSRQ           = $B7;
+  DIK_RMENU           = $B8;    { right Alt }
+  DIK_PAUSE           = $C5;    { Pause }
+  DIK_HOME            = $C7;    { Home on arrow keypad }
+  DIK_UP              = $C8;    { UpArrow on arrow keypad }
+  DIK_PRIOR           = $C9;    { PgUp on arrow keypad }
+  DIK_LEFT            = $CB;    { LeftArrow on arrow keypad }
+  DIK_RIGHT           = $CD;    { RightArrow on arrow keypad }
+  DIK_END             = $CF;    { End on arrow keypad }
+  DIK_DOWN            = $D0;    { DownArrow on arrow keypad }
+  DIK_NEXT            = $D1;    { PgDn on arrow keypad }
+  DIK_INSERT          = $D2;    { Insert on arrow keypad }
+  DIK_DELETE          = $D3;    { Delete on arrow keypad }
+  DIK_LWIN            = $DB;    { Left Windows key }
+  DIK_RWIN            = $DC;    { Right Windows key }
+  DIK_APPS            = $DD;    { AppMenu key }
+  DIK_POWER           = $DE;    { System Power }
+  DIK_SLEEP           = $DF;    { System Sleep }
+  DIK_WAKE            = $E3;    { System Wake }
+  DIK_WEBSEARCH       = $E5;    { Web Search }
+  DIK_WEBFAVORITES    = $E6;    { Web Favorites }
+  DIK_WEBREFRESH      = $E7;    { Web Refresh }
+  DIK_WEBSTOP         = $E8;    { Web Stop }
+  DIK_WEBFORWARD      = $E9;    { Web Forward }
+  DIK_WEBBACK         = $EA;    { Web Back }
+  DIK_MYCOMPUTER      = $EB;    { My Computer }
+  DIK_MAIL            = $EC;    { Mail }
+  DIK_MEDIASELECT     = $ED;    { Media Select }
+
+(*
+ *  Alternate names for keys, to facilitate transition from DOS.
+ *)
+  DIK_BACKSPACE       = DIK_BACK;            { backspace }
+  DIK_NUMPADSTAR      = DIK_MULTIPLY;        { * on numeric keypad }
+  DIK_LALT            = DIK_LMENU;           { left Alt }
+  DIK_CAPSLOCK        = DIK_CAPITAL;         { CapsLock }
+  DIK_NUMPADMINUS     = DIK_SUBTRACT;        { - on numeric keypad }
+  DIK_NUMPADPLUS      = DIK_ADD;             { + on numeric keypad }
+  DIK_NUMPADPERIOD    = DIK_DECIMAL;         { . on numeric keypad }
+  DIK_NUMPADSLASH     = DIK_DIVIDE;          { / on numeric keypad }
+  DIK_RALT            = DIK_RMENU;           { right Alt }
+  DIK_UPARROW         = DIK_UP;              { UpArrow on arrow keypad }
+  DIK_PGUP            = DIK_PRIOR;           { PgUp on arrow keypad }
+  DIK_LEFTARROW       = DIK_LEFT;            { LeftArrow on arrow keypad }
+  DIK_RIGHTARROW      = DIK_RIGHT;           { RightArrow on arrow keypad }
+  DIK_DOWNARROW       = DIK_DOWN;            { DownArrow on arrow keypad }
+  DIK_PGDN            = DIK_NEXT;            { PgDn on arrow keypad }
+
+(*
+ *  Alternate names for keys originally not used on US keyboards.
+ *)
+  DIK_CIRCUMFLEX      = DIK_PREVTRACK;       { Japanese keyboard }
+
+//#endif /* DIJ_RINGZERO */
+
+(****************************************************************************
+ *
+ *      Joystick
+ *
+ ****************************************************************************)
+
+//#ifndef DIJ_RINGZERO
+
+type
+  LPDIJOYSTATE = ^TDIJOYSTATE;
+  PDIJOYSTATE = ^TDIJOYSTATE;
+  TDIJOYSTATE = record
+    lX: LONG;                            { x-axis position              }
+    lY: LONG;                            { y-axis position              }
+    lZ: LONG;                            { z-axis position              }
+    lRx: LONG;                           { x-axis rotation              }
+    lRy: LONG;                           { y-axis rotation              }
+    lRz: LONG;                           { z-axis rotation              }
+    rglSlider: array [0..1] of LONG;     { extra axes positions         }
+    rgdwPOV: array [0..3] of DWORD;      { POV directions               }
+    rgbButtons: array [0..31] of BYTE;   { 32 buttons                   }
+  end;
+
+  LPDIJOYSTATE2 = ^TDIJOYSTATE2;
+  PDIJOYSTATE2 = ^TDIJOYSTATE2;
+  TDIJOYSTATE2 = record
+    lX: LONG;                            { x-axis position              }
+    lY: LONG;                            { y-axis position              }
+    lZ: LONG;                            { z-axis position              }
+    lRx: LONG;                           { x-axis rotation              }
+    lRy: LONG;                           { y-axis rotation              }
+    lRz: LONG;                           { z-axis rotation              }
+    rglSlider: array [0..1] of LONG;     { extra axes positions         }
+    rgdwPOV: array [0..3] of DWORD;      { POV directions               }
+    rgbButtons: array [0..127] of BYTE;  { 128 buttons                  }
+    lVX: LONG;                           { x-axis velocity              }
+    lVY: LONG;                           { y-axis velocity              }
+    lVZ: LONG;                           { z-axis velocity              }
+    lVRx: LONG;                          { x-axis angular velocity      }
+    lVRy: LONG;                          { y-axis angular velocity      }
+    lVRz: LONG;                          { z-axis angular velocity      }
+    rglVSlider: array [0..1] of LONG;    { extra axes velocities        }
+    lAX: LONG;                           { x-axis acceleration          }
+    lAY: LONG;                           { y-axis acceleration          }
+    lAZ: LONG;                           { z-axis acceleration          }
+    lARx: LONG;                          { x-axis angular acceleration  }
+    lARy: LONG;                          { y-axis angular acceleration  }
+    lARz: LONG;                          { z-axis angular acceleration  }
+    rglASlider: array [0..1] of LONG;    { extra axes accelerations     }
+    lFX: LONG;                           { x-axis force                 }
+    lFY: LONG;                           { y-axis force                 }
+    lFZ: LONG;                           { z-axis force                 }
+    lFRx: LONG;                          { x-axis torque                }
+    lFRy: LONG;                          { y-axis torque                }
+    lFRz: LONG;                          { z-axis torque                }
+    rglFSlider: array [0..1] of LONG;    { extra axes forces            }
+  end;
+
+(*#define DIJOFS_X            FIELD_OFFSET(DIJOYSTATE, lX)
+#define DIJOFS_Y            FIELD_OFFSET(DIJOYSTATE, lY)
+#define DIJOFS_Z            FIELD_OFFSET(DIJOYSTATE, lZ)
+#define DIJOFS_RX           FIELD_OFFSET(DIJOYSTATE, lRx)
+#define DIJOFS_RY           FIELD_OFFSET(DIJOYSTATE, lRy)
+#define DIJOFS_RZ           FIELD_OFFSET(DIJOYSTATE, lRz)
+#define DIJOFS_SLIDER(n)   (FIELD_OFFSET(DIJOYSTATE, rglSlider) + \
+                                                        (n) * sizeof(LONG))
+#define DIJOFS_POV(n)      (FIELD_OFFSET(DIJOYSTATE, rgdwPOV) + \
+                                                        (n) * sizeof(DWORD))
+#define DIJOFS_BUTTON(n)   (FIELD_OFFSET(DIJOYSTATE, rgbButtons) + (n))
+#define DIJOFS_BUTTON0      DIJOFS_BUTTON(0)
+#define DIJOFS_BUTTON1      DIJOFS_BUTTON(1)
+#define DIJOFS_BUTTON2      DIJOFS_BUTTON(2)
+#define DIJOFS_BUTTON3      DIJOFS_BUTTON(3)
+#define DIJOFS_BUTTON4      DIJOFS_BUTTON(4)
+#define DIJOFS_BUTTON5      DIJOFS_BUTTON(5)
+#define DIJOFS_BUTTON6      DIJOFS_BUTTON(6)
+#define DIJOFS_BUTTON7      DIJOFS_BUTTON(7)
+#define DIJOFS_BUTTON8      DIJOFS_BUTTON(8)
+#define DIJOFS_BUTTON9      DIJOFS_BUTTON(9)
+#define DIJOFS_BUTTON10     DIJOFS_BUTTON(10)
+#define DIJOFS_BUTTON11     DIJOFS_BUTTON(11)
+#define DIJOFS_BUTTON12     DIJOFS_BUTTON(12)
+#define DIJOFS_BUTTON13     DIJOFS_BUTTON(13)
+#define DIJOFS_BUTTON14     DIJOFS_BUTTON(14)
+#define DIJOFS_BUTTON15     DIJOFS_BUTTON(15)
+#define DIJOFS_BUTTON16     DIJOFS_BUTTON(16)
+#define DIJOFS_BUTTON17     DIJOFS_BUTTON(17)
+#define DIJOFS_BUTTON18     DIJOFS_BUTTON(18)
+#define DIJOFS_BUTTON19     DIJOFS_BUTTON(19)
+#define DIJOFS_BUTTON20     DIJOFS_BUTTON(20)
+#define DIJOFS_BUTTON21     DIJOFS_BUTTON(21)
+#define DIJOFS_BUTTON22     DIJOFS_BUTTON(22)
+#define DIJOFS_BUTTON23     DIJOFS_BUTTON(23)
+#define DIJOFS_BUTTON24     DIJOFS_BUTTON(24)
+#define DIJOFS_BUTTON25     DIJOFS_BUTTON(25)
+#define DIJOFS_BUTTON26     DIJOFS_BUTTON(26)
+#define DIJOFS_BUTTON27     DIJOFS_BUTTON(27)
+#define DIJOFS_BUTTON28     DIJOFS_BUTTON(28)
+#define DIJOFS_BUTTON29     DIJOFS_BUTTON(29)
+#define DIJOFS_BUTTON30     DIJOFS_BUTTON(30)
+#define DIJOFS_BUTTON31     DIJOFS_BUTTON(31)*)
+
+
+//#endif /* DIJ_RINGZERO */
+
+(****************************************************************************
+ *
+ *  IDirectInput
+ *
+ ****************************************************************************)
+
+//#ifndef DIJ_RINGZERO
+
+const
+  DIENUM_STOP           = 0;
+  DIENUM_CONTINUE       = 1;
+
+type
+  LPDIENUMDEVICESCALLBACKA = function(lpddi: LPCDIDEVICEINSTANCEA; pvRef: LPVOID): BOOL; stdcall;
+  LPDIENUMDEVICESCALLBACKW = function(lpddi: LPCDIDEVICEINSTANCEW; pvRef: LPVOID): BOOL; stdcall;
+{$IFDEF UNICODE}
+  LPDIENUMDEVICESCALLBACK = LPDIENUMDEVICESCALLBACKW;
+{$ELSE}
+  LPDIENUMDEVICESCALLBACK = LPDIENUMDEVICESCALLBACKA;
+{$ENDIF} // !UNICODE
+  LPDICONFIGUREDEVICESCALLBACK = function(lpDDSTarget: {IUnknown FAR *}IUnknown; pvRef: LPVOID): BOOL; stdcall;
+
+const
+  DIEDFL_ALLDEVICES      = $00000000;
+  DIEDFL_ATTACHEDONLY    = $00000001;
+{$IF DIRECTINPUT_VERSION >= $0500}
+  DIEDFL_FORCEFEEDBACK   = $00000100;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0500 }
+{$IF DIRECTINPUT_VERSION >= $050a}
+  DIEDFL_INCLUDEALIASES  = $00010000;
+  DIEDFL_INCLUDEPHANTOMS = $00020000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+{$IF DIRECTINPUT_VERSION >= $0800}
+  DIEDFL_INCLUDEHIDDEN   = $00040000;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+type
+  LPDIENUMDEVICESBYSEMANTICSCBA = function(lpddi: LPCDIDEVICEINSTANCEA; lpdid: LPDIRECTINPUTDEVICE8A; dwFlags: DWORD; dwRemaining: DWORD; pvRef: LPVOID): BOOL; stdcall;
+  LPDIENUMDEVICESBYSEMANTICSCBW = function(lpddi: LPCDIDEVICEINSTANCEW; lpdid: LPDIRECTINPUTDEVICE8W; dwFlags: DWORD; dwRemaining: DWORD; pvRef: LPVOID): BOOL; stdcall;
+{$IFDEF UNICODE}
+  LPDIENUMDEVICESBYSEMANTICSCB = LPDIENUMDEVICESBYSEMANTICSCBW;
+{$ELSE}
+  LPDIENUMDEVICESBYSEMANTICSCB = LPDIENUMDEVICESBYSEMANTICSCBA;
+{$ENDIF} // !UNICODE
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+const
+  DIEDBS_MAPPEDPRI1        = $00000001;
+  DIEDBS_MAPPEDPRI2        = $00000002;
+  DIEDBS_RECENTDEVICE      = $00000010;
+  DIEDBS_NEWDEVICE         = $00000020;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+const
+  DIEDBSFL_ATTACHEDONLY       = $00000000;
+  DIEDBSFL_THISUSER           = $00000010;
+  DIEDBSFL_FORCEFEEDBACK      = DIEDFL_FORCEFEEDBACK;
+  DIEDBSFL_AVAILABLEDEVICES   = $00001000;
+  DIEDBSFL_MULTIMICEKEYBOARDS = $00002000;
+  DIEDBSFL_NONGAMINGDEVICES   = $00004000;
+  DIEDBSFL_VALID              = $00007110;
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputW
+
+type
+  IDirectInputW = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputW methods ***)
+    function CreateDevice(const rguid: TGuid; out lplpDirectInputDevice: IDirectInputDeviceW; pUnkOuter: IUnknown): HRESULT; stdcall;
+    function EnumDevices(dwDevType: DWORD; lpCallback: LPDIENUMDEVICESCALLBACKW; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetDeviceStatus(const rguidInstance: TGuid): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD): HRESULT; stdcall;
+  end;
+
+//  typedef struct IDirectInputW *LPDIRECTINPUTW;
+  LPDIRECTINPUTW = IDirectInputW;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInputA
+
+  IDirectInputA = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputA methods ***)
+    function CreateDevice(const rguid: TGuid; out lplpDirectInputDevice: IDirectInputDeviceA; pUnkOuter: IUnknown): HRESULT; stdcall;
+    function EnumDevices(dwDevType: DWORD; lpCallback: LPDIENUMDEVICESCALLBACKA; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetDeviceStatus(const rguidInstance: TGuid): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInputA *LPDIRECTINPUTA;
+  LPDIRECTINPUTA = IDirectInputA;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInput: TIID = {IID_IDirectInputW}'{89521361-AA8A-11CF-BFC7-444553540000}';
+type
+  IDirectInput = IDirectInputW;
+{$ELSE}
+const
+  IID_IDirectInput: TIID = {IID_IDirectInputA}'{89521360-AA8A-11CF-BFC7-444553540000}';
+type
+  IDirectInput = IDirectInputA;
+{$ENDIF}
+//typedef struct IDirectInput *LPDIRECTINPUT;
+  LPDIRECTINPUT = IDirectInput;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInput_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInput_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInput_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInput_CreateDevice(p,a,b,c) (p)->lpVtbl->CreateDevice(p,a,b,c)
+//#define IDirectInput_EnumDevices(p,a,b,c,d) (p)->lpVtbl->EnumDevices(p,a,b,c,d)
+//#define IDirectInput_GetDeviceStatus(p,a) (p)->lpVtbl->GetDeviceStatus(p,a)
+//#define IDirectInput_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInput_Initialize(p,a,b) (p)->lpVtbl->Initialize(p,a,b)
+//#else
+//#define IDirectInput_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInput_AddRef(p) (p)->AddRef()
+//#define IDirectInput_Release(p) (p)->Release()
+//#define IDirectInput_CreateDevice(p,a,b,c) (p)->CreateDevice(a,b,c)
+//#define IDirectInput_EnumDevices(p,a,b,c,d) (p)->EnumDevices(a,b,c,d)
+//#define IDirectInput_GetDeviceStatus(p,a) (p)->GetDeviceStatus(a)
+//#define IDirectInput_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInput_Initialize(p,a,b) (p)->Initialize(a,b)
+//#endif
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInput2W
+
+type
+  IDirectInput2W = interface(IDirectInputW)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputW methods ***)
+    {STDMETHOD(CreateDevice)(THIS_ REFGUID,LPDIRECTINPUTDEVICEW *,LPUNKNOWN) PURE;
+    STDMETHOD(EnumDevices)(THIS_ DWORD,LPDIENUMDEVICESCALLBACKW,LPVOID,DWORD) PURE;
+    STDMETHOD(GetDeviceStatus)(THIS_ REFGUID) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD) PURE;}
+
+    (*** IDirectInput2W methods ***)
+    function FindDevice(const rguidClass: TGuid; ptszName: LPCWSTR; pguidInstance: LPGUID): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInput2W *LPDIRECTINPUT2W;
+  LPDIRECTINPUT2W = IDirectInput2W;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInput2A
+
+  IDirectInput2A = interface(IDirectInputA)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInputA methods ***)
+    {STDMETHOD(CreateDevice)(THIS_ REFGUID,LPDIRECTINPUTDEVICEA *,LPUNKNOWN) PURE;
+    STDMETHOD(EnumDevices)(THIS_ DWORD,LPDIENUMDEVICESCALLBACKA,LPVOID,DWORD) PURE;
+    STDMETHOD(GetDeviceStatus)(THIS_ REFGUID) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD) PURE;}
+
+    (*** IDirectInput2A methods ***)
+    function FindDevice(const rguidClass: TGuid; ptszName: LPCSTR; pguidInstance: LPGUID): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInput2A *LPDIRECTINPUT2A;
+  LPDIRECTINPUT2A = IDirectInput2A;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInput2: TIID = {IID_IDirectInput2W}'{5944E663-AA8A-11CF-BFC7-444553540000}';
+type
+  IDirectInput2 = IDirectInput2W;
+{$ELSE}
+const
+  IID_IDirectInput2: TIID = {IID_IDirectInput2A}'{5944E662-AA8A-11CF-BFC7-444553540000}';
+type
+  IDirectInput2 = IDirectInput2A;
+{$ENDIF}
+//typedef struct IDirectInput2 *LPDIRECTINPUT2;
+  LPDIRECTINPUT2 = IDirectInput2;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInput2_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInput2_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInput2_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInput2_CreateDevice(p,a,b,c) (p)->lpVtbl->CreateDevice(p,a,b,c)
+//#define IDirectInput2_EnumDevices(p,a,b,c,d) (p)->lpVtbl->EnumDevices(p,a,b,c,d)
+//#define IDirectInput2_GetDeviceStatus(p,a) (p)->lpVtbl->GetDeviceStatus(p,a)
+//#define IDirectInput2_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInput2_Initialize(p,a,b) (p)->lpVtbl->Initialize(p,a,b)
+//#define IDirectInput2_FindDevice(p,a,b,c) (p)->lpVtbl->FindDevice(p,a,b,c)
+//#else
+//#define IDirectInput2_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInput2_AddRef(p) (p)->AddRef()
+//#define IDirectInput2_Release(p) (p)->Release()
+//#define IDirectInput2_CreateDevice(p,a,b,c) (p)->CreateDevice(a,b,c)
+//#define IDirectInput2_EnumDevices(p,a,b,c,d) (p)->EnumDevices(a,b,c,d)
+//#define IDirectInput2_GetDeviceStatus(p,a) (p)->GetDeviceStatus(a)
+//#define IDirectInput2_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInput2_Initialize(p,a,b) (p)->Initialize(a,b)
+//#define IDirectInput2_FindDevice(p,a,b,c) (p)->FindDevice(a,b,c)
+//#endif
+
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInput7W
+
+type
+  IDirectInput7W = interface(IDirectInput2W)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInput2W methods ***)
+    {STDMETHOD(CreateDevice)(THIS_ REFGUID,LPDIRECTINPUTDEVICEW *,LPUNKNOWN) PURE;
+    STDMETHOD(EnumDevices)(THIS_ DWORD,LPDIENUMDEVICESCALLBACKW,LPVOID,DWORD) PURE;
+    STDMETHOD(GetDeviceStatus)(THIS_ REFGUID) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD) PURE;
+    STDMETHOD(FindDevice)(THIS_ REFGUID,LPCWSTR,LPGUID) PURE;}
+
+    (*** IDirectInput7W methods ***)
+    function CreateDeviceEx(const rguid: TGuid; const riid: TIID; out pvOut: LPVOID; pUnkOuter: IUnknown): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInput7W *LPDIRECTINPUT7W;
+  LPDIRECTINPUT7W = IDirectInput7W;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInput7A
+
+  IDirectInput7A = interface(IDirectInput2A)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInput2A methods ***)
+    {STDMETHOD(CreateDevice)(THIS_ REFGUID,LPDIRECTINPUTDEVICEA *,LPUNKNOWN) PURE;
+    STDMETHOD(EnumDevices)(THIS_ DWORD,LPDIENUMDEVICESCALLBACKA,LPVOID,DWORD) PURE;
+    STDMETHOD(GetDeviceStatus)(THIS_ REFGUID) PURE;
+    STDMETHOD(RunControlPanel)(THIS_ HWND,DWORD) PURE;
+    STDMETHOD(Initialize)(THIS_ HINSTANCE,DWORD) PURE;
+    STDMETHOD(FindDevice)(THIS_ REFGUID,LPCSTR,LPGUID) PURE;}
+
+    (*** IDirectInput7A methods ***)
+    function CreateDeviceEx(const rguid: TGuid; const riid: TIID; out pvOut: LPVOID; pUnkOuter: IUnknown): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInput7A *LPDIRECTINPUT7A;
+  LPDIRECTINPUT7A = IDirectInput7A;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInput7: TIID = {IID_IDirectInput7W}'{9A4CB685-236D-11D3-8E9D-00C04F6844AE}';
+type
+  IDirectInput7 = IDirectInput7W;
+{$ELSE}
+const
+  IID_IDirectInput7: TIID = {IID_IDirectInput7A}'{9A4CB684-236D-11D3-8E9D-00C04F6844AE}';
+type
+  IDirectInput7 = IDirectInput7A;
+{$ENDIF}
+//typedef struct IDirectInput7 *LPDIRECTINPUT7;
+  LPDIRECTINPUT7 = IDirectInput7;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInput7_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInput7_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInput7_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInput7_CreateDevice(p,a,b,c) (p)->lpVtbl->CreateDevice(p,a,b,c)
+//#define IDirectInput7_EnumDevices(p,a,b,c,d) (p)->lpVtbl->EnumDevices(p,a,b,c,d)
+//#define IDirectInput7_GetDeviceStatus(p,a) (p)->lpVtbl->GetDeviceStatus(p,a)
+//#define IDirectInput7_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInput7_Initialize(p,a,b) (p)->lpVtbl->Initialize(p,a,b)
+//#define IDirectInput7_FindDevice(p,a,b,c) (p)->lpVtbl->FindDevice(p,a,b,c)
+//#define IDirectInput7_CreateDeviceEx(p,a,b,c,d) (p)->lpVtbl->CreateDeviceEx(p,a,b,c,d)
+//#else
+//#define IDirectInput7_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInput7_AddRef(p) (p)->AddRef()
+//#define IDirectInput7_Release(p) (p)->Release()
+//#define IDirectInput7_CreateDevice(p,a,b,c) (p)->CreateDevice(a,b,c)
+//#define IDirectInput7_EnumDevices(p,a,b,c,d) (p)->EnumDevices(a,b,c,d)
+//#define IDirectInput7_GetDeviceStatus(p,a) (p)->GetDeviceStatus(a)
+//#define IDirectInput7_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInput7_Initialize(p,a,b) (p)->Initialize(a,b)
+//#define IDirectInput7_FindDevice(p,a,b,c) (p)->FindDevice(a,b,c)
+//#define IDirectInput7_CreateDeviceEx(p,a,b,c,d) (p)->CreateDeviceEx(a,b,c,d)
+//#endif
+
+{$IF DIRECTINPUT_VERSION >= $0800}
+//#undef INTERFACE
+//#define INTERFACE IDirectInput8W
+
+type
+  IDirectInput8W = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInput8W methods ***)
+    function CreateDevice(const rguid: TGuid; out lplpDirectInputDevice: IDirectInputDevice8W; pUnkOuter: IUnknown): HRESULT; stdcall;
+    function EnumDevices(dwDevType: DWORD; lpCallback: LPDIENUMDEVICESCALLBACKW; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetDeviceStatus(const rguidInstance: TGuid): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD): HRESULT; stdcall;
+    function FindDevice(const rguidClass: TGuid; ptszName: LPCWSTR; pguidInstance: LPGUID): HRESULT; stdcall;
+    function EnumDevicesBySemantics(ptszUserName: LPCWSTR; lpdiActionFormat: LPDIACTIONFORMATW; lpCallback: LPDIENUMDEVICESBYSEMANTICSCBW; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function ConfigureDevices(lpdiCallback: LPDICONFIGUREDEVICESCALLBACK; lpdiCDParams: LPDICONFIGUREDEVICESPARAMSW; dwFlags: DWORD; pvRefData: LPVOID): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInput8W *LPDIRECTINPUT8W;
+  LPDIRECTINPUT8W = IDirectInput8W;
+
+//#undef INTERFACE
+//#define INTERFACE IDirectInput8A
+
+  IDirectInput8A = interface(IUnknown)
+    (*** IUnknown methods ***)
+    {STDMETHOD(QueryInterface)(THIS_ REFIID riid, LPVOID * ppvObj) PURE;
+    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
+    STDMETHOD_(ULONG,Release)(THIS) PURE;}
+
+    (*** IDirectInput8A methods ***)
+    function CreateDevice(const rguid: TGuid; out lplpDirectInputDevice: IDirectInputDevice8A; pUnkOuter: IUnknown): HRESULT; stdcall;
+    function EnumDevices(dwDevType: DWORD; lpCallback: LPDIENUMDEVICESCALLBACKA; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function GetDeviceStatus(const rguidInstance: TGuid): HRESULT; stdcall;
+    function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HRESULT; stdcall;
+    function Initialize(hinst: HINST; dwVersion: DWORD): HRESULT; stdcall;
+    function FindDevice(const rguidClass: TGuid; ptszName: LPCSTR; pguidInstance: LPGUID): HRESULT; stdcall;
+    function EnumDevicesBySemantics(ptszUserName: LPCSTR; lpdiActionFormat: LPDIACTIONFORMATA; lpCallback: LPDIENUMDEVICESBYSEMANTICSCBA; pvRef: LPVOID; dwFlags: DWORD): HRESULT; stdcall;
+    function ConfigureDevices(lpdiCallback: LPDICONFIGUREDEVICESCALLBACK; lpdiCDParams: LPDICONFIGUREDEVICESPARAMSA; dwFlags: DWORD; pvRefData: LPVOID): HRESULT; stdcall;
+  end;
+
+//typedef struct IDirectInput8A *LPDIRECTINPUT8A;
+  LPDIRECTINPUT8A = IDirectInput8A;
+
+{$IFDEF UNICODE}
+const
+  IID_IDirectInput8: TIID = {IID_IDirectInput8W}'{BF798031-483A-4DA2-AA99-5D64ED369700}';
+type
+  IDirectInput8 = IDirectInput8W;
+{$ELSE}
+const
+  IID_IDirectInput8: TIID = {IID_IDirectInput8A}'{BF798030-483A-4DA2-AA99-5D64ED369700}';
+type
+  IDirectInput8 = IDirectInput8A;
+{$ENDIF}
+//typedef struct IDirectInput8 *LPDIRECTINPUT8;
+  LPDIRECTINPUT8 = IDirectInput8;
+
+//#if !defined(__cplusplus) || defined(CINTERFACE)
+//#define IDirectInput8_QueryInterface(p,a,b) (p)->lpVtbl->QueryInterface(p,a,b)
+//#define IDirectInput8_AddRef(p) (p)->lpVtbl->AddRef(p)
+//#define IDirectInput8_Release(p) (p)->lpVtbl->Release(p)
+//#define IDirectInput8_CreateDevice(p,a,b,c) (p)->lpVtbl->CreateDevice(p,a,b,c)
+//#define IDirectInput8_EnumDevices(p,a,b,c,d) (p)->lpVtbl->EnumDevices(p,a,b,c,d)
+//#define IDirectInput8_GetDeviceStatus(p,a) (p)->lpVtbl->GetDeviceStatus(p,a)
+//#define IDirectInput8_RunControlPanel(p,a,b) (p)->lpVtbl->RunControlPanel(p,a,b)
+//#define IDirectInput8_Initialize(p,a,b) (p)->lpVtbl->Initialize(p,a,b)
+//#define IDirectInput8_FindDevice(p,a,b,c) (p)->lpVtbl->FindDevice(p,a,b,c)
+//#define IDirectInput8_EnumDevicesBySemantics(p,a,b,c,d,e) (p)->lpVtbl->EnumDevicesBySemantics(p,a,b,c,d,e)
+//#define IDirectInput8_ConfigureDevices(p,a,b,c,d) (p)->lpVtbl->ConfigureDevices(p,a,b,c,d)
+//#else
+//#define IDirectInput8_QueryInterface(p,a,b) (p)->QueryInterface(a,b)
+//#define IDirectInput8_AddRef(p) (p)->AddRef()
+//#define IDirectInput8_Release(p) (p)->Release()
+//#define IDirectInput8_CreateDevice(p,a,b,c) (p)->CreateDevice(a,b,c)
+//#define IDirectInput8_EnumDevices(p,a,b,c,d) (p)->EnumDevices(a,b,c,d)
+//#define IDirectInput8_GetDeviceStatus(p,a) (p)->GetDeviceStatus(a)
+//#define IDirectInput8_RunControlPanel(p,a,b) (p)->RunControlPanel(a,b)
+//#define IDirectInput8_Initialize(p,a,b) (p)->Initialize(a,b)
+//#define IDirectInput8_FindDevice(p,a,b,c) (p)->FindDevice(a,b,c)
+//#define IDirectInput8_EnumDevicesBySemantics(p,a,b,c,d,e) (p)->EnumDevicesBySemantics(a,b,c,d,e)
+//#define IDirectInput8_ConfigureDevices(p,a,b,c,d) (p)->ConfigureDevices(a,b,c,d)
+//#endif
+{$ENDIF} { DIRECTINPUT_VERSION >= $0800 }
+
+{$IF DIRECTINPUT_VERSION > $0700}
+
+//extern HRESULT WINAPI DirectInput8Create(HINSTANCE hinst, DWORD dwVersion, REFIID riidltf, LPVOID *ppvOut, LPUNKNOWN punkOuter);
+function DirectInput8Create(hinst: HINST; dwVersion: DWORD; const riidltf: TIID; out ppvOut: LPVOID; punkOuter: IUnknown): HRESULT; stdcall; external 'dinput8';
+
+{$ELSE}
+//extern HRESULT WINAPI DirectInputCreateA(HINSTANCE hinst, DWORD dwVersion, LPDIRECTINPUTA *ppDI, LPUNKNOWN punkOuter);
+function DirectInputCreateA(hinst: HINST; dwVersion: DWORD; out ppDI: IDirectInputA; punkOuter: IUnknown): HRESULT; stdcall; external 'dinput';
+//extern HRESULT WINAPI DirectInputCreateW(HINSTANCE hinst, DWORD dwVersion, LPDIRECTINPUTW *ppDI, LPUNKNOWN punkOuter);
+function DirectInputCreateW(hinst: HINST; dwVersion: DWORD; out ppDI: IDirectInputW; punkOuter: IUnknown): HRESULT; stdcall; external 'dinput';
+{$IFDEF UNICODE}
+function DirectInputCreate(hinst: HINST; dwVersion: DWORD; out ppDI: IDirectInputW; punkOuter: IUnknown): HRESULT; stdcall; external 'dinput' name 'DirectInputCreateW';
+{$ELSE}
+function DirectInputCreate(hinst: HINST; dwVersion: DWORD; out ppDI: IDirectInputA; punkOuter: IUnknown): HRESULT; stdcall; external 'dinput' name 'DirectInputCreateA';
+{$ENDIF} // !UNICODE
+
+//extern HRESULT WINAPI DirectInputCreateEx(HINSTANCE hinst, DWORD dwVersion, REFIID riidltf, LPVOID *ppvOut, LPUNKNOWN punkOuter);
+function DirectInputCreateEx(hinst: HINST; dwVersion: DWORD; const riidltf: TIID; out ppvOut: LPVOID; punkOuter: IUnknown): HRESULT; stdcall; external 'dinput';
+
+{$ENDIF} { DIRECTINPUT_VERSION > $700 }
+
+//#endif /* DIJ_RINGZERO */
+
+
+(****************************************************************************
+ *
+ *  Return Codes
+ *
+ ****************************************************************************)
+
+(*
+ *  The operation completed successfully.
+ *)
+const
+  DI_OK                           = S_OK;
+
+(*
+ *  The device exists but is not currently attached.
+ *)
+  DI_NOTATTACHED                  = S_FALSE;
+
+(*
+ *  The device buffer overflowed.  Some input was lost.
+ *)
+  DI_BUFFEROVERFLOW               = S_FALSE;
+
+(*
+ *  The change in device properties had no effect.
+ *)
+  DI_PROPNOEFFECT                 = S_FALSE;
+
+(*
+ *  The operation had no effect.
+ *)
+  DI_NOEFFECT                     = S_FALSE;
+
+(*
+ *  The device is a polled device.  As a result, device buffering
+ *  will not collect any data and event notifications will not be
+ *  signalled until GetDeviceState is called.
+ *)
+  DI_POLLEDDEVICE                 = HRESULT($00000002);
+
+(*
+ *  The parameters of the effect were successfully updated by
+ *  IDirectInputEffect::SetParameters, but the effect was not
+ *  downloaded because the device is not exclusively acquired
+ *  or because the DIEP_NODOWNLOAD flag was passed.
+ *)
+  DI_DOWNLOADSKIPPED              = HRESULT($00000003);
+
+(*
+ *  The parameters of the effect were successfully updated by
+ *  IDirectInputEffect::SetParameters, but in order to change
+ *  the parameters, the effect needed to be restarted.
+ *)
+  DI_EFFECTRESTARTED              = HRESULT($00000004);
+
+(*
+ *  The parameters of the effect were successfully updated by
+ *  IDirectInputEffect::SetParameters, but some of them were
+ *  beyond the capabilities of the device and were truncated.
+ *)
+  DI_TRUNCATED                    = HRESULT($00000008);
+
+(*
+ *  The settings have been successfully applied but could not be
+ *  persisted.
+ *)
+  DI_SETTINGSNOTSAVED             = HRESULT($0000000B);
+
+(*
+ *  Equal to DI_EFFECTRESTARTED | DI_TRUNCATED.
+ *)
+  DI_TRUNCATEDANDRESTARTED        = HRESULT($0000000C);
+
+(*
+ *  A SUCCESS code indicating that settings cannot be modified.
+ *)
+  DI_WRITEPROTECT                 = HRESULT($00000013);
+
+(*
+ *  The application requires a newer version of DirectInput.
+ *)
+//  DIERR_OLDDIRECTINPUTVERSION     \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_OLD_WIN_VERSION)
+
+(*
+ *  The application was written for an unsupported prerelease version
+ *  of DirectInput.
+ *)
+//  DIERR_BETADIRECTINPUTVERSION    \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_RMODE_APP)
+
+(*
+ *  The object could not be created due to an incompatible driver version
+ *  or mismatched or incomplete driver components.
+ *)
+//  DIERR_BADDRIVERVER              \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_BAD_DRIVER_LEVEL)
+
+(*
+ * The device or device instance or effect is not registered with DirectInput.
+ *)
+  DIERR_DEVICENOTREG              = REGDB_E_CLASSNOTREG;
+
+(*
+ * The requested object does not exist.
+ *)
+//  DIERR_NOTFOUND                  \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_FILE_NOT_FOUND)
+
+(*
+ * The requested object does not exist.
+ *)
+//  DIERR_OBJECTNOTFOUND            \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_FILE_NOT_FOUND)
+
+(*
+ * An invalid parameter was passed to the returning function,
+ * or the object was not in a state that admitted the function
+ * to be called.
+ *)
+  DIERR_INVALIDPARAM              = E_INVALIDARG;
+
+(*
+ * The specified interface is not supported by the object
+ *)
+  DIERR_NOINTERFACE               = E_NOINTERFACE;
+
+(*
+ * An undetermined error occured inside the DInput subsystem
+ *)
+  DIERR_GENERIC                   = E_FAIL;
+
+(*
+ * The DInput subsystem couldn't allocate sufficient memory to complete the
+ * caller's request.
+ *)
+  DIERR_OUTOFMEMORY               = E_OUTOFMEMORY;
+
+(*
+ * The function called is not supported at this time
+ *)
+  DIERR_UNSUPPORTED               = E_NOTIMPL;
+
+(*
+ * This object has not been initialized
+ *)
+//  DIERR_NOTINITIALIZED            \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_NOT_READY)
+
+(*
+ * This object is already initialized
+ *)
+//  DIERR_ALREADYINITIALIZED        \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_ALREADY_INITIALIZED)
+
+(*
+ * This object does not support aggregation
+ *)
+  DIERR_NOAGGREGATION             = CLASS_E_NOAGGREGATION;
+
+(*
+ * Another app has a higher priority level, preventing this call from
+ * succeeding.
+ *)
+  DIERR_OTHERAPPHASPRIO           = E_ACCESSDENIED;
+
+(*
+ * Access to the device has been lost.  It must be re-acquired.
+ *)
+//  DIERR_INPUTLOST                 \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_READ_FAULT)
+
+(*
+ * The operation cannot be performed while the device is acquired.
+ *)
+//  DIERR_ACQUIRED                  \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_BUSY)
+
+(*
+ * The operation cannot be performed unless the device is acquired.
+ *)
+//  DIERR_NOTACQUIRED               \
+//    MAKE_HRESULT(SEVERITY_ERROR, FACILITY_WIN32, ERROR_INVALID_ACCESS)
+
+(*
+ * The specified property cannot be changed.
+ *)
+  DIERR_READONLY                  = E_ACCESSDENIED;
+
+(*
+ * The device already has an event notification associated with it.
+ *)
+  DIERR_HANDLEEXISTS              = E_ACCESSDENIED;
+
+(*
+ * Data is not yet available.
+ *)
+//#ifndef E_PENDING
+  E_PENDING                       = $8000000A;
+//#endif
+
+(*
+ * Unable to IDirectInputJoyConfig_Acquire because the user
+ * does not have sufficient privileges to change the joystick
+ * configuration.
+ *)
+  DIERR_INSUFFICIENTPRIVS         = $80040200;
+
+(*
+ * The device is full.
+ *)
+  DIERR_DEVICEFULL                = $80040201;
+
+(*
+ * Not all the requested information fit into the buffer.
+ *)
+  DIERR_MOREDATA                  = $80040202;
+
+(*
+ * The effect is not downloaded.
+ *)
+  DIERR_NOTDOWNLOADED             = $80040203;
+
+(*
+ *  The device cannot be reinitialized because there are still effects
+ *  attached to it.
+ *)
+  DIERR_HASEFFECTS                = $80040204;
+
+(*
+ *  The operation cannot be performed unless the device is acquired
+ *  in DISCL_EXCLUSIVE mode.
+ *)
+  DIERR_NOTEXCLUSIVEACQUIRED      = $80040205;
+
+(*
+ *  The effect could not be downloaded because essential information
+ *  is missing.  For example, no axes have been associated with the
+ *  effect, or no type-specific information has been created.
+ *)
+  DIERR_INCOMPLETEEFFECT          = $80040206;
+
+(*
+ *  Attempted to read buffered device data from a device that is
+ *  not buffered.
+ *)
+  DIERR_NOTBUFFERED               = $80040207;
+
+(*
+ *  An attempt was made to modify parameters of an effect while it is
+ *  playing.  Not all hardware devices support altering the parameters
+ *  of an effect while it is playing.
+ *)
+  DIERR_EFFECTPLAYING             = $80040208;
+
+(*
+ *  The operation could not be completed because the device is not
+ *  plugged in.
+ *)
+  DIERR_UNPLUGGED                 = $80040209;
+
+(*
+ *  SendDeviceData failed because more information was requested
+ *  to be sent than can be sent to the device.  Some devices have
+ *  restrictions on how much data can be sent to them.  (For example,
+ *  there might be a limit on the number of buttons that can be
+ *  pressed at once.)
+ *)
+  DIERR_REPORTFULL                = $8004020A;
+
+
+(*
+ *  A mapper file function failed because reading or writing the user or IHV
+ *  settings file failed.
+ *)
+  DIERR_MAPFILEFAIL               = $8004020B;
+
+
+//
+//    Copyright (C) Microsoft.  All rights reserved.
+//
+
+
+//
+//    Copyright (C) Microsoft.  All rights reserved.
+//
+(*--- DINPUT Mapper Definitions: New for Dx8         ---*)
+
+
+(*--- Keyboard
+      Physical Keyboard Device       ---*)
+
+//
+//    Copyright (C) Microsoft.  All rights reserved.
+//
+  DIKEYBOARD_ESCAPE                       = $81000401;
+  DIKEYBOARD_1                            = $81000402;
+  DIKEYBOARD_2                            = $81000403;
+  DIKEYBOARD_3                            = $81000404;
+  DIKEYBOARD_4                            = $81000405;
+  DIKEYBOARD_5                            = $81000406;
+  DIKEYBOARD_6                            = $81000407;
+  DIKEYBOARD_7                            = $81000408;
+  DIKEYBOARD_8                            = $81000409;
+  DIKEYBOARD_9                            = $8100040A;
+  DIKEYBOARD_0                            = $8100040B;
+  DIKEYBOARD_MINUS                        = $8100040C;    { - on main keyboard }
+  DIKEYBOARD_EQUALS                       = $8100040D;
+  DIKEYBOARD_BACK                         = $8100040E;    { backspace }
+  DIKEYBOARD_TAB                          = $8100040F;
+  DIKEYBOARD_Q                            = $81000410;
+  DIKEYBOARD_W                            = $81000411;
+  DIKEYBOARD_E                            = $81000412;
+  DIKEYBOARD_R                            = $81000413;
+  DIKEYBOARD_T                            = $81000414;
+  DIKEYBOARD_Y                            = $81000415;
+  DIKEYBOARD_U                            = $81000416;
+  DIKEYBOARD_I                            = $81000417;
+  DIKEYBOARD_O                            = $81000418;
+  DIKEYBOARD_P                            = $81000419;
+  DIKEYBOARD_LBRACKET                     = $8100041A;
+  DIKEYBOARD_RBRACKET                     = $8100041B;
+  DIKEYBOARD_RETURN                       = $8100041C;    { Enter on main keyboard }
+  DIKEYBOARD_LCONTROL                     = $8100041D;
+  DIKEYBOARD_A                            = $8100041E;
+  DIKEYBOARD_S                            = $8100041F;
+  DIKEYBOARD_D                            = $81000420;
+  DIKEYBOARD_F                            = $81000421;
+  DIKEYBOARD_G                            = $81000422;
+  DIKEYBOARD_H                            = $81000423;
+  DIKEYBOARD_J                            = $81000424;
+  DIKEYBOARD_K                            = $81000425;
+  DIKEYBOARD_L                            = $81000426;
+  DIKEYBOARD_SEMICOLON                    = $81000427;
+  DIKEYBOARD_APOSTROPHE                   = $81000428;
+  DIKEYBOARD_GRAVE                        = $81000429;    { accent grave }
+  DIKEYBOARD_LSHIFT                       = $8100042A;
+  DIKEYBOARD_BACKSLASH                    = $8100042B;
+  DIKEYBOARD_Z                            = $8100042C;
+  DIKEYBOARD_X                            = $8100042D;
+  DIKEYBOARD_C                            = $8100042E;
+  DIKEYBOARD_V                            = $8100042F;
+  DIKEYBOARD_B                            = $81000430;
+  DIKEYBOARD_N                            = $81000431;
+  DIKEYBOARD_M                            = $81000432;
+  DIKEYBOARD_COMMA                        = $81000433;
+  DIKEYBOARD_PERIOD                       = $81000434;    { . on main keyboard }
+  DIKEYBOARD_SLASH                        = $81000435;    { / on main keyboard }
+  DIKEYBOARD_RSHIFT                       = $81000436;
+  DIKEYBOARD_MULTIPLY                     = $81000437;    { * on numeric keypad }
+  DIKEYBOARD_LMENU                        = $81000438;    { left Alt }
+  DIKEYBOARD_SPACE                        = $81000439;
+  DIKEYBOARD_CAPITAL                      = $8100043A;
+  DIKEYBOARD_F1                           = $8100043B;
+  DIKEYBOARD_F2                           = $8100043C;
+  DIKEYBOARD_F3                           = $8100043D;
+  DIKEYBOARD_F4                           = $8100043E;
+  DIKEYBOARD_F5                           = $8100043F;
+  DIKEYBOARD_F6                           = $81000440;
+  DIKEYBOARD_F7                           = $81000441;
+  DIKEYBOARD_F8                           = $81000442;
+  DIKEYBOARD_F9                           = $81000443;
+  DIKEYBOARD_F10                          = $81000444;
+  DIKEYBOARD_NUMLOCK                      = $81000445;
+  DIKEYBOARD_SCROLL                       = $81000446;    { Scroll Lock }
+  DIKEYBOARD_NUMPAD7                      = $81000447;
+  DIKEYBOARD_NUMPAD8                      = $81000448;
+  DIKEYBOARD_NUMPAD9                      = $81000449;
+  DIKEYBOARD_SUBTRACT                     = $8100044A;    { - on numeric keypad }
+  DIKEYBOARD_NUMPAD4                      = $8100044B;
+  DIKEYBOARD_NUMPAD5                      = $8100044C;
+  DIKEYBOARD_NUMPAD6                      = $8100044D;
+  DIKEYBOARD_ADD                          = $8100044E;    { + on numeric keypad }
+  DIKEYBOARD_NUMPAD1                      = $8100044F;
+  DIKEYBOARD_NUMPAD2                      = $81000450;
+  DIKEYBOARD_NUMPAD3                      = $81000451;
+  DIKEYBOARD_NUMPAD0                      = $81000452;
+  DIKEYBOARD_DECIMAL                      = $81000453;    { . on numeric keypad }
+  DIKEYBOARD_OEM_102                      = $81000456;    { <> or \| on RT 102-key keyboard (Non-U.S.) }
+  DIKEYBOARD_F11                          = $81000457;
+  DIKEYBOARD_F12                          = $81000458;
+  DIKEYBOARD_F13                          = $81000464;    {                     (NEC PC98) }
+  DIKEYBOARD_F14                          = $81000465;    {                     (NEC PC98) }
+  DIKEYBOARD_F15                          = $81000466;    {                     (NEC PC98) }
+  DIKEYBOARD_KANA                         = $81000470;    { (Japanese keyboard)            }
+  DIKEYBOARD_ABNT_C1                      = $81000473;    { /? on Brazilian keyboard }
+  DIKEYBOARD_CONVERT                      = $81000479;    { (Japanese keyboard)            }
+  DIKEYBOARD_NOCONVERT                    = $8100047B;    { (Japanese keyboard)            }
+  DIKEYBOARD_YEN                          = $8100047D;    { (Japanese keyboard)            }
+  DIKEYBOARD_ABNT_C2                      = $8100047E;    { Numpad . on Brazilian keyboard }
+  DIKEYBOARD_NUMPADEQUALS                 = $8100048D;    { = on numeric keypad (NEC PC98) }
+  DIKEYBOARD_PREVTRACK                    = $81000490;    { Previous Track (DIK_CIRCUMFLEX on Japanese keyboard) }
+  DIKEYBOARD_AT                           = $81000491;    {                     (NEC PC98) }
+  DIKEYBOARD_COLON                        = $81000492;    {                     (NEC PC98) }
+  DIKEYBOARD_UNDERLINE                    = $81000493;    {                     (NEC PC98) }
+  DIKEYBOARD_KANJI                        = $81000494;    { (Japanese keyboard)            }
+  DIKEYBOARD_STOP                         = $81000495;    {                     (NEC PC98) }
+  DIKEYBOARD_AX                           = $81000496;    {                     (Japan AX) }
+  DIKEYBOARD_UNLABELED                    = $81000497;    {                        (J3100) }
+  DIKEYBOARD_NEXTTRACK                    = $81000499;    { Next Track }
+  DIKEYBOARD_NUMPADENTER                  = $8100049C;    { Enter on numeric keypad }
+  DIKEYBOARD_RCONTROL                     = $8100049D;
+  DIKEYBOARD_MUTE                         = $810004A0;    { Mute }
+  DIKEYBOARD_CALCULATOR                   = $810004A1;    { Calculator }
+  DIKEYBOARD_PLAYPAUSE                    = $810004A2;    { Play / Pause }
+  DIKEYBOARD_MEDIASTOP                    = $810004A4;    { Media Stop }
+  DIKEYBOARD_VOLUMEDOWN                   = $810004AE;    { Volume - }
+  DIKEYBOARD_VOLUMEUP                     = $810004B0;    { Volume + }
+  DIKEYBOARD_WEBHOME                      = $810004B2;    { Web home }
+  DIKEYBOARD_NUMPADCOMMA                  = $810004B3;    { , on numeric keypad (NEC PC98) }
+  DIKEYBOARD_DIVIDE                       = $810004B5;    { / on numeric keypad }
+  DIKEYBOARD_SYSRQ                        = $810004B7;
+  DIKEYBOARD_RMENU                        = $810004B8;    { right Alt }
+  DIKEYBOARD_PAUSE                        = $810004C5;    { Pause }
+  DIKEYBOARD_HOME                         = $810004C7;    { Home on arrow keypad }
+  DIKEYBOARD_UP                           = $810004C8;    { UpArrow on arrow keypad }
+  DIKEYBOARD_PRIOR                        = $810004C9;    { PgUp on arrow keypad }
+  DIKEYBOARD_LEFT                         = $810004CB;    { LeftArrow on arrow keypad }
+  DIKEYBOARD_RIGHT                        = $810004CD;    { RightArrow on arrow keypad }
+  DIKEYBOARD_END                          = $810004CF;    { End on arrow keypad }
+  DIKEYBOARD_DOWN                         = $810004D0;    { DownArrow on arrow keypad }
+  DIKEYBOARD_NEXT                         = $810004D1;    { PgDn on arrow keypad }
+  DIKEYBOARD_INSERT                       = $810004D2;    { Insert on arrow keypad }
+  DIKEYBOARD_DELETE                       = $810004D3;    { Delete on arrow keypad }
+  DIKEYBOARD_LWIN                         = $810004DB;    { Left Windows key }
+  DIKEYBOARD_RWIN                         = $810004DC;    { Right Windows key }
+  DIKEYBOARD_APPS                         = $810004DD;    { AppMenu key }
+  DIKEYBOARD_POWER                        = $810004DE;    { System Power }
+  DIKEYBOARD_SLEEP                        = $810004DF;    { System Sleep }
+  DIKEYBOARD_WAKE                         = $810004E3;    { System Wake }
+  DIKEYBOARD_WEBSEARCH                    = $810004E5;    { Web Search }
+  DIKEYBOARD_WEBFAVORITES                 = $810004E6;    { Web Favorites }
+  DIKEYBOARD_WEBREFRESH                   = $810004E7;    { Web Refresh }
+  DIKEYBOARD_WEBSTOP                      = $810004E8;    { Web Stop }
+  DIKEYBOARD_WEBFORWARD                   = $810004E9;    { Web Forward }
+  DIKEYBOARD_WEBBACK                      = $810004EA;    { Web Back }
+  DIKEYBOARD_MYCOMPUTER                   = $810004EB;    { My Computer }
+  DIKEYBOARD_MAIL                         = $810004EC;    { Mail }
+  DIKEYBOARD_MEDIASELECT                  = $810004ED;    { Media Select }
+
+
+(*--- MOUSE
+      Physical Mouse Device             ---*)
+
+{#define DIMOUSE_XAXISAB                         (0x82000200 |DIMOFS_X ) /* X Axis-absolute: Some mice natively report absolute coordinates  */
+#define DIMOUSE_YAXISAB                         (0x82000200 |DIMOFS_Y ) /* Y Axis-absolute: Some mice natively report absolute coordinates */
+#define DIMOUSE_XAXIS                           (0x82000300 |DIMOFS_X ) /* X Axis */
+#define DIMOUSE_YAXIS                           (0x82000300 |DIMOFS_Y ) /* Y Axis */
+#define DIMOUSE_WHEEL                           (0x82000300 |DIMOFS_Z ) /* Z Axis */
+#define DIMOUSE_BUTTON0                         (0x82000400 |DIMOFS_BUTTON0) /* Button 0 */
+#define DIMOUSE_BUTTON1                         (0x82000400 |DIMOFS_BUTTON1) /* Button 1 */
+#define DIMOUSE_BUTTON2                         (0x82000400 |DIMOFS_BUTTON2) /* Button 2 */
+#define DIMOUSE_BUTTON3                         (0x82000400 |DIMOFS_BUTTON3) /* Button 3 */
+#define DIMOUSE_BUTTON4                         (0x82000400 |DIMOFS_BUTTON4) /* Button 4 */
+#define DIMOUSE_BUTTON5                         (0x82000400 |DIMOFS_BUTTON5) /* Button 5 */
+#define DIMOUSE_BUTTON6                         (0x82000400 |DIMOFS_BUTTON6) /* Button 6 */
+#define DIMOUSE_BUTTON7                         (0x82000400 |DIMOFS_BUTTON7) /* Button 7 */}
+
+
+(*--- VOICE
+      Physical Dplay Voice Device       ---*)
+
+  DIVOICE_CHANNEL1                        = $83000401;
+  DIVOICE_CHANNEL2                        = $83000402;
+  DIVOICE_CHANNEL3                        = $83000403;
+  DIVOICE_CHANNEL4                        = $83000404;
+  DIVOICE_CHANNEL5                        = $83000405;
+  DIVOICE_CHANNEL6                        = $83000406;
+  DIVOICE_CHANNEL7                        = $83000407;
+  DIVOICE_CHANNEL8                        = $83000408;
+  DIVOICE_TEAM                            = $83000409;
+  DIVOICE_ALL                             = $8300040A;
+  DIVOICE_RECORDMUTE                      = $8300040B;
+  DIVOICE_PLAYBACKMUTE                    = $8300040C;
+  DIVOICE_TRANSMIT                        = $8300040D;
+
+  DIVOICE_VOICECOMMAND                    = $83000410;
+
+
+(*--- Driving Simulator - Racing
+      Vehicle control is primary objective  ---*)
+  DIVIRTUAL_DRIVING_RACE                  = $01000000;
+  DIAXIS_DRIVINGR_STEER                   = $01008A01; { Steering }
+  DIAXIS_DRIVINGR_ACCELERATE              = $01039202; { Accelerate }
+  DIAXIS_DRIVINGR_BRAKE                   = $01041203; { Brake-Axis }
+  DIBUTTON_DRIVINGR_SHIFTUP               = $01000C01; { Shift to next higher gear }
+  DIBUTTON_DRIVINGR_SHIFTDOWN             = $01000C02; { Shift to next lower gear }
+  DIBUTTON_DRIVINGR_VIEW                  = $01001C03; { Cycle through view options }
+  DIBUTTON_DRIVINGR_MENU                  = $010004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIAXIS_DRIVINGR_ACCEL_AND_BRAKE         = $01014A04; { Some devices combine accelerate and brake in a single axis }
+  DIHATSWITCH_DRIVINGR_GLANCE             = $01004601; { Look around }
+  DIBUTTON_DRIVINGR_BRAKE                 = $01004C04; { Brake-button }
+  DIBUTTON_DRIVINGR_DASHBOARD             = $01004405; { Select next dashboard option }
+  DIBUTTON_DRIVINGR_AIDS                  = $01004406; { Driver correction aids }
+  DIBUTTON_DRIVINGR_MAP                   = $01004407; { Display Driving Map }
+  DIBUTTON_DRIVINGR_BOOST                 = $01004408; { Turbo Boost }
+  DIBUTTON_DRIVINGR_PIT                   = $01004409; { Pit stop notification }
+  DIBUTTON_DRIVINGR_ACCELERATE_LINK       = $0103D4E0; { Fallback Accelerate button }
+  DIBUTTON_DRIVINGR_STEER_LEFT_LINK       = $0100CCE4; { Fallback Steer Left button }
+  DIBUTTON_DRIVINGR_STEER_RIGHT_LINK      = $0100CCEC; { Fallback Steer Right button }
+  DIBUTTON_DRIVINGR_GLANCE_LEFT_LINK      = $0107C4E4; { Fallback Glance Left button }
+  DIBUTTON_DRIVINGR_GLANCE_RIGHT_LINK     = $0107C4EC; { Fallback Glance Right button }
+  DIBUTTON_DRIVINGR_DEVICE                = $010044FE; { Show input device and controls }
+  DIBUTTON_DRIVINGR_PAUSE                 = $010044FC; { Start / Pause / Restart game }
+
+(*--- Driving Simulator - Combat
+      Combat from within a vehicle is primary objective  ---*)
+  DIVIRTUAL_DRIVING_COMBAT                = $02000000;
+  DIAXIS_DRIVINGC_STEER                   = $02008A01; { Steering  }
+  DIAXIS_DRIVINGC_ACCELERATE              = $02039202; { Accelerate }
+  DIAXIS_DRIVINGC_BRAKE                   = $02041203; { Brake-axis }
+  DIBUTTON_DRIVINGC_FIRE                  = $02000C01; { Fire }
+  DIBUTTON_DRIVINGC_WEAPONS               = $02000C02; { Select next weapon }
+  DIBUTTON_DRIVINGC_TARGET                = $02000C03; { Select next available target }
+  DIBUTTON_DRIVINGC_MENU                  = $020004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIAXIS_DRIVINGC_ACCEL_AND_BRAKE         = $02014A04; { Some devices combine accelerate and brake in a single axis }
+  DIHATSWITCH_DRIVINGC_GLANCE             = $02004601; { Look around }
+  DIBUTTON_DRIVINGC_SHIFTUP               = $02004C04; { Shift to next higher gear }
+  DIBUTTON_DRIVINGC_SHIFTDOWN             = $02004C05; { Shift to next lower gear }
+  DIBUTTON_DRIVINGC_DASHBOARD             = $02004406; { Select next dashboard option }
+  DIBUTTON_DRIVINGC_AIDS                  = $02004407; { Driver correction aids }
+  DIBUTTON_DRIVINGC_BRAKE                 = $02004C08; { Brake-button }
+  DIBUTTON_DRIVINGC_FIRESECONDARY         = $02004C09; { Alternative fire button }
+  DIBUTTON_DRIVINGC_ACCELERATE_LINK       = $0203D4E0; { Fallback Accelerate button }
+  DIBUTTON_DRIVINGC_STEER_LEFT_LINK       = $0200CCE4; { Fallback Steer Left button }
+  DIBUTTON_DRIVINGC_STEER_RIGHT_LINK      = $0200CCEC; { Fallback Steer Right button }
+  DIBUTTON_DRIVINGC_GLANCE_LEFT_LINK      = $0207C4E4; { Fallback Glance Left button }
+  DIBUTTON_DRIVINGC_GLANCE_RIGHT_LINK     = $0207C4EC; { Fallback Glance Right button }
+  DIBUTTON_DRIVINGC_DEVICE                = $020044FE; { Show input device and controls }
+  DIBUTTON_DRIVINGC_PAUSE                 = $020044FC; { Start / Pause / Restart game }
+
+(*--- Driving Simulator - Tank
+      Combat from withing a tank is primary objective  ---*)
+  DIVIRTUAL_DRIVING_TANK                  = $03000000;
+  DIAXIS_DRIVINGT_STEER                   = $03008A01; { Turn tank left / right }
+  DIAXIS_DRIVINGT_BARREL                  = $03010202; { Raise / lower barrel }
+  DIAXIS_DRIVINGT_ACCELERATE              = $03039203; { Accelerate }
+  DIAXIS_DRIVINGT_ROTATE                  = $03020204; { Turn barrel left / right }
+  DIBUTTON_DRIVINGT_FIRE                  = $03000C01; { Fire }
+  DIBUTTON_DRIVINGT_WEAPONS               = $03000C02; { Select next weapon }
+  DIBUTTON_DRIVINGT_TARGET                = $03000C03; { Selects next available target }
+  DIBUTTON_DRIVINGT_MENU                  = $030004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_DRIVINGT_GLANCE             = $03004601; { Look around }
+  DIAXIS_DRIVINGT_BRAKE                   = $03045205; { Brake-axis }
+  DIAXIS_DRIVINGT_ACCEL_AND_BRAKE         = $03014A06; { Some devices combine accelerate and brake in a single axis }
+  DIBUTTON_DRIVINGT_VIEW                  = $03005C04; { Cycle through view options }
+  DIBUTTON_DRIVINGT_DASHBOARD             = $03005C05; { Select next dashboard option }
+  DIBUTTON_DRIVINGT_BRAKE                 = $03004C06; { Brake-button }
+  DIBUTTON_DRIVINGT_FIRESECONDARY         = $03004C07; { Alternative fire button }
+  DIBUTTON_DRIVINGT_ACCELERATE_LINK       = $0303D4E0; { Fallback Accelerate button }
+  DIBUTTON_DRIVINGT_STEER_LEFT_LINK       = $0300CCE4; { Fallback Steer Left button }
+  DIBUTTON_DRIVINGT_STEER_RIGHT_LINK      = $0300CCEC; { Fallback Steer Right button }
+  DIBUTTON_DRIVINGT_BARREL_UP_LINK        = $030144E0; { Fallback Barrel up button }
+  DIBUTTON_DRIVINGT_BARREL_DOWN_LINK      = $030144E8; { Fallback Barrel down button }
+  DIBUTTON_DRIVINGT_ROTATE_LEFT_LINK      = $030244E4; { Fallback Rotate left button }
+  DIBUTTON_DRIVINGT_ROTATE_RIGHT_LINK     = $030244EC; { Fallback Rotate right button }
+  DIBUTTON_DRIVINGT_GLANCE_LEFT_LINK      = $0307C4E4; { Fallback Glance Left button }
+  DIBUTTON_DRIVINGT_GLANCE_RIGHT_LINK     = $0307C4EC; { Fallback Glance Right button }
+  DIBUTTON_DRIVINGT_DEVICE                = $030044FE; { Show input device and controls }
+  DIBUTTON_DRIVINGT_PAUSE                 = $030044FC; { Start / Pause / Restart game }
+
+(*--- Flight Simulator - Civilian
+      Plane control is the primary objective  ---*)
+  DIVIRTUAL_FLYING_CIVILIAN               = $04000000;
+  DIAXIS_FLYINGC_BANK                     = $04008A01; { Roll ship left / right }
+  DIAXIS_FLYINGC_PITCH                    = $04010A02; { Nose up / down }
+  DIAXIS_FLYINGC_THROTTLE                 = $04039203; { Throttle }
+  DIBUTTON_FLYINGC_VIEW                   = $04002401; { Cycle through view options }
+  DIBUTTON_FLYINGC_DISPLAY                = $04002402; { Select next dashboard / heads up display option }
+  DIBUTTON_FLYINGC_GEAR                   = $04002C03; { Gear up / down }
+  DIBUTTON_FLYINGC_MENU                   = $040004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_FLYINGC_GLANCE              = $04004601; { Look around }
+  DIAXIS_FLYINGC_BRAKE                    = $04046A04; { Apply Brake }
+  DIAXIS_FLYINGC_RUDDER                   = $04025205; { Yaw ship left/right }
+  DIAXIS_FLYINGC_FLAPS                    = $04055A06; { Flaps }
+  DIBUTTON_FLYINGC_FLAPSUP                = $04006404; { Increment stepping up until fully retracted }
+  DIBUTTON_FLYINGC_FLAPSDOWN              = $04006405; { Decrement stepping down until fully extended }
+  DIBUTTON_FLYINGC_BRAKE_LINK             = $04046CE0; { Fallback brake button }
+  DIBUTTON_FLYINGC_FASTER_LINK            = $0403D4E0; { Fallback throttle up button }
+  DIBUTTON_FLYINGC_SLOWER_LINK            = $0403D4E8; { Fallback throttle down button }
+  DIBUTTON_FLYINGC_GLANCE_LEFT_LINK       = $0407C4E4; { Fallback Glance Left button }
+  DIBUTTON_FLYINGC_GLANCE_RIGHT_LINK      = $0407C4EC; { Fallback Glance Right button }
+  DIBUTTON_FLYINGC_GLANCE_UP_LINK         = $0407C4E0; { Fallback Glance Up button }
+  DIBUTTON_FLYINGC_GLANCE_DOWN_LINK       = $0407C4E8; { Fallback Glance Down button }
+  DIBUTTON_FLYINGC_DEVICE                 = $040044FE; { Show input device and controls }
+  DIBUTTON_FLYINGC_PAUSE                  = $040044FC; { Start / Pause / Restart game }
+
+(*--- Flight Simulator - Military
+      Aerial combat is the primary objective  ---*)
+  DIVIRTUAL_FLYING_MILITARY               = $05000000;
+  DIAXIS_FLYINGM_BANK                     = $05008A01; { Bank - Roll ship left / right }
+  DIAXIS_FLYINGM_PITCH                    = $05010A02; { Pitch - Nose up / down }
+  DIAXIS_FLYINGM_THROTTLE                 = $05039203; { Throttle - faster / slower }
+  DIBUTTON_FLYINGM_FIRE                   = $05000C01; { Fire }
+  DIBUTTON_FLYINGM_WEAPONS                = $05000C02; { Select next weapon }
+  DIBUTTON_FLYINGM_TARGET                 = $05000C03; { Selects next available target }
+  DIBUTTON_FLYINGM_MENU                   = $050004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_FLYINGM_GLANCE              = $05004601; { Look around }
+  DIBUTTON_FLYINGM_COUNTER                = $05005C04; { Activate counter measures }
+  DIAXIS_FLYINGM_RUDDER                   = $05024A04; { Rudder - Yaw ship left/right }
+  DIAXIS_FLYINGM_BRAKE                    = $05046205; { Brake-axis }
+  DIBUTTON_FLYINGM_VIEW                   = $05006405; { Cycle through view options }
+  DIBUTTON_FLYINGM_DISPLAY                = $05006406; { Select next dashboard option }
+  DIAXIS_FLYINGM_FLAPS                    = $05055206; { Flaps }
+  DIBUTTON_FLYINGM_FLAPSUP                = $05005407; { Increment stepping up until fully retracted }
+  DIBUTTON_FLYINGM_FLAPSDOWN              = $05005408; { Decrement stepping down until fully extended }
+  DIBUTTON_FLYINGM_FIRESECONDARY          = $05004C09; { Alternative fire button }
+  DIBUTTON_FLYINGM_GEAR                   = $0500640A; { Gear up / down }
+  DIBUTTON_FLYINGM_BRAKE_LINK             = $050464E0; { Fallback brake button }
+  DIBUTTON_FLYINGM_FASTER_LINK            = $0503D4E0; { Fallback throttle up button }
+  DIBUTTON_FLYINGM_SLOWER_LINK            = $0503D4E8; { Fallback throttle down button }
+  DIBUTTON_FLYINGM_GLANCE_LEFT_LINK       = $0507C4E4; { Fallback Glance Left button }
+  DIBUTTON_FLYINGM_GLANCE_RIGHT_LINK      = $0507C4EC; { Fallback Glance Right button }
+  DIBUTTON_FLYINGM_GLANCE_UP_LINK         = $0507C4E0; { Fallback Glance Up button }
+  DIBUTTON_FLYINGM_GLANCE_DOWN_LINK       = $0507C4E8; { Fallback Glance Down button }
+  DIBUTTON_FLYINGM_DEVICE                 = $050044FE; { Show input device and controls }
+  DIBUTTON_FLYINGM_PAUSE                  = $050044FC; { Start / Pause / Restart game }
+
+(*--- Flight Simulator - Combat Helicopter
+      Combat from helicopter is primary objective  ---*)
+  DIVIRTUAL_FLYING_HELICOPTER             = $06000000;
+  DIAXIS_FLYINGH_BANK                     = $06008A01; { Bank - Roll ship left / right }
+  DIAXIS_FLYINGH_PITCH                    = $06010A02; { Pitch - Nose up / down }
+  DIAXIS_FLYINGH_COLLECTIVE               = $06018A03; { Collective - Blade pitch/power }
+  DIBUTTON_FLYINGH_FIRE                   = $06001401; { Fire }
+  DIBUTTON_FLYINGH_WEAPONS                = $06001402; { Select next weapon }
+  DIBUTTON_FLYINGH_TARGET                 = $06001403; { Selects next available target }
+  DIBUTTON_FLYINGH_MENU                   = $060004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_FLYINGH_GLANCE              = $06004601; { Look around }
+  DIAXIS_FLYINGH_TORQUE                   = $06025A04; { Torque - Rotate ship around left / right axis }
+  DIAXIS_FLYINGH_THROTTLE                 = $0603DA05; { Throttle }
+  DIBUTTON_FLYINGH_COUNTER                = $06005404; { Activate counter measures }
+  DIBUTTON_FLYINGH_VIEW                   = $06006405; { Cycle through view options }
+  DIBUTTON_FLYINGH_GEAR                   = $06006406; { Gear up / down }
+  DIBUTTON_FLYINGH_FIRESECONDARY          = $06004C07; { Alternative fire button }
+  DIBUTTON_FLYINGH_FASTER_LINK            = $0603DCE0; { Fallback throttle up button }
+  DIBUTTON_FLYINGH_SLOWER_LINK            = $0603DCE8; { Fallback throttle down button }
+  DIBUTTON_FLYINGH_GLANCE_LEFT_LINK       = $0607C4E4; { Fallback Glance Left button }
+  DIBUTTON_FLYINGH_GLANCE_RIGHT_LINK      = $0607C4EC; { Fallback Glance Right button }
+  DIBUTTON_FLYINGH_GLANCE_UP_LINK         = $0607C4E0; { Fallback Glance Up button }
+  DIBUTTON_FLYINGH_GLANCE_DOWN_LINK       = $0607C4E8; { Fallback Glance Down button }
+  DIBUTTON_FLYINGH_DEVICE                 = $060044FE; { Show input device and controls }
+  DIBUTTON_FLYINGH_PAUSE                  = $060044FC; { Start / Pause / Restart game }
+
+(*--- Space Simulator - Combat
+      Space Simulator with weapons  ---*)
+  DIVIRTUAL_SPACESIM                      = $07000000;
+  DIAXIS_SPACESIM_LATERAL                 = $07008201; { Move ship left / right }
+  DIAXIS_SPACESIM_MOVE                    = $07010202; { Move ship forward/backward }
+  DIAXIS_SPACESIM_THROTTLE                = $07038203; { Throttle - Engine speed }
+  DIBUTTON_SPACESIM_FIRE                  = $07000401; { Fire }
+  DIBUTTON_SPACESIM_WEAPONS               = $07000402; { Select next weapon }
+  DIBUTTON_SPACESIM_TARGET                = $07000403; { Selects next available target }
+  DIBUTTON_SPACESIM_MENU                  = $070004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_SPACESIM_GLANCE             = $07004601; { Look around }
+  DIAXIS_SPACESIM_CLIMB                   = $0701C204; { Climb - Pitch ship up/down }
+  DIAXIS_SPACESIM_ROTATE                  = $07024205; { Rotate - Turn ship left/right }
+  DIBUTTON_SPACESIM_VIEW                  = $07004404; { Cycle through view options }
+  DIBUTTON_SPACESIM_DISPLAY               = $07004405; { Select next dashboard / heads up display option }
+  DIBUTTON_SPACESIM_RAISE                 = $07004406; { Raise ship while maintaining current pitch }
+  DIBUTTON_SPACESIM_LOWER                 = $07004407; { Lower ship while maintaining current pitch }
+  DIBUTTON_SPACESIM_GEAR                  = $07004408; { Gear up / down }
+  DIBUTTON_SPACESIM_FIRESECONDARY         = $07004409; { Alternative fire button }
+  DIBUTTON_SPACESIM_LEFT_LINK             = $0700C4E4; { Fallback move left button }
+  DIBUTTON_SPACESIM_RIGHT_LINK            = $0700C4EC; { Fallback move right button }
+  DIBUTTON_SPACESIM_FORWARD_LINK          = $070144E0; { Fallback move forward button }
+  DIBUTTON_SPACESIM_BACKWARD_LINK         = $070144E8; { Fallback move backwards button }
+  DIBUTTON_SPACESIM_FASTER_LINK           = $0703C4E0; { Fallback throttle up button }
+  DIBUTTON_SPACESIM_SLOWER_LINK           = $0703C4E8; { Fallback throttle down button }
+  DIBUTTON_SPACESIM_TURN_LEFT_LINK        = $070244E4; { Fallback turn left button }
+  DIBUTTON_SPACESIM_TURN_RIGHT_LINK       = $070244EC; { Fallback turn right button }
+  DIBUTTON_SPACESIM_GLANCE_LEFT_LINK      = $0707C4E4; { Fallback Glance Left button }
+  DIBUTTON_SPACESIM_GLANCE_RIGHT_LINK     = $0707C4EC; { Fallback Glance Right button }
+  DIBUTTON_SPACESIM_GLANCE_UP_LINK        = $0707C4E0; { Fallback Glance Up button }
+  DIBUTTON_SPACESIM_GLANCE_DOWN_LINK      = $0707C4E8; { Fallback Glance Down button }
+  DIBUTTON_SPACESIM_DEVICE                = $070044FE; { Show input device and controls }
+  DIBUTTON_SPACESIM_PAUSE                 = $070044FC; { Start / Pause / Restart game }
+
+(*--- Fighting - First Person
+      Hand to Hand combat is primary objective  ---*)
+  DIVIRTUAL_FIGHTING_HAND2HAND            = $08000000;
+  DIAXIS_FIGHTINGH_LATERAL                = $08008201; { Sidestep left/right }
+  DIAXIS_FIGHTINGH_MOVE                   = $08010202; { Move forward/backward }
+  DIBUTTON_FIGHTINGH_PUNCH                = $08000401; { Punch }
+  DIBUTTON_FIGHTINGH_KICK                 = $08000402; { Kick }
+  DIBUTTON_FIGHTINGH_BLOCK                = $08000403; { Block }
+  DIBUTTON_FIGHTINGH_CROUCH               = $08000404; { Crouch }
+  DIBUTTON_FIGHTINGH_JUMP                 = $08000405; { Jump }
+  DIBUTTON_FIGHTINGH_SPECIAL1             = $08000406; { Apply first special move }
+  DIBUTTON_FIGHTINGH_SPECIAL2             = $08000407; { Apply second special move }
+  DIBUTTON_FIGHTINGH_MENU                 = $080004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_FIGHTINGH_SELECT               = $08004408; { Select special move }
+  DIHATSWITCH_FIGHTINGH_SLIDE             = $08004601; { Look around }
+  DIBUTTON_FIGHTINGH_DISPLAY              = $08004409; { Shows next on-screen display option }
+  DIAXIS_FIGHTINGH_ROTATE                 = $08024203; { Rotate - Turn body left/right }
+  DIBUTTON_FIGHTINGH_DODGE                = $0800440A; { Dodge }
+  DIBUTTON_FIGHTINGH_LEFT_LINK            = $0800C4E4; { Fallback left sidestep button }
+  DIBUTTON_FIGHTINGH_RIGHT_LINK           = $0800C4EC; { Fallback right sidestep button }
+  DIBUTTON_FIGHTINGH_FORWARD_LINK         = $080144E0; { Fallback forward button }
+  DIBUTTON_FIGHTINGH_BACKWARD_LINK        = $080144E8; { Fallback backward button }
+  DIBUTTON_FIGHTINGH_DEVICE               = $080044FE; { Show input device and controls }
+  DIBUTTON_FIGHTINGH_PAUSE                = $080044FC; { Start / Pause / Restart game }
+
+(*--- Fighting - First Person Shooting
+      Navigation and combat are primary objectives  ---*)
+  DIVIRTUAL_FIGHTING_FPS                  = $09000000;
+  DIAXIS_FPS_ROTATE                       = $09008201; { Rotate character left/right }
+  DIAXIS_FPS_MOVE                         = $09010202; { Move forward/backward }
+  DIBUTTON_FPS_FIRE                       = $09000401; { Fire }
+  DIBUTTON_FPS_WEAPONS                    = $09000402; { Select next weapon }
+  DIBUTTON_FPS_APPLY                      = $09000403; { Use item }
+  DIBUTTON_FPS_SELECT                     = $09000404; { Select next inventory item }
+  DIBUTTON_FPS_CROUCH                     = $09000405; { Crouch/ climb down/ swim down }
+  DIBUTTON_FPS_JUMP                       = $09000406; { Jump/ climb up/ swim up }
+  DIAXIS_FPS_LOOKUPDOWN                   = $09018203; { Look up / down  }
+  DIBUTTON_FPS_STRAFE                     = $09000407; { Enable strafing while active }
+  DIBUTTON_FPS_MENU                       = $090004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_FPS_GLANCE                  = $09004601; { Look around }
+  DIBUTTON_FPS_DISPLAY                    = $09004408; { Shows next on-screen display option/ map }
+  DIAXIS_FPS_SIDESTEP                     = $09024204; { Sidestep }
+  DIBUTTON_FPS_DODGE                      = $09004409; { Dodge }
+  DIBUTTON_FPS_GLANCEL                    = $0900440A; { Glance Left }
+  DIBUTTON_FPS_GLANCER                    = $0900440B; { Glance Right }
+  DIBUTTON_FPS_FIRESECONDARY              = $0900440C; { Alternative fire button }
+  DIBUTTON_FPS_ROTATE_LEFT_LINK           = $0900C4E4; { Fallback rotate left button }
+  DIBUTTON_FPS_ROTATE_RIGHT_LINK          = $0900C4EC; { Fallback rotate right button }
+  DIBUTTON_FPS_FORWARD_LINK               = $090144E0; { Fallback forward button }
+  DIBUTTON_FPS_BACKWARD_LINK              = $090144E8; { Fallback backward button }
+  DIBUTTON_FPS_GLANCE_UP_LINK             = $0901C4E0; { Fallback look up button }
+  DIBUTTON_FPS_GLANCE_DOWN_LINK           = $0901C4E8; { Fallback look down button }
+  DIBUTTON_FPS_STEP_LEFT_LINK             = $090244E4; { Fallback step left button }
+  DIBUTTON_FPS_STEP_RIGHT_LINK            = $090244EC; { Fallback step right button }
+  DIBUTTON_FPS_DEVICE                     = $090044FE; { Show input device and controls }
+  DIBUTTON_FPS_PAUSE                      = $090044FC; { Start / Pause / Restart game }
+
+(*--- Fighting - Third Person action
+      Perspective of camera is behind the main character  ---*)
+  DIVIRTUAL_FIGHTING_THIRDPERSON          = $0A000000;
+  DIAXIS_TPS_TURN                         = $0A020201; { Turn left/right }
+  DIAXIS_TPS_MOVE                         = $0A010202; { Move forward/backward }
+  DIBUTTON_TPS_RUN                        = $0A000401; { Run or walk toggle switch }
+  DIBUTTON_TPS_ACTION                     = $0A000402; { Action Button }
+  DIBUTTON_TPS_SELECT                     = $0A000403; { Select next weapon }
+  DIBUTTON_TPS_USE                        = $0A000404; { Use inventory item currently selected }
+  DIBUTTON_TPS_JUMP                       = $0A000405; { Character Jumps }
+  DIBUTTON_TPS_MENU                       = $0A0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_TPS_GLANCE                  = $0A004601; { Look around }
+  DIBUTTON_TPS_VIEW                       = $0A004406; { Select camera view }
+  DIBUTTON_TPS_STEPLEFT                   = $0A004407; { Character takes a left step }
+  DIBUTTON_TPS_STEPRIGHT                  = $0A004408; { Character takes a right step }
+  DIAXIS_TPS_STEP                         = $0A00C203; { Character steps left/right }
+  DIBUTTON_TPS_DODGE                      = $0A004409; { Character dodges or ducks }
+  DIBUTTON_TPS_INVENTORY                  = $0A00440A; { Cycle through inventory }
+  DIBUTTON_TPS_TURN_LEFT_LINK             = $0A0244E4; { Fallback turn left button }
+  DIBUTTON_TPS_TURN_RIGHT_LINK            = $0A0244EC; { Fallback turn right button }
+  DIBUTTON_TPS_FORWARD_LINK               = $0A0144E0; { Fallback forward button }
+  DIBUTTON_TPS_BACKWARD_LINK              = $0A0144E8; { Fallback backward button }
+  DIBUTTON_TPS_GLANCE_UP_LINK             = $0A07C4E0; { Fallback look up button }
+  DIBUTTON_TPS_GLANCE_DOWN_LINK           = $0A07C4E8; { Fallback look down button }
+  DIBUTTON_TPS_GLANCE_LEFT_LINK           = $0A07C4E4; { Fallback glance up button }
+  DIBUTTON_TPS_GLANCE_RIGHT_LINK          = $0A07C4EC; { Fallback glance right button }
+  DIBUTTON_TPS_DEVICE                     = $0A0044FE; { Show input device and controls }
+  DIBUTTON_TPS_PAUSE                      = $0A0044FC; { Start / Pause / Restart game }
+
+(*--- Strategy - Role Playing
+      Navigation and problem solving are primary actions  ---*)
+  DIVIRTUAL_STRATEGY_ROLEPLAYING          = $0B000000;
+  DIAXIS_STRATEGYR_LATERAL                = $0B008201; { sidestep - left/right }
+  DIAXIS_STRATEGYR_MOVE                   = $0B010202; { move forward/backward }
+  DIBUTTON_STRATEGYR_GET                  = $0B000401; { Acquire item }
+  DIBUTTON_STRATEGYR_APPLY                = $0B000402; { Use selected item }
+  DIBUTTON_STRATEGYR_SELECT               = $0B000403; { Select nextitem }
+  DIBUTTON_STRATEGYR_ATTACK               = $0B000404; { Attack }
+  DIBUTTON_STRATEGYR_CAST                 = $0B000405; { Cast Spell }
+  DIBUTTON_STRATEGYR_CROUCH               = $0B000406; { Crouch }
+  DIBUTTON_STRATEGYR_JUMP                 = $0B000407; { Jump }
+  DIBUTTON_STRATEGYR_MENU                 = $0B0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_STRATEGYR_GLANCE            = $0B004601; { Look around }
+  DIBUTTON_STRATEGYR_MAP                  = $0B004408; { Cycle through map options }
+  DIBUTTON_STRATEGYR_DISPLAY              = $0B004409; { Shows next on-screen display option }
+  DIAXIS_STRATEGYR_ROTATE                 = $0B024203; { Turn body left/right }
+  DIBUTTON_STRATEGYR_LEFT_LINK            = $0B00C4E4; { Fallback sidestep left button }
+  DIBUTTON_STRATEGYR_RIGHT_LINK           = $0B00C4EC; { Fallback sidestep right button }
+  DIBUTTON_STRATEGYR_FORWARD_LINK         = $0B0144E0; { Fallback move forward button }
+  DIBUTTON_STRATEGYR_BACK_LINK            = $0B0144E8; { Fallback move backward button }
+  DIBUTTON_STRATEGYR_ROTATE_LEFT_LINK     = $0B0244E4; { Fallback turn body left button }
+  DIBUTTON_STRATEGYR_ROTATE_RIGHT_LINK    = $0B0244EC; { Fallback turn body right button }
+  DIBUTTON_STRATEGYR_DEVICE               = $0B0044FE; { Show input device and controls }
+  DIBUTTON_STRATEGYR_PAUSE                = $0B0044FC; { Start / Pause / Restart game }
+
+(*--- Strategy - Turn based
+      Navigation and problem solving are primary actions  ---*)
+  DIVIRTUAL_STRATEGY_TURN                 = $0C000000;
+  DIAXIS_STRATEGYT_LATERAL                = $0C008201; { Sidestep left/right }
+  DIAXIS_STRATEGYT_MOVE                   = $0C010202; { Move forward/backwards }
+  DIBUTTON_STRATEGYT_SELECT               = $0C000401; { Select unit or object }
+  DIBUTTON_STRATEGYT_INSTRUCT             = $0C000402; { Cycle through instructions }
+  DIBUTTON_STRATEGYT_APPLY                = $0C000403; { Apply selected instruction }
+  DIBUTTON_STRATEGYT_TEAM                 = $0C000404; { Select next team / cycle through all }
+  DIBUTTON_STRATEGYT_TURN                 = $0C000405; { Indicate turn over }
+  DIBUTTON_STRATEGYT_MENU                 = $0C0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_STRATEGYT_ZOOM                 = $0C004406; { Zoom - in / out }
+  DIBUTTON_STRATEGYT_MAP                  = $0C004407; { cycle through map options }
+  DIBUTTON_STRATEGYT_DISPLAY              = $0C004408; { shows next on-screen display options }
+  DIBUTTON_STRATEGYT_LEFT_LINK            = $0C00C4E4; { Fallback sidestep left button }
+  DIBUTTON_STRATEGYT_RIGHT_LINK           = $0C00C4EC; { Fallback sidestep right button }
+  DIBUTTON_STRATEGYT_FORWARD_LINK         = $0C0144E0; { Fallback move forward button }
+  DIBUTTON_STRATEGYT_BACK_LINK            = $0C0144E8; { Fallback move back button }
+  DIBUTTON_STRATEGYT_DEVICE               = $0C0044FE; { Show input device and controls }
+  DIBUTTON_STRATEGYT_PAUSE                = $0C0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Hunting
+      Hunting                ---*)
+  DIVIRTUAL_SPORTS_HUNTING                = $0D000000;
+  DIAXIS_HUNTING_LATERAL                  = $0D008201; { sidestep left/right }
+  DIAXIS_HUNTING_MOVE                     = $0D010202; { move forward/backwards }
+  DIBUTTON_HUNTING_FIRE                   = $0D000401; { Fire selected weapon }
+  DIBUTTON_HUNTING_AIM                    = $0D000402; { Select aim/move }
+  DIBUTTON_HUNTING_WEAPON                 = $0D000403; { Select next weapon }
+  DIBUTTON_HUNTING_BINOCULAR              = $0D000404; { Look through Binoculars }
+  DIBUTTON_HUNTING_CALL                   = $0D000405; { Make animal call }
+  DIBUTTON_HUNTING_MAP                    = $0D000406; { View Map }
+  DIBUTTON_HUNTING_SPECIAL                = $0D000407; { Special game operation }
+  DIBUTTON_HUNTING_MENU                   = $0D0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_HUNTING_GLANCE              = $0D004601; { Look around }
+  DIBUTTON_HUNTING_DISPLAY                = $0D004408; { show next on-screen display option }
+  DIAXIS_HUNTING_ROTATE                   = $0D024203; { Turn body left/right }
+  DIBUTTON_HUNTING_CROUCH                 = $0D004409; { Crouch/ Climb / Swim down }
+  DIBUTTON_HUNTING_JUMP                   = $0D00440A; { Jump/ Climb up / Swim up }
+  DIBUTTON_HUNTING_FIRESECONDARY          = $0D00440B; { Alternative fire button }
+  DIBUTTON_HUNTING_LEFT_LINK              = $0D00C4E4; { Fallback sidestep left button }
+  DIBUTTON_HUNTING_RIGHT_LINK             = $0D00C4EC; { Fallback sidestep right button }
+  DIBUTTON_HUNTING_FORWARD_LINK           = $0D0144E0; { Fallback move forward button }
+  DIBUTTON_HUNTING_BACK_LINK              = $0D0144E8; { Fallback move back button }
+  DIBUTTON_HUNTING_ROTATE_LEFT_LINK       = $0D0244E4; { Fallback turn body left button }
+  DIBUTTON_HUNTING_ROTATE_RIGHT_LINK      = $0D0244EC; { Fallback turn body right button }
+  DIBUTTON_HUNTING_DEVICE                 = $0D0044FE; { Show input device and controls }
+  DIBUTTON_HUNTING_PAUSE                  = $0D0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Fishing
+      Catching Fish is primary objective   ---*)
+  DIVIRTUAL_SPORTS_FISHING                = $0E000000;
+  DIAXIS_FISHING_LATERAL                  = $0E008201; { sidestep left/right }
+  DIAXIS_FISHING_MOVE                     = $0E010202; { move forward/backwards }
+  DIBUTTON_FISHING_CAST                   = $0E000401; { Cast line }
+  DIBUTTON_FISHING_TYPE                   = $0E000402; { Select cast type }
+  DIBUTTON_FISHING_BINOCULAR              = $0E000403; { Look through Binocular }
+  DIBUTTON_FISHING_BAIT                   = $0E000404; { Select type of Bait }
+  DIBUTTON_FISHING_MAP                    = $0E000405; { View Map }
+  DIBUTTON_FISHING_MENU                   = $0E0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_FISHING_GLANCE              = $0E004601; { Look around }
+  DIBUTTON_FISHING_DISPLAY                = $0E004406; { Show next on-screen display option }
+  DIAXIS_FISHING_ROTATE                   = $0E024203; { Turn character left / right }
+  DIBUTTON_FISHING_CROUCH                 = $0E004407; { Crouch/ Climb / Swim down }
+  DIBUTTON_FISHING_JUMP                   = $0E004408; { Jump/ Climb up / Swim up }
+  DIBUTTON_FISHING_LEFT_LINK              = $0E00C4E4; { Fallback sidestep left button }
+  DIBUTTON_FISHING_RIGHT_LINK             = $0E00C4EC; { Fallback sidestep right button }
+  DIBUTTON_FISHING_FORWARD_LINK           = $0E0144E0; { Fallback move forward button }
+  DIBUTTON_FISHING_BACK_LINK              = $0E0144E8; { Fallback move back button }
+  DIBUTTON_FISHING_ROTATE_LEFT_LINK       = $0E0244E4; { Fallback turn body left button }
+  DIBUTTON_FISHING_ROTATE_RIGHT_LINK      = $0E0244EC; { Fallback turn body right button }
+  DIBUTTON_FISHING_DEVICE                 = $0E0044FE; { Show input device and controls }
+  DIBUTTON_FISHING_PAUSE                  = $0E0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Baseball - Batting
+      Batter control is primary objective  ---*)
+  DIVIRTUAL_SPORTS_BASEBALL_BAT           = $0F000000;
+  DIAXIS_BASEBALLB_LATERAL                = $0F008201; { Aim left / right }
+  DIAXIS_BASEBALLB_MOVE                   = $0F010202; { Aim up / down }
+  DIBUTTON_BASEBALLB_SELECT               = $0F000401; { cycle through swing options }
+  DIBUTTON_BASEBALLB_NORMAL               = $0F000402; { normal swing }
+  DIBUTTON_BASEBALLB_POWER                = $0F000403; { swing for the fence }
+  DIBUTTON_BASEBALLB_BUNT                 = $0F000404; { bunt }
+  DIBUTTON_BASEBALLB_STEAL                = $0F000405; { Base runner attempts to steal a base }
+  DIBUTTON_BASEBALLB_BURST                = $0F000406; { Base runner invokes burst of speed }
+  DIBUTTON_BASEBALLB_SLIDE                = $0F000407; { Base runner slides into base }
+  DIBUTTON_BASEBALLB_CONTACT              = $0F000408; { Contact swing }
+  DIBUTTON_BASEBALLB_MENU                 = $0F0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_BASEBALLB_NOSTEAL              = $0F004409; { Base runner goes back to a base }
+  DIBUTTON_BASEBALLB_BOX                  = $0F00440A; { Enter or exit batting box }
+  DIBUTTON_BASEBALLB_LEFT_LINK            = $0F00C4E4; { Fallback sidestep left button }
+  DIBUTTON_BASEBALLB_RIGHT_LINK           = $0F00C4EC; { Fallback sidestep right button }
+  DIBUTTON_BASEBALLB_FORWARD_LINK         = $0F0144E0; { Fallback move forward button }
+  DIBUTTON_BASEBALLB_BACK_LINK            = $0F0144E8; { Fallback move back button }
+  DIBUTTON_BASEBALLB_DEVICE               = $0F0044FE; { Show input device and controls }
+  DIBUTTON_BASEBALLB_PAUSE                = $0F0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Baseball - Pitching
+      Pitcher control is primary objective   ---*)
+  DIVIRTUAL_SPORTS_BASEBALL_PITCH         = $10000000;
+  DIAXIS_BASEBALLP_LATERAL                = $10008201; { Aim left / right }
+  DIAXIS_BASEBALLP_MOVE                   = $10010202; { Aim up / down }
+  DIBUTTON_BASEBALLP_SELECT               = $10000401; { cycle through pitch selections }
+  DIBUTTON_BASEBALLP_PITCH                = $10000402; { throw pitch }
+  DIBUTTON_BASEBALLP_BASE                 = $10000403; { select base to throw to }
+  DIBUTTON_BASEBALLP_THROW                = $10000404; { throw to base }
+  DIBUTTON_BASEBALLP_FAKE                 = $10000405; { Fake a throw to a base }
+  DIBUTTON_BASEBALLP_MENU                 = $100004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_BASEBALLP_WALK                 = $10004406; { Throw intentional walk / pitch out }
+  DIBUTTON_BASEBALLP_LOOK                 = $10004407; { Look at runners on bases }
+  DIBUTTON_BASEBALLP_LEFT_LINK            = $1000C4E4; { Fallback sidestep left button }
+  DIBUTTON_BASEBALLP_RIGHT_LINK           = $1000C4EC; { Fallback sidestep right button }
+  DIBUTTON_BASEBALLP_FORWARD_LINK         = $100144E0; { Fallback move forward button }
+  DIBUTTON_BASEBALLP_BACK_LINK            = $100144E8; { Fallback move back button }
+  DIBUTTON_BASEBALLP_DEVICE               = $100044FE; { Show input device and controls }
+  DIBUTTON_BASEBALLP_PAUSE                = $100044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Baseball - Fielding
+      Fielder control is primary objective  ---*)
+  DIVIRTUAL_SPORTS_BASEBALL_FIELD         = $11000000;
+  DIAXIS_BASEBALLF_LATERAL                = $11008201; { Aim left / right }
+  DIAXIS_BASEBALLF_MOVE                   = $11010202; { Aim up / down }
+  DIBUTTON_BASEBALLF_NEAREST              = $11000401; { Switch to fielder nearest to the ball }
+  DIBUTTON_BASEBALLF_THROW1               = $11000402; { Make conservative throw }
+  DIBUTTON_BASEBALLF_THROW2               = $11000403; { Make aggressive throw }
+  DIBUTTON_BASEBALLF_BURST                = $11000404; { Invoke burst of speed }
+  DIBUTTON_BASEBALLF_JUMP                 = $11000405; { Jump to catch ball }
+  DIBUTTON_BASEBALLF_DIVE                 = $11000406; { Dive to catch ball }
+  DIBUTTON_BASEBALLF_MENU                 = $110004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_BASEBALLF_SHIFTIN              = $11004407; { Shift the infield positioning }
+  DIBUTTON_BASEBALLF_SHIFTOUT             = $11004408; { Shift the outfield positioning }
+  DIBUTTON_BASEBALLF_AIM_LEFT_LINK        = $1100C4E4; { Fallback aim left button }
+  DIBUTTON_BASEBALLF_AIM_RIGHT_LINK       = $1100C4EC; { Fallback aim right button }
+  DIBUTTON_BASEBALLF_FORWARD_LINK         = $110144E0; { Fallback move forward button }
+  DIBUTTON_BASEBALLF_BACK_LINK            = $110144E8; { Fallback move back button }
+  DIBUTTON_BASEBALLF_DEVICE               = $110044FE; { Show input device and controls }
+  DIBUTTON_BASEBALLF_PAUSE                = $110044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Basketball - Offense
+      Offense  ---*)
+  DIVIRTUAL_SPORTS_BASKETBALL_OFFENSE     = $12000000;
+  DIAXIS_BBALLO_LATERAL                   = $12008201; { left / right }
+  DIAXIS_BBALLO_MOVE                      = $12010202; { up / down }
+  DIBUTTON_BBALLO_SHOOT                   = $12000401; { shoot basket }
+  DIBUTTON_BBALLO_DUNK                    = $12000402; { dunk basket }
+  DIBUTTON_BBALLO_PASS                    = $12000403; { throw pass }
+  DIBUTTON_BBALLO_FAKE                    = $12000404; { fake shot or pass }
+  DIBUTTON_BBALLO_SPECIAL                 = $12000405; { apply special move }
+  DIBUTTON_BBALLO_PLAYER                  = $12000406; { select next player }
+  DIBUTTON_BBALLO_BURST                   = $12000407; { invoke burst }
+  DIBUTTON_BBALLO_CALL                    = $12000408; { call for ball / pass to me }
+  DIBUTTON_BBALLO_MENU                    = $120004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_BBALLO_GLANCE               = $12004601; { scroll view }
+  DIBUTTON_BBALLO_SCREEN                  = $12004409; { Call for screen }
+  DIBUTTON_BBALLO_PLAY                    = $1200440A; { Call for specific offensive play }
+  DIBUTTON_BBALLO_JAB                     = $1200440B; { Initiate fake drive to basket }
+  DIBUTTON_BBALLO_POST                    = $1200440C; { Perform post move }
+  DIBUTTON_BBALLO_TIMEOUT                 = $1200440D; { Time Out }
+  DIBUTTON_BBALLO_SUBSTITUTE              = $1200440E; { substitute one player for another }
+  DIBUTTON_BBALLO_LEFT_LINK               = $1200C4E4; { Fallback sidestep left button }
+  DIBUTTON_BBALLO_RIGHT_LINK              = $1200C4EC; { Fallback sidestep right button }
+  DIBUTTON_BBALLO_FORWARD_LINK            = $120144E0; { Fallback move forward button }
+  DIBUTTON_BBALLO_BACK_LINK               = $120144E8; { Fallback move back button }
+  DIBUTTON_BBALLO_DEVICE                  = $120044FE; { Show input device and controls }
+  DIBUTTON_BBALLO_PAUSE                   = $120044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Basketball - Defense
+      Defense  ---*)
+  DIVIRTUAL_SPORTS_BASKETBALL_DEFENSE     = $13000000;
+  DIAXIS_BBALLD_LATERAL                   = $13008201; { left / right }
+  DIAXIS_BBALLD_MOVE                      = $13010202; { up / down }
+  DIBUTTON_BBALLD_JUMP                    = $13000401; { jump to block shot }
+  DIBUTTON_BBALLD_STEAL                   = $13000402; { attempt to steal ball }
+  DIBUTTON_BBALLD_FAKE                    = $13000403; { fake block or steal }
+  DIBUTTON_BBALLD_SPECIAL                 = $13000404; { apply special move }
+  DIBUTTON_BBALLD_PLAYER                  = $13000405; { select next player }
+  DIBUTTON_BBALLD_BURST                   = $13000406; { invoke burst }
+  DIBUTTON_BBALLD_PLAY                    = $13000407; { call for specific defensive play }
+  DIBUTTON_BBALLD_MENU                    = $130004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_BBALLD_GLANCE               = $13004601; { scroll view }
+  DIBUTTON_BBALLD_TIMEOUT                 = $13004408; { Time Out }
+  DIBUTTON_BBALLD_SUBSTITUTE              = $13004409; { substitute one player for another }
+  DIBUTTON_BBALLD_LEFT_LINK               = $1300C4E4; { Fallback sidestep left button }
+  DIBUTTON_BBALLD_RIGHT_LINK              = $1300C4EC; { Fallback sidestep right button }
+  DIBUTTON_BBALLD_FORWARD_LINK            = $130144E0; { Fallback move forward button }
+  DIBUTTON_BBALLD_BACK_LINK               = $130144E8; { Fallback move back button }
+  DIBUTTON_BBALLD_DEVICE                  = $130044FE; { Show input device and controls }
+  DIBUTTON_BBALLD_PAUSE                   = $130044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Football - Play
+      Play selection  ---*)
+  DIVIRTUAL_SPORTS_FOOTBALL_FIELD         = $14000000;
+  DIBUTTON_FOOTBALLP_PLAY                 = $14000401; { cycle through available plays }
+  DIBUTTON_FOOTBALLP_SELECT               = $14000402; { select play }
+  DIBUTTON_FOOTBALLP_HELP                 = $14000403; { Bring up pop-up help }
+  DIBUTTON_FOOTBALLP_MENU                 = $140004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_FOOTBALLP_DEVICE               = $140044FE; { Show input device and controls }
+  DIBUTTON_FOOTBALLP_PAUSE                = $140044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Football - QB
+      Offense: Quarterback / Kicker  ---*)
+  DIVIRTUAL_SPORTS_FOOTBALL_QBCK          = $15000000;
+  DIAXIS_FOOTBALLQ_LATERAL                = $15008201; { Move / Aim: left / right }
+  DIAXIS_FOOTBALLQ_MOVE                   = $15010202; { Move / Aim: up / down }
+  DIBUTTON_FOOTBALLQ_SELECT               = $15000401; { Select }
+  DIBUTTON_FOOTBALLQ_SNAP                 = $15000402; { snap ball - start play }
+  DIBUTTON_FOOTBALLQ_JUMP                 = $15000403; { jump over defender }
+  DIBUTTON_FOOTBALLQ_SLIDE                = $15000404; { Dive/Slide }
+  DIBUTTON_FOOTBALLQ_PASS                 = $15000405; { throws pass to receiver }
+  DIBUTTON_FOOTBALLQ_FAKE                 = $15000406; { pump fake pass or fake kick }
+  DIBUTTON_FOOTBALLQ_MENU                 = $150004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_FOOTBALLQ_FAKESNAP             = $15004407; { Fake snap  }
+  DIBUTTON_FOOTBALLQ_MOTION               = $15004408; { Send receivers in motion }
+  DIBUTTON_FOOTBALLQ_AUDIBLE              = $15004409; { Change offensive play at line of scrimmage }
+  DIBUTTON_FOOTBALLQ_LEFT_LINK            = $1500C4E4; { Fallback sidestep left button }
+  DIBUTTON_FOOTBALLQ_RIGHT_LINK           = $1500C4EC; { Fallback sidestep right button }
+  DIBUTTON_FOOTBALLQ_FORWARD_LINK         = $150144E0; { Fallback move forward button }
+  DIBUTTON_FOOTBALLQ_BACK_LINK            = $150144E8; { Fallback move back button }
+  DIBUTTON_FOOTBALLQ_DEVICE               = $150044FE; { Show input device and controls }
+  DIBUTTON_FOOTBALLQ_PAUSE                = $150044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Football - Offense
+      Offense - Runner  ---*)
+  DIVIRTUAL_SPORTS_FOOTBALL_OFFENSE       = $16000000;
+  DIAXIS_FOOTBALLO_LATERAL                = $16008201; { Move / Aim: left / right }
+  DIAXIS_FOOTBALLO_MOVE                   = $16010202; { Move / Aim: up / down }
+  DIBUTTON_FOOTBALLO_JUMP                 = $16000401; { jump or hurdle over defender }
+  DIBUTTON_FOOTBALLO_LEFTARM              = $16000402; { holds out left arm }
+  DIBUTTON_FOOTBALLO_RIGHTARM             = $16000403; { holds out right arm }
+  DIBUTTON_FOOTBALLO_THROW                = $16000404; { throw pass or lateral ball to another runner }
+  DIBUTTON_FOOTBALLO_SPIN                 = $16000405; { Spin to avoid defenders }
+  DIBUTTON_FOOTBALLO_MENU                 = $160004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_FOOTBALLO_JUKE                 = $16004406; { Use special move to avoid defenders }
+  DIBUTTON_FOOTBALLO_SHOULDER             = $16004407; { Lower shoulder to run over defenders }
+  DIBUTTON_FOOTBALLO_TURBO                = $16004408; { Speed burst past defenders }
+  DIBUTTON_FOOTBALLO_DIVE                 = $16004409; { Dive over defenders }
+  DIBUTTON_FOOTBALLO_ZOOM                 = $1600440A; { Zoom view in / out }
+  DIBUTTON_FOOTBALLO_SUBSTITUTE           = $1600440B; { substitute one player for another }
+  DIBUTTON_FOOTBALLO_LEFT_LINK            = $1600C4E4; { Fallback sidestep left button }
+  DIBUTTON_FOOTBALLO_RIGHT_LINK           = $1600C4EC; { Fallback sidestep right button }
+  DIBUTTON_FOOTBALLO_FORWARD_LINK         = $160144E0; { Fallback move forward button }
+  DIBUTTON_FOOTBALLO_BACK_LINK            = $160144E8; { Fallback move back button }
+  DIBUTTON_FOOTBALLO_DEVICE               = $160044FE; { Show input device and controls }
+  DIBUTTON_FOOTBALLO_PAUSE                = $160044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Football - Defense
+      Defense     ---*)
+  DIVIRTUAL_SPORTS_FOOTBALL_DEFENSE       = $17000000;
+  DIAXIS_FOOTBALLD_LATERAL                = $17008201; { Move / Aim: left / right }
+  DIAXIS_FOOTBALLD_MOVE                   = $17010202; { Move / Aim: up / down }
+  DIBUTTON_FOOTBALLD_PLAY                 = $17000401; { cycle through available plays }
+  DIBUTTON_FOOTBALLD_SELECT               = $17000402; { select player closest to the ball }
+  DIBUTTON_FOOTBALLD_JUMP                 = $17000403; { jump to intercept or block }
+  DIBUTTON_FOOTBALLD_TACKLE               = $17000404; { tackler runner }
+  DIBUTTON_FOOTBALLD_FAKE                 = $17000405; { hold down to fake tackle or intercept }
+  DIBUTTON_FOOTBALLD_SUPERTACKLE          = $17000406; { Initiate special tackle }
+  DIBUTTON_FOOTBALLD_MENU                 = $170004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_FOOTBALLD_SPIN                 = $17004407; { Spin to beat offensive line }
+  DIBUTTON_FOOTBALLD_SWIM                 = $17004408; { Swim to beat the offensive line }
+  DIBUTTON_FOOTBALLD_BULLRUSH             = $17004409; { Bull rush the offensive line }
+  DIBUTTON_FOOTBALLD_RIP                  = $1700440A; { Rip the offensive line }
+  DIBUTTON_FOOTBALLD_AUDIBLE              = $1700440B; { Change defensive play at the line of scrimmage }
+  DIBUTTON_FOOTBALLD_ZOOM                 = $1700440C; { Zoom view in / out }
+  DIBUTTON_FOOTBALLD_SUBSTITUTE           = $1700440D; { substitute one player for another }
+  DIBUTTON_FOOTBALLD_LEFT_LINK            = $1700C4E4; { Fallback sidestep left button }
+  DIBUTTON_FOOTBALLD_RIGHT_LINK           = $1700C4EC; { Fallback sidestep right button }
+  DIBUTTON_FOOTBALLD_FORWARD_LINK         = $170144E0; { Fallback move forward button }
+  DIBUTTON_FOOTBALLD_BACK_LINK            = $170144E8; { Fallback move back button }
+  DIBUTTON_FOOTBALLD_DEVICE               = $170044FE; { Show input device and controls }
+  DIBUTTON_FOOTBALLD_PAUSE                = $170044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Golf
+                                ---*)
+  DIVIRTUAL_SPORTS_GOLF                   = $18000000;
+  DIAXIS_GOLF_LATERAL                     = $18008201; { Move / Aim: left / right }
+  DIAXIS_GOLF_MOVE                        = $18010202; { Move / Aim: up / down }
+  DIBUTTON_GOLF_SWING                     = $18000401; { swing club }
+  DIBUTTON_GOLF_SELECT                    = $18000402; { cycle between: club / swing strength / ball arc / ball spin }
+  DIBUTTON_GOLF_UP                        = $18000403; { increase selection }
+  DIBUTTON_GOLF_DOWN                      = $18000404; { decrease selection }
+  DIBUTTON_GOLF_TERRAIN                   = $18000405; { shows terrain detail }
+  DIBUTTON_GOLF_FLYBY                     = $18000406; { view the hole via a flyby }
+  DIBUTTON_GOLF_MENU                      = $180004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_GOLF_SCROLL                 = $18004601; { scroll view }
+  DIBUTTON_GOLF_ZOOM                      = $18004407; { Zoom view in / out }
+  DIBUTTON_GOLF_TIMEOUT                   = $18004408; { Call for time out }
+  DIBUTTON_GOLF_SUBSTITUTE                = $18004409; { substitute one player for another }
+  DIBUTTON_GOLF_LEFT_LINK                 = $1800C4E4; { Fallback sidestep left button }
+  DIBUTTON_GOLF_RIGHT_LINK                = $1800C4EC; { Fallback sidestep right button }
+  DIBUTTON_GOLF_FORWARD_LINK              = $180144E0; { Fallback move forward button }
+  DIBUTTON_GOLF_BACK_LINK                 = $180144E8; { Fallback move back button }
+  DIBUTTON_GOLF_DEVICE                    = $180044FE; { Show input device and controls }
+  DIBUTTON_GOLF_PAUSE                     = $180044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Hockey - Offense
+      Offense       ---*)
+  DIVIRTUAL_SPORTS_HOCKEY_OFFENSE         = $19000000;
+  DIAXIS_HOCKEYO_LATERAL                  = $19008201; { Move / Aim: left / right }
+  DIAXIS_HOCKEYO_MOVE                     = $19010202; { Move / Aim: up / down }
+  DIBUTTON_HOCKEYO_SHOOT                  = $19000401; { Shoot }
+  DIBUTTON_HOCKEYO_PASS                   = $19000402; { pass the puck }
+  DIBUTTON_HOCKEYO_BURST                  = $19000403; { invoke speed burst }
+  DIBUTTON_HOCKEYO_SPECIAL                = $19000404; { invoke special move }
+  DIBUTTON_HOCKEYO_FAKE                   = $19000405; { hold down to fake pass or kick }
+  DIBUTTON_HOCKEYO_MENU                   = $190004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_HOCKEYO_SCROLL              = $19004601; { scroll view }
+  DIBUTTON_HOCKEYO_ZOOM                   = $19004406; { Zoom view in / out }
+  DIBUTTON_HOCKEYO_STRATEGY               = $19004407; { Invoke coaching menu for strategy help }
+  DIBUTTON_HOCKEYO_TIMEOUT                = $19004408; { Call for time out }
+  DIBUTTON_HOCKEYO_SUBSTITUTE             = $19004409; { substitute one player for another }
+  DIBUTTON_HOCKEYO_LEFT_LINK              = $1900C4E4; { Fallback sidestep left button }
+  DIBUTTON_HOCKEYO_RIGHT_LINK             = $1900C4EC; { Fallback sidestep right button }
+  DIBUTTON_HOCKEYO_FORWARD_LINK           = $190144E0; { Fallback move forward button }
+  DIBUTTON_HOCKEYO_BACK_LINK              = $190144E8; { Fallback move back button }
+  DIBUTTON_HOCKEYO_DEVICE                 = $190044FE; { Show input device and controls }
+  DIBUTTON_HOCKEYO_PAUSE                  = $190044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Hockey - Defense
+      Defense       ---*)
+  DIVIRTUAL_SPORTS_HOCKEY_DEFENSE         = $1A000000;
+  DIAXIS_HOCKEYD_LATERAL                  = $1A008201; { Move / Aim: left / right }
+  DIAXIS_HOCKEYD_MOVE                     = $1A010202; { Move / Aim: up / down }
+  DIBUTTON_HOCKEYD_PLAYER                 = $1A000401; { control player closest to the puck }
+  DIBUTTON_HOCKEYD_STEAL                  = $1A000402; { attempt steal }
+  DIBUTTON_HOCKEYD_BURST                  = $1A000403; { speed burst or body check }
+  DIBUTTON_HOCKEYD_BLOCK                  = $1A000404; { block puck }
+  DIBUTTON_HOCKEYD_FAKE                   = $1A000405; { hold down to fake tackle or intercept }
+  DIBUTTON_HOCKEYD_MENU                   = $1A0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_HOCKEYD_SCROLL              = $1A004601; { scroll view }
+  DIBUTTON_HOCKEYD_ZOOM                   = $1A004406; { Zoom view in / out }
+  DIBUTTON_HOCKEYD_STRATEGY               = $1A004407; { Invoke coaching menu for strategy help }
+  DIBUTTON_HOCKEYD_TIMEOUT                = $1A004408; { Call for time out }
+  DIBUTTON_HOCKEYD_SUBSTITUTE             = $1A004409; { substitute one player for another }
+  DIBUTTON_HOCKEYD_LEFT_LINK              = $1A00C4E4; { Fallback sidestep left button }
+  DIBUTTON_HOCKEYD_RIGHT_LINK             = $1A00C4EC; { Fallback sidestep right button }
+  DIBUTTON_HOCKEYD_FORWARD_LINK           = $1A0144E0; { Fallback move forward button }
+  DIBUTTON_HOCKEYD_BACK_LINK              = $1A0144E8; { Fallback move back button }
+  DIBUTTON_HOCKEYD_DEVICE                 = $1A0044FE; { Show input device and controls }
+  DIBUTTON_HOCKEYD_PAUSE                  = $1A0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Hockey - Goalie
+      Goal tending  ---*)
+  DIVIRTUAL_SPORTS_HOCKEY_GOALIE          = $1B000000;
+  DIAXIS_HOCKEYG_LATERAL                  = $1B008201; { Move / Aim: left / right }
+  DIAXIS_HOCKEYG_MOVE                     = $1B010202; { Move / Aim: up / down }
+  DIBUTTON_HOCKEYG_PASS                   = $1B000401; { pass puck }
+  DIBUTTON_HOCKEYG_POKE                   = $1B000402; { poke / check / hack }
+  DIBUTTON_HOCKEYG_STEAL                  = $1B000403; { attempt steal }
+  DIBUTTON_HOCKEYG_BLOCK                  = $1B000404; { block puck }
+  DIBUTTON_HOCKEYG_MENU                   = $1B0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_HOCKEYG_SCROLL              = $1B004601; { scroll view }
+  DIBUTTON_HOCKEYG_ZOOM                   = $1B004405; { Zoom view in / out }
+  DIBUTTON_HOCKEYG_STRATEGY               = $1B004406; { Invoke coaching menu for strategy help }
+  DIBUTTON_HOCKEYG_TIMEOUT                = $1B004407; { Call for time out }
+  DIBUTTON_HOCKEYG_SUBSTITUTE             = $1B004408; { substitute one player for another }
+  DIBUTTON_HOCKEYG_LEFT_LINK              = $1B00C4E4; { Fallback sidestep left button }
+  DIBUTTON_HOCKEYG_RIGHT_LINK             = $1B00C4EC; { Fallback sidestep right button }
+  DIBUTTON_HOCKEYG_FORWARD_LINK           = $1B0144E0; { Fallback move forward button }
+  DIBUTTON_HOCKEYG_BACK_LINK              = $1B0144E8; { Fallback move back button }
+  DIBUTTON_HOCKEYG_DEVICE                 = $1B0044FE; { Show input device and controls }
+  DIBUTTON_HOCKEYG_PAUSE                  = $1B0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Mountain Biking
+                     ---*)
+  DIVIRTUAL_SPORTS_BIKING_MOUNTAIN        = $1C000000;
+  DIAXIS_BIKINGM_TURN                     = $1C008201; { left / right }
+  DIAXIS_BIKINGM_PEDAL                    = $1C010202; { Pedal faster / slower / brake }
+  DIBUTTON_BIKINGM_JUMP                   = $1C000401; { jump over obstacle }
+  DIBUTTON_BIKINGM_CAMERA                 = $1C000402; { switch camera view }
+  DIBUTTON_BIKINGM_SPECIAL1               = $1C000403; { perform first special move }
+  DIBUTTON_BIKINGM_SELECT                 = $1C000404; { Select }
+  DIBUTTON_BIKINGM_SPECIAL2               = $1C000405; { perform second special move }
+  DIBUTTON_BIKINGM_MENU                   = $1C0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_BIKINGM_SCROLL              = $1C004601; { scroll view }
+  DIBUTTON_BIKINGM_ZOOM                   = $1C004406; { Zoom view in / out }
+  DIAXIS_BIKINGM_BRAKE                    = $1C044203; { Brake axis  }
+  DIBUTTON_BIKINGM_LEFT_LINK              = $1C00C4E4; { Fallback turn left button }
+  DIBUTTON_BIKINGM_RIGHT_LINK             = $1C00C4EC; { Fallback turn right button }
+  DIBUTTON_BIKINGM_FASTER_LINK            = $1C0144E0; { Fallback pedal faster button }
+  DIBUTTON_BIKINGM_SLOWER_LINK            = $1C0144E8; { Fallback pedal slower button }
+  DIBUTTON_BIKINGM_BRAKE_BUTTON_LINK      = $1C0444E8; { Fallback brake button }
+  DIBUTTON_BIKINGM_DEVICE                 = $1C0044FE; { Show input device and controls }
+  DIBUTTON_BIKINGM_PAUSE                  = $1C0044FC; { Start / Pause / Restart game }
+
+(*--- Sports: Skiing / Snowboarding / Skateboarding
+        ---*)
+  DIVIRTUAL_SPORTS_SKIING                 = $1D000000;
+  DIAXIS_SKIING_TURN                      = $1D008201; { left / right }
+  DIAXIS_SKIING_SPEED                     = $1D010202; { faster / slower }
+  DIBUTTON_SKIING_JUMP                    = $1D000401; { Jump }
+  DIBUTTON_SKIING_CROUCH                  = $1D000402; { crouch down }
+  DIBUTTON_SKIING_CAMERA                  = $1D000403; { switch camera view }
+  DIBUTTON_SKIING_SPECIAL1                = $1D000404; { perform first special move }
+  DIBUTTON_SKIING_SELECT                  = $1D000405; { Select }
+  DIBUTTON_SKIING_SPECIAL2                = $1D000406; { perform second special move }
+  DIBUTTON_SKIING_MENU                    = $1D0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_SKIING_GLANCE               = $1D004601; { scroll view }
+  DIBUTTON_SKIING_ZOOM                    = $1D004407; { Zoom view in / out }
+  DIBUTTON_SKIING_LEFT_LINK               = $1D00C4E4; { Fallback turn left button }
+  DIBUTTON_SKIING_RIGHT_LINK              = $1D00C4EC; { Fallback turn right button }
+  DIBUTTON_SKIING_FASTER_LINK             = $1D0144E0; { Fallback increase speed button }
+  DIBUTTON_SKIING_SLOWER_LINK             = $1D0144E8; { Fallback decrease speed button }
+  DIBUTTON_SKIING_DEVICE                  = $1D0044FE; { Show input device and controls }
+  DIBUTTON_SKIING_PAUSE                   = $1D0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Soccer - Offense
+      Offense       ---*)
+  DIVIRTUAL_SPORTS_SOCCER_OFFENSE         = $1E000000;
+  DIAXIS_SOCCERO_LATERAL                  = $1E008201; { Move / Aim: left / right }
+  DIAXIS_SOCCERO_MOVE                     = $1E010202; { Move / Aim: up / down }
+  DIAXIS_SOCCERO_BEND                     = $1E018203; { Bend to soccer shot/pass }
+  DIBUTTON_SOCCERO_SHOOT                  = $1E000401; { Shoot the ball }
+  DIBUTTON_SOCCERO_PASS                   = $1E000402; { Pass  }
+  DIBUTTON_SOCCERO_FAKE                   = $1E000403; { Fake }
+  DIBUTTON_SOCCERO_PLAYER                 = $1E000404; { Select next player }
+  DIBUTTON_SOCCERO_SPECIAL1               = $1E000405; { Apply special move }
+  DIBUTTON_SOCCERO_SELECT                 = $1E000406; { Select special move }
+  DIBUTTON_SOCCERO_MENU                   = $1E0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_SOCCERO_GLANCE              = $1E004601; { scroll view }
+  DIBUTTON_SOCCERO_SUBSTITUTE             = $1E004407; { Substitute one player for another }
+  DIBUTTON_SOCCERO_SHOOTLOW               = $1E004408; { Shoot the ball low }
+  DIBUTTON_SOCCERO_SHOOTHIGH              = $1E004409; { Shoot the ball high }
+  DIBUTTON_SOCCERO_PASSTHRU               = $1E00440A; { Make a thru pass }
+  DIBUTTON_SOCCERO_SPRINT                 = $1E00440B; { Sprint / turbo boost }
+  DIBUTTON_SOCCERO_CONTROL                = $1E00440C; { Obtain control of the ball }
+  DIBUTTON_SOCCERO_HEAD                   = $1E00440D; { Attempt to head the ball }
+  DIBUTTON_SOCCERO_LEFT_LINK              = $1E00C4E4; { Fallback sidestep left button }
+  DIBUTTON_SOCCERO_RIGHT_LINK             = $1E00C4EC; { Fallback sidestep right button }
+  DIBUTTON_SOCCERO_FORWARD_LINK           = $1E0144E0; { Fallback move forward button }
+  DIBUTTON_SOCCERO_BACK_LINK              = $1E0144E8; { Fallback move back button }
+  DIBUTTON_SOCCERO_DEVICE                 = $1E0044FE; { Show input device and controls }
+  DIBUTTON_SOCCERO_PAUSE                  = $1E0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Soccer - Defense
+      Defense       ---*)
+  DIVIRTUAL_SPORTS_SOCCER_DEFENSE         = $1F000000;
+  DIAXIS_SOCCERD_LATERAL                  = $1F008201; { Move / Aim: left / right }
+  DIAXIS_SOCCERD_MOVE                     = $1F010202; { Move / Aim: up / down }
+  DIBUTTON_SOCCERD_BLOCK                  = $1F000401; { Attempt to block shot }
+  DIBUTTON_SOCCERD_STEAL                  = $1F000402; { Attempt to steal ball }
+  DIBUTTON_SOCCERD_FAKE                   = $1F000403; { Fake a block or a steal }
+  DIBUTTON_SOCCERD_PLAYER                 = $1F000404; { Select next player }
+  DIBUTTON_SOCCERD_SPECIAL                = $1F000405; { Apply special move }
+  DIBUTTON_SOCCERD_SELECT                 = $1F000406; { Select special move }
+  DIBUTTON_SOCCERD_SLIDE                  = $1F000407; { Attempt a slide tackle }
+  DIBUTTON_SOCCERD_MENU                   = $1F0004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_SOCCERD_GLANCE              = $1F004601; { scroll view }
+  DIBUTTON_SOCCERD_FOUL                   = $1F004408; { Initiate a foul / hard-foul }
+  DIBUTTON_SOCCERD_HEAD                   = $1F004409; { Attempt a Header }
+  DIBUTTON_SOCCERD_CLEAR                  = $1F00440A; { Attempt to clear the ball down the field }
+  DIBUTTON_SOCCERD_GOALIECHARGE           = $1F00440B; { Make the goalie charge out of the box }
+  DIBUTTON_SOCCERD_SUBSTITUTE             = $1F00440C; { Substitute one player for another }
+  DIBUTTON_SOCCERD_LEFT_LINK              = $1F00C4E4; { Fallback sidestep left button }
+  DIBUTTON_SOCCERD_RIGHT_LINK             = $1F00C4EC; { Fallback sidestep right button }
+  DIBUTTON_SOCCERD_FORWARD_LINK           = $1F0144E0; { Fallback move forward button }
+  DIBUTTON_SOCCERD_BACK_LINK              = $1F0144E8; { Fallback move back button }
+  DIBUTTON_SOCCERD_DEVICE                 = $1F0044FE; { Show input device and controls }
+  DIBUTTON_SOCCERD_PAUSE                  = $1F0044FC; { Start / Pause / Restart game }
+
+(*--- Sports - Racquet
+      Tennis - Table-Tennis - Squash   ---*)
+  DIVIRTUAL_SPORTS_RACQUET                = $20000000;
+  DIAXIS_RACQUET_LATERAL                  = $20008201; { Move / Aim: left / right }
+  DIAXIS_RACQUET_MOVE                     = $20010202; { Move / Aim: up / down }
+  DIBUTTON_RACQUET_SWING                  = $20000401; { Swing racquet }
+  DIBUTTON_RACQUET_BACKSWING              = $20000402; { Swing backhand }
+  DIBUTTON_RACQUET_SMASH                  = $20000403; { Smash shot }
+  DIBUTTON_RACQUET_SPECIAL                = $20000404; { Special shot }
+  DIBUTTON_RACQUET_SELECT                 = $20000405; { Select special shot }
+  DIBUTTON_RACQUET_MENU                   = $200004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_RACQUET_GLANCE              = $20004601; { scroll view }
+  DIBUTTON_RACQUET_TIMEOUT                = $20004406; { Call for time out }
+  DIBUTTON_RACQUET_SUBSTITUTE             = $20004407; { Substitute one player for another }
+  DIBUTTON_RACQUET_LEFT_LINK              = $2000C4E4; { Fallback sidestep left button }
+  DIBUTTON_RACQUET_RIGHT_LINK             = $2000C4EC; { Fallback sidestep right button }
+  DIBUTTON_RACQUET_FORWARD_LINK           = $200144E0; { Fallback move forward button }
+  DIBUTTON_RACQUET_BACK_LINK              = $200144E8; { Fallback move back button }
+  DIBUTTON_RACQUET_DEVICE                 = $200044FE; { Show input device and controls }
+  DIBUTTON_RACQUET_PAUSE                  = $200044FC; { Start / Pause / Restart game }
+
+(*--- Arcade- 2D
+      Side to Side movement        ---*)
+  DIVIRTUAL_ARCADE_SIDE2SIDE              = $21000000;
+  DIAXIS_ARCADES_LATERAL                  = $21008201; { left / right }
+  DIAXIS_ARCADES_MOVE                     = $21010202; { up / down }
+  DIBUTTON_ARCADES_THROW                  = $21000401; { throw object }
+  DIBUTTON_ARCADES_CARRY                  = $21000402; { carry object }
+  DIBUTTON_ARCADES_ATTACK                 = $21000403; { attack }
+  DIBUTTON_ARCADES_SPECIAL                = $21000404; { apply special move }
+  DIBUTTON_ARCADES_SELECT                 = $21000405; { select special move }
+  DIBUTTON_ARCADES_MENU                   = $210004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_ARCADES_VIEW                = $21004601; { scroll view left / right / up / down }
+  DIBUTTON_ARCADES_LEFT_LINK              = $2100C4E4; { Fallback sidestep left button }
+  DIBUTTON_ARCADES_RIGHT_LINK             = $2100C4EC; { Fallback sidestep right button }
+  DIBUTTON_ARCADES_FORWARD_LINK           = $210144E0; { Fallback move forward button }
+  DIBUTTON_ARCADES_BACK_LINK              = $210144E8; { Fallback move back button }
+  DIBUTTON_ARCADES_VIEW_UP_LINK           = $2107C4E0; { Fallback scroll view up button }
+  DIBUTTON_ARCADES_VIEW_DOWN_LINK         = $2107C4E8; { Fallback scroll view down button }
+  DIBUTTON_ARCADES_VIEW_LEFT_LINK         = $2107C4E4; { Fallback scroll view left button }
+  DIBUTTON_ARCADES_VIEW_RIGHT_LINK        = $2107C4EC; { Fallback scroll view right button }
+  DIBUTTON_ARCADES_DEVICE                 = $210044FE; { Show input device and controls }
+  DIBUTTON_ARCADES_PAUSE                  = $210044FC; { Start / Pause / Restart game }
+
+(*--- Arcade - Platform Game
+      Character moves around on screen  ---*)
+  DIVIRTUAL_ARCADE_PLATFORM               = $22000000;
+  DIAXIS_ARCADEP_LATERAL                  = $22008201; { Left / right }
+  DIAXIS_ARCADEP_MOVE                     = $22010202; { Up / down }
+  DIBUTTON_ARCADEP_JUMP                   = $22000401; { Jump }
+  DIBUTTON_ARCADEP_FIRE                   = $22000402; { Fire }
+  DIBUTTON_ARCADEP_CROUCH                 = $22000403; { Crouch }
+  DIBUTTON_ARCADEP_SPECIAL                = $22000404; { Apply special move }
+  DIBUTTON_ARCADEP_SELECT                 = $22000405; { Select special move }
+  DIBUTTON_ARCADEP_MENU                   = $220004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_ARCADEP_VIEW                = $22004601; { Scroll view }
+  DIBUTTON_ARCADEP_FIRESECONDARY          = $22004406; { Alternative fire button }
+  DIBUTTON_ARCADEP_LEFT_LINK              = $2200C4E4; { Fallback sidestep left button }
+  DIBUTTON_ARCADEP_RIGHT_LINK             = $2200C4EC; { Fallback sidestep right button }
+  DIBUTTON_ARCADEP_FORWARD_LINK           = $220144E0; { Fallback move forward button }
+  DIBUTTON_ARCADEP_BACK_LINK              = $220144E8; { Fallback move back button }
+  DIBUTTON_ARCADEP_VIEW_UP_LINK           = $2207C4E0; { Fallback scroll view up button }
+  DIBUTTON_ARCADEP_VIEW_DOWN_LINK         = $2207C4E8; { Fallback scroll view down button }
+  DIBUTTON_ARCADEP_VIEW_LEFT_LINK         = $2207C4E4; { Fallback scroll view left button }
+  DIBUTTON_ARCADEP_VIEW_RIGHT_LINK        = $2207C4EC; { Fallback scroll view right button }
+  DIBUTTON_ARCADEP_DEVICE                 = $220044FE; { Show input device and controls }
+  DIBUTTON_ARCADEP_PAUSE                  = $220044FC; { Start / Pause / Restart game }
+
+(*--- CAD - 2D Object Control
+      Controls to select and move objects in 2D  ---*)
+  DIVIRTUAL_CAD_2DCONTROL                 = $23000000;
+  DIAXIS_2DCONTROL_LATERAL                = $23008201; { Move view left / right }
+  DIAXIS_2DCONTROL_MOVE                   = $23010202; { Move view up / down }
+  DIAXIS_2DCONTROL_INOUT                  = $23018203; { Zoom - in / out }
+  DIBUTTON_2DCONTROL_SELECT               = $23000401; { Select Object }
+  DIBUTTON_2DCONTROL_SPECIAL1             = $23000402; { Do first special operation }
+  DIBUTTON_2DCONTROL_SPECIAL              = $23000403; { Select special operation }
+  DIBUTTON_2DCONTROL_SPECIAL2             = $23000404; { Do second special operation }
+  DIBUTTON_2DCONTROL_MENU                 = $230004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_2DCONTROL_HATSWITCH         = $23004601; { Hat switch }
+  DIAXIS_2DCONTROL_ROTATEZ                = $23024204; { Rotate view clockwise / counterclockwise }
+  DIBUTTON_2DCONTROL_DISPLAY              = $23004405; { Shows next on-screen display options }
+  DIBUTTON_2DCONTROL_DEVICE               = $230044FE; { Show input device and controls }
+  DIBUTTON_2DCONTROL_PAUSE                = $230044FC; { Start / Pause / Restart game }
+
+(*--- CAD - 3D object control
+      Controls to select and move objects within a 3D environment  ---*)
+  DIVIRTUAL_CAD_3DCONTROL                 = $24000000;
+  DIAXIS_3DCONTROL_LATERAL                = $24008201; { Move view left / right }
+  DIAXIS_3DCONTROL_MOVE                   = $24010202; { Move view up / down }
+  DIAXIS_3DCONTROL_INOUT                  = $24018203; { Zoom - in / out }
+  DIBUTTON_3DCONTROL_SELECT               = $24000401; { Select Object }
+  DIBUTTON_3DCONTROL_SPECIAL1             = $24000402; { Do first special operation }
+  DIBUTTON_3DCONTROL_SPECIAL              = $24000403; { Select special operation }
+  DIBUTTON_3DCONTROL_SPECIAL2             = $24000404; { Do second special operation }
+  DIBUTTON_3DCONTROL_MENU                 = $240004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_3DCONTROL_HATSWITCH         = $24004601; { Hat switch }
+  DIAXIS_3DCONTROL_ROTATEX                = $24034204; { Rotate view forward or up / backward or down }
+  DIAXIS_3DCONTROL_ROTATEY                = $2402C205; { Rotate view clockwise / counterclockwise }
+  DIAXIS_3DCONTROL_ROTATEZ                = $24024206; { Rotate view left / right }
+  DIBUTTON_3DCONTROL_DISPLAY              = $24004405; { Show next on-screen display options }
+  DIBUTTON_3DCONTROL_DEVICE               = $240044FE; { Show input device and controls }
+  DIBUTTON_3DCONTROL_PAUSE                = $240044FC; { Start / Pause / Restart game }
+
+(*--- CAD - 3D Navigation - Fly through
+      Controls for 3D modeling  ---*)
+  DIVIRTUAL_CAD_FLYBY                     = $25000000;
+  DIAXIS_CADF_LATERAL                     = $25008201; { move view left / right }
+  DIAXIS_CADF_MOVE                        = $25010202; { move view up / down }
+  DIAXIS_CADF_INOUT                       = $25018203; { in / out }
+  DIBUTTON_CADF_SELECT                    = $25000401; { Select Object }
+  DIBUTTON_CADF_SPECIAL1                  = $25000402; { do first special operation }
+  DIBUTTON_CADF_SPECIAL                   = $25000403; { Select special operation }
+  DIBUTTON_CADF_SPECIAL2                  = $25000404; { do second special operation }
+  DIBUTTON_CADF_MENU                      = $250004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_CADF_HATSWITCH              = $25004601; { Hat switch }
+  DIAXIS_CADF_ROTATEX                     = $25034204; { Rotate view forward or up / backward or down }
+  DIAXIS_CADF_ROTATEY                     = $2502C205; { Rotate view clockwise / counterclockwise }
+  DIAXIS_CADF_ROTATEZ                     = $25024206; { Rotate view left / right }
+  DIBUTTON_CADF_DISPLAY                   = $25004405; { shows next on-screen display options }
+  DIBUTTON_CADF_DEVICE                    = $250044FE; { Show input device and controls }
+  DIBUTTON_CADF_PAUSE                     = $250044FC; { Start / Pause / Restart game }
+
+(*--- CAD - 3D Model Control
+      Controls for 3D modeling  ---*)
+  DIVIRTUAL_CAD_MODEL                     = $26000000;
+  DIAXIS_CADM_LATERAL                     = $26008201; { move view left / right }
+  DIAXIS_CADM_MOVE                        = $26010202; { move view up / down }
+  DIAXIS_CADM_INOUT                       = $26018203; { in / out }
+  DIBUTTON_CADM_SELECT                    = $26000401; { Select Object }
+  DIBUTTON_CADM_SPECIAL1                  = $26000402; { do first special operation }
+  DIBUTTON_CADM_SPECIAL                   = $26000403; { Select special operation }
+  DIBUTTON_CADM_SPECIAL2                  = $26000404; { do second special operation }
+  DIBUTTON_CADM_MENU                      = $260004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIHATSWITCH_CADM_HATSWITCH              = $26004601; { Hat switch }
+  DIAXIS_CADM_ROTATEX                     = $26034204; { Rotate view forward or up / backward or down }
+  DIAXIS_CADM_ROTATEY                     = $2602C205; { Rotate view clockwise / counterclockwise }
+  DIAXIS_CADM_ROTATEZ                     = $26024206; { Rotate view left / right }
+  DIBUTTON_CADM_DISPLAY                   = $26004405; { shows next on-screen display options }
+  DIBUTTON_CADM_DEVICE                    = $260044FE; { Show input device and controls }
+  DIBUTTON_CADM_PAUSE                     = $260044FC; { Start / Pause / Restart game }
+
+(*--- Control - Media Equipment
+      Remote        ---*)
+  DIVIRTUAL_REMOTE_CONTROL                = $27000000;
+  DIAXIS_REMOTE_SLIDER                    = $27050201; { Slider for adjustment: volume / color / bass / etc }
+  DIBUTTON_REMOTE_MUTE                    = $27000401; { Set volume on current device to zero }
+  DIBUTTON_REMOTE_SELECT                  = $27000402; { Next/previous: channel/ track / chapter / picture / station }
+  DIBUTTON_REMOTE_PLAY                    = $27002403; { Start or pause entertainment on current device }
+  DIBUTTON_REMOTE_CUE                     = $27002404; { Move through current media }
+  DIBUTTON_REMOTE_REVIEW                  = $27002405; { Move through current media }
+  DIBUTTON_REMOTE_CHANGE                  = $27002406; { Select next device }
+  DIBUTTON_REMOTE_RECORD                  = $27002407; { Start recording the current media }
+  DIBUTTON_REMOTE_MENU                    = $270004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIAXIS_REMOTE_SLIDER2                   = $27054202; { Slider for adjustment: volume }
+  DIBUTTON_REMOTE_TV                      = $27005C08; { Select TV }
+  DIBUTTON_REMOTE_CABLE                   = $27005C09; { Select cable box }
+  DIBUTTON_REMOTE_CD                      = $27005C0A; { Select CD player }
+  DIBUTTON_REMOTE_VCR                     = $27005C0B; { Select VCR }
+  DIBUTTON_REMOTE_TUNER                   = $27005C0C; { Select tuner }
+  DIBUTTON_REMOTE_DVD                     = $27005C0D; { Select DVD player }
+  DIBUTTON_REMOTE_ADJUST                  = $27005C0E; { Enter device adjustment menu }
+  DIBUTTON_REMOTE_DIGIT0                  = $2700540F; { Digit 0 }
+  DIBUTTON_REMOTE_DIGIT1                  = $27005410; { Digit 1 }
+  DIBUTTON_REMOTE_DIGIT2                  = $27005411; { Digit 2 }
+  DIBUTTON_REMOTE_DIGIT3                  = $27005412; { Digit 3 }
+  DIBUTTON_REMOTE_DIGIT4                  = $27005413; { Digit 4 }
+  DIBUTTON_REMOTE_DIGIT5                  = $27005414; { Digit 5 }
+  DIBUTTON_REMOTE_DIGIT6                  = $27005415; { Digit 6 }
+  DIBUTTON_REMOTE_DIGIT7                  = $27005416; { Digit 7 }
+  DIBUTTON_REMOTE_DIGIT8                  = $27005417; { Digit 8 }
+  DIBUTTON_REMOTE_DIGIT9                  = $27005418; { Digit 9 }
+  DIBUTTON_REMOTE_DEVICE                  = $270044FE; { Show input device and controls }
+  DIBUTTON_REMOTE_PAUSE                   = $270044FC; { Start / Pause / Restart game }
+
+(*--- Control- Web
+      Help or Browser            ---*)
+  DIVIRTUAL_BROWSER_CONTROL               = $28000000;
+  DIAXIS_BROWSER_LATERAL                  = $28008201; { Move on screen pointer }
+  DIAXIS_BROWSER_MOVE                     = $28010202; { Move on screen pointer }
+  DIBUTTON_BROWSER_SELECT                 = $28000401; { Select current item }
+  DIAXIS_BROWSER_VIEW                     = $28018203; { Move view up/down }
+  DIBUTTON_BROWSER_REFRESH                = $28000402; { Refresh }
+  DIBUTTON_BROWSER_MENU                   = $280004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_BROWSER_SEARCH                 = $28004403; { Use search tool }
+  DIBUTTON_BROWSER_STOP                   = $28004404; { Cease current update }
+  DIBUTTON_BROWSER_HOME                   = $28004405; { Go directly to "home" location }
+  DIBUTTON_BROWSER_FAVORITES              = $28004406; { Mark current site as favorite }
+  DIBUTTON_BROWSER_NEXT                   = $28004407; { Select Next page }
+  DIBUTTON_BROWSER_PREVIOUS               = $28004408; { Select Previous page }
+  DIBUTTON_BROWSER_HISTORY                = $28004409; { Show/Hide History }
+  DIBUTTON_BROWSER_PRINT                  = $2800440A; { Print current page }
+  DIBUTTON_BROWSER_DEVICE                 = $280044FE; { Show input device and controls }
+  DIBUTTON_BROWSER_PAUSE                  = $280044FC; { Start / Pause / Restart game }
+
+(*--- Driving Simulator - Giant Walking Robot
+      Walking tank with weapons  ---*)
+  DIVIRTUAL_DRIVING_MECHA                 = $29000000;
+  DIAXIS_MECHA_STEER                      = $29008201; { Turns mecha left/right }
+  DIAXIS_MECHA_TORSO                      = $29010202; { Tilts torso forward/backward }
+  DIAXIS_MECHA_ROTATE                     = $29020203; { Turns torso left/right }
+  DIAXIS_MECHA_THROTTLE                   = $29038204; { Engine Speed }
+  DIBUTTON_MECHA_FIRE                     = $29000401; { Fire }
+  DIBUTTON_MECHA_WEAPONS                  = $29000402; { Select next weapon group }
+  DIBUTTON_MECHA_TARGET                   = $29000403; { Select closest enemy available target }
+  DIBUTTON_MECHA_REVERSE                  = $29000404; { Toggles throttle in/out of reverse }
+  DIBUTTON_MECHA_ZOOM                     = $29000405; { Zoom in/out targeting reticule }
+  DIBUTTON_MECHA_JUMP                     = $29000406; { Fires jump jets }
+  DIBUTTON_MECHA_MENU                     = $290004FD; { Show menu options }
+(*--- Priority 2 controls                            ---*)
+
+  DIBUTTON_MECHA_CENTER                   = $29004407; { Center torso to legs }
+  DIHATSWITCH_MECHA_GLANCE                = $29004601; { Look around }
+  DIBUTTON_MECHA_VIEW                     = $29004408; { Cycle through view options }
+  DIBUTTON_MECHA_FIRESECONDARY            = $29004409; { Alternative fire button }
+  DIBUTTON_MECHA_LEFT_LINK                = $2900C4E4; { Fallback steer left button }
+  DIBUTTON_MECHA_RIGHT_LINK               = $2900C4EC; { Fallback steer right button }
+  DIBUTTON_MECHA_FORWARD_LINK             = $290144E0; { Fallback tilt torso forward button }
+  DIBUTTON_MECHA_BACK_LINK                = $290144E8; { Fallback tilt toroso backward button }
+  DIBUTTON_MECHA_ROTATE_LEFT_LINK         = $290244E4; { Fallback rotate toroso right button }
+  DIBUTTON_MECHA_ROTATE_RIGHT_LINK        = $290244EC; { Fallback rotate torso left button }
+  DIBUTTON_MECHA_FASTER_LINK              = $2903C4E0; { Fallback increase engine speed }
+  DIBUTTON_MECHA_SLOWER_LINK              = $2903C4E8; { Fallback decrease engine speed }
+  DIBUTTON_MECHA_DEVICE                   = $290044FE; { Show input device and controls }
+  DIBUTTON_MECHA_PAUSE                    = $290044FC; { Start / Pause / Restart game }
+
+(*
+ *  "ANY" semantics can be used as a last resort to get mappings for actions
+ *  that match nothing in the chosen virtual genre.  These semantics will be
+ *  mapped at a lower priority that virtual genre semantics.  Also, hardware
+ *  vendors will not be able to provide sensible mappings for these unless
+ *  they provide application specific mappings.
+ *)
+  DIAXIS_ANY_X_1                          = $FF00C201;
+  DIAXIS_ANY_X_2                          = $FF00C202;
+  DIAXIS_ANY_Y_1                          = $FF014201;
+  DIAXIS_ANY_Y_2                          = $FF014202;
+  DIAXIS_ANY_Z_1                          = $FF01C201;
+  DIAXIS_ANY_Z_2                          = $FF01C202;
+  DIAXIS_ANY_R_1                          = $FF024201;
+  DIAXIS_ANY_R_2                          = $FF024202;
+  DIAXIS_ANY_U_1                          = $FF02C201;
+  DIAXIS_ANY_U_2                          = $FF02C202;
+  DIAXIS_ANY_V_1                          = $FF034201;
+  DIAXIS_ANY_V_2                          = $FF034202;
+  DIAXIS_ANY_A_1                          = $FF03C201;
+  DIAXIS_ANY_A_2                          = $FF03C202;
+  DIAXIS_ANY_B_1                          = $FF044201;
+  DIAXIS_ANY_B_2                          = $FF044202;
+  DIAXIS_ANY_C_1                          = $FF04C201;
+  DIAXIS_ANY_C_2                          = $FF04C202;
+  DIAXIS_ANY_S_1                          = $FF054201;
+  DIAXIS_ANY_S_2                          = $FF054202;
+
+  DIAXIS_ANY_1                            = $FF004201;
+  DIAXIS_ANY_2                            = $FF004202;
+  DIAXIS_ANY_3                            = $FF004203;
+  DIAXIS_ANY_4                            = $FF004204;
+
+  DIPOV_ANY_1                             = $FF004601;
+  DIPOV_ANY_2                             = $FF004602;
+  DIPOV_ANY_3                             = $FF004603;
+  DIPOV_ANY_4                             = $FF004604;
+
+//#define DIBUTTON_ANY(instance)                  ( 0xFF004400 | instance )
+
+
+//#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP) */
+//#pragma endregion
+
+//#ifdef __cplusplus
+//};
+//#endif
+
+//#endif  /* __DINPUT_INCLUDED__ */
+
+(****************************************************************************
+ *
+ *  Definitions for non-IDirectInput (VJoyD) features defined more recently
+ *  than the current sdk files
+ *
+ ****************************************************************************)
+
+{$IFDEF _INC_MMSYSTEM}
+{$IFNDEF MMNOJOY}
+
+{$IFNDEF __VJOYDX_INCLUDED__}
+{$DEFINE __VJOYDX_INCLUDED__}
+
+//#ifdef __cplusplus
+//extern "C" {
+//#endif
+
+//#pragma region Desktop Family
+//#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP)
+
+(*
+ * Flag to indicate that the dwReserved2 field of the JOYINFOEX structure
+ * contains mini-driver specific data to be passed by VJoyD to the mini-
+ * driver instead of doing a poll.
+ *)
+const
+  JOY_PASSDRIVERDATA          = $10000000;
+
+(*
+ * Informs the joystick driver that the configuration has been changed
+ * and should be reloaded from the registery.
+ * dwFlags is reserved and should be set to zero
+ *)
+//WINMMAPI MMRESULT WINAPI joyConfigChanged( DWORD dwFlags );
+
+//#ifndef DIJ_RINGZERO
+(*
+ * Invoke the joystick control panel directly, using the passed window handle
+ * as the parent of the dialog.  This API is only supported for compatibility
+ * purposes; new applications should use the RunControlPanel method of a
+ * device interface for a game controller.
+ * The API is called by using the function pointer returned by
+ * GetProcAddress( hCPL, TEXT("ShowJoyCPL") ) where hCPL is a HMODULE returned
+ * by LoadLibrary( TEXT("joy.cpl") ).  The typedef is provided to allow
+ * declaration and casting of an appropriately typed variable.
+ *)
+//void WINAPI ShowJoyCPL( HWND hWnd );
+//typedef void (WINAPI* LPFNSHOWJOYCPL)( HWND hWnd );
+type
+  LPFNSHOWJOYCPL = procedure(hWnd: HWND); stdcall;
+//#endif
+
+(*
+ * Hardware Setting indicating that the device is a headtracker
+ *)
+const
+  JOY_HWS_ISHEADTRACKER       = $02000000;
+
+(*
+ * Hardware Setting indicating that the VxD is used to replace
+ * the standard analog polling
+ *)
+  JOY_HWS_ISGAMEPORTDRIVER    = $04000000;
+
+(*
+ * Hardware Setting indicating that the driver needs a standard
+ * gameport in order to communicate with the device.
+ *)
+  JOY_HWS_ISANALOGPORTDRIVER  = $08000000;
+
+(*
+ * Hardware Setting indicating that VJoyD should not load this
+ * driver, it will be loaded externally and will register with
+ * VJoyD of it's own accord.
+ *)
+  JOY_HWS_AUTOLOAD            = $10000000;
+
+(*
+ * Hardware Setting indicating that the driver acquires any
+ * resources needed without needing a devnode through VJoyD.
+ *)
+  JOY_HWS_NODEVNODE           = $20000000;
+
+
+(*
+ * Hardware Setting indicating that the device is a gameport bus
+ *)
+  JOY_HWS_ISGAMEPORTBUS       = $80000000;
+  JOY_HWS_GAMEPORTBUSBUSY     = $00000001;
+
+(*
+ * Usage Setting indicating that the settings are volatile and
+ * should be removed if still present on a reboot.
+ *)
+  JOY_US_VOLATILE             = $00000008;
+
+//#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP) */
+//#pragma endregion
+
+//#ifdef __cplusplus
+//};
+//#endif
+
+{$ENDIF}  { __VJOYDX_INCLUDED__ }
+
+{$ENDIF}  { not MMNOJOY }
+{$ENDIF}  { _INC_MMSYSTEM }
+
+(****************************************************************************
+ *
+ *  Definitions for non-IDirectInput (VJoyD) features defined more recently
+ *  than the current ddk files
+ *
+ ****************************************************************************)
+
+//#ifndef DIJ_RINGZERO
+
+{$IFDEF _INC_MMDDK}
+{$IFNDEF MMNOJOYDEV}
+
+{$IFNDEF __VJOYDXD_INCLUDED__}
+{$DEFINE __VJOYDXD_INCLUDED__}
+(*
+ * Poll type in which the do_other field of the JOYOEMPOLLDATA
+ * structure contains mini-driver specific data passed from an app.
+ *)
+const
+  JOY_OEMPOLL_PASSDRIVERDATA = 7;
+
+{$ENDIF}  { __VJOYDXD_INCLUDED__ }
+
+{$ENDIF}  { not MMNOJOYDEV }
+{$ENDIF}  { _INC_MMDDK }
+
+//#endif /* DIJ_RINGZERO */
+
+function GET_DIDEVICE_SUBTYPE(dwDevType: DWORD): BYTE; inline;
+function DIDFT_MAKEINSTANCE(n: WORD): DWORD; inline;
+function DIDFT_GETINSTANCE(n: DWORD): WORD; inline;
+function DIDFT_ENUMCOLLECTION(n: WORD): DWORD; inline;
+{$IF DIRECTINPUT_VERSION >= $050a}
+function DIMAKEUSAGEDWORD(UsagePage, Usage: Word): DWORD; inline;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+function DISEQUENCE_COMPARE(dwSequence1: DWORD; const cmp: string; dwSequence2: DWORD): Boolean; inline;
+function DIBUTTON_ANY(instance: Byte): DWORD; inline;
+
+implementation
+
+//#define GET_DIDEVICE_SUBTYPE(dwDevType) HIBYTE(dwDevType)
+function GET_DIDEVICE_SUBTYPE(dwDevType: DWORD): BYTE; inline;
+begin
+  Result := HIBYTE(dwDevType);
+end;
+
+//#define DIDFT_MAKEINSTANCE(n) ((WORD)(n) << 8)
+function DIDFT_MAKEINSTANCE(n: WORD): DWORD; inline;
+begin
+  Result := n shl 8;
+end;
+
+//#define DIDFT_GETINSTANCE(n) LOWORD((n) >> 8)
+function DIDFT_GETINSTANCE(n: DWORD): WORD; inline;
+begin
+  Result := LOWORD(n shr 8);
+end;
+
+//#define DIDFT_ENUMCOLLECTION(n) ((WORD)(n) << 8)
+function DIDFT_ENUMCOLLECTION(n: WORD): DWORD; inline;
+begin
+  Result := n shl 8;
+end;
+
+{$IF DIRECTINPUT_VERSION >= $050a}
+//#define DIMAKEUSAGEDWORD(UsagePage, Usage) \
+//                                (DWORD)MAKELONG(Usage, UsagePage)
+function DIMAKEUSAGEDWORD(UsagePage, Usage: Word): DWORD; inline;
+begin
+  Result := MAKELONG(Usage, UsagePage);
+end;
+{$ENDIF} { DIRECTINPUT_VERSION >= $050a }
+
+//#define DISEQUENCE_COMPARE(dwSequence1, cmp, dwSequence2) \
+//                        ((int)((dwSequence1) - (dwSequence2)) cmp 0)
+function DISEQUENCE_COMPARE(dwSequence1: DWORD; const cmp: string; dwSequence2: DWORD): Boolean; inline;
+begin
+{$PUSH}{$Q-,R-}
+  if (cmp = '==') or (cmp = '=') then
+    Result := LongInt(dwSequence1 - dwSequence2) = 0
+  else if (cmp = '!=') or (cmp = '<>') then
+    Result := LongInt(dwSequence1 - dwSequence2) <> 0
+  else if cmp = '<' then
+    Result := LongInt(dwSequence1 - dwSequence2) < 0
+  else if cmp = '>' then
+    Result := LongInt(dwSequence1 - dwSequence2) > 0
+  else if cmp = '<=' then
+    Result := LongInt(dwSequence1 - dwSequence2) <= 0
+  else if cmp = '>=' then
+    Result := LongInt(dwSequence1 - dwSequence2) >= 0;
+{$POP}
+end;
+
+//#define DIBUTTON_ANY(instance)                  ( 0xFF004400 | instance )
+function DIBUTTON_ANY(instance: Byte): DWORD; inline;
+begin
+  Result := $FF004400 or instance;
+end;
+
+end.
diff --git a/packages/ptc/src/win32/directx/win32directxcheck.inc b/packages/ptc/src/win32/directx/win32directxcheck.inc
index 6527a1d1cc..9d59fb750c 100644
--- a/packages/ptc/src/win32/directx/win32directxcheck.inc
+++ b/packages/ptc/src/win32/directx/win32directxcheck.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 procedure DirectXCheck(AResult: HRESULT);
diff --git a/packages/ptc/src/win32/directx/win32directxconsoled.inc b/packages/ptc/src/win32/directx/win32directxconsoled.inc
index 0e237d978a..b8aad5bac3 100644
--- a/packages/ptc/src/win32/directx/win32directxconsoled.inc
+++ b/packages/ptc/src/win32/directx/win32directxconsoled.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -180,4 +180,5 @@ type
     function GetInformation: string; override;
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
+    function MoveMouseTo(X, Y: Integer): Boolean; override;
   end;
diff --git a/packages/ptc/src/win32/directx/win32directxconsolei.inc b/packages/ptc/src/win32/directx/win32directxconsolei.inc
index c4583c7bc1..3aec43e58a 100644
--- a/packages/ptc/src/win32/directx/win32directxconsolei.inc
+++ b/packages/ptc/src/win32/directx/win32directxconsolei.inc
@@ -1,6 +1,6 @@
 {
     Free Pascal port of the OpenPTC C++ library.
-    Copyright (C) 2001-2003, 2006, 2007, 2009-2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2003, 2006, 2007, 2009-2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Glenn Fiedler (ptc@gaffer.org)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$MACRO ON}
@@ -991,7 +991,7 @@ begin
   FKeyboard := TWin32Keyboard.Create(FWindow.handle, FWindow.thread, False, FEventQueue);
   FMouse := TWin32Mouse.Create(FWindow.handle, FWindow.thread, False, FEventQueue, FPrimary.Fullscreen, FPrimary.width, FPrimary.height);
   if FPrimary.Fullscreen then
-    FMouse.SetWindowArea(0, 0, FDisplay.Mode.Width, FDisplay.Mode.Height);
+    FMouse.SetWindowArea(0, 0, FDisplay.Mode.Width - 1, FDisplay.Mode.Height - 1);
   if not FPrimary.Fullscreen then
     FResize := TWin32Resize.Create(FWindow.handle, FWindow.thread, FEventQueue);
   FWindow.update;
@@ -1243,6 +1243,12 @@ begin
     FWindow.InterceptClose := AInterceptClose;
 end;
 
+function TDirectXConsole.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  CHECK_OPEN('TDirectXConsole.MoveMouseTo');
+  Result := FMouse.MoveMouseTo(X, Y);
+end;
+
 {$IFDEF DEBUG}
 procedure TDirectXConsole.CHECK_OPEN(AMsg: String);
 begin
diff --git a/packages/ptc/src/win32/directx/win32directxdisplay.inc b/packages/ptc/src/win32/directx/win32directxdisplay.inc
index 570f757414..691eaa01e4 100644
--- a/packages/ptc/src/win32/directx/win32directxdisplay.inc
+++ b/packages/ptc/src/win32/directx/win32directxdisplay.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TDirectXDisplay.Create;
@@ -119,8 +119,8 @@ begin
       if not found then
       begin
         LOG('adding 320x200x8 to mode list');
-	
-	Inc(FModesCount);
+
+        Inc(FModesCount);
         SetLength(FModes, FModesCount);
         FModes[FModesCount - 1] := TPTCMode.Create(320, 200, format8);
       end;
@@ -133,7 +133,7 @@ begin
       begin
         LOG('adding 320x240x8 to mode list');
 
-	Inc(FModesCount);
+        Inc(FModesCount);
         SetLength(FModes, FModesCount);
         FModes[FModesCount - 1] := TPTCMode.Create(320, 240, format8);
       end;
diff --git a/packages/ptc/src/win32/directx/win32directxdisplayd.inc b/packages/ptc/src/win32/directx/win32directxdisplayd.inc
index cfc81fe0db..25158d3e49 100644
--- a/packages/ptc/src/win32/directx/win32directxdisplayd.inc
+++ b/packages/ptc/src/win32/directx/win32directxdisplayd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/directx/win32directxhook.inc b/packages/ptc/src/win32/directx/win32directxhook.inc
index 54584287b9..810ecaf197 100644
--- a/packages/ptc/src/win32/directx/win32directxhook.inc
+++ b/packages/ptc/src/win32/directx/win32directxhook.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TDirectXHook.Create(AConsole: TDirectXConsole; AWindow: HWND; AThread: DWord; ACursor, AManaged, AFullscreen: Boolean);
@@ -79,9 +79,9 @@ begin
       if active = False then
       begin
         if FConsole.FGrabMouse and (not FFullscreen) then
-	begin
-	  FConsole.FWindow.ConfineCursor(False);
-	end;
+        begin
+          FConsole.FWindow.ConfineCursor(False);
+        end;
 
         { deactivate }
         Deactivate;
@@ -103,19 +103,19 @@ begin
         begin
           { check show command is not minimize }
           if placement.showCmd <> SW_SHOWMINIMIZED then
-	  begin
+          begin
             {hide cursor}
             FConsole.FWin32Cursor.Hide;
-	  end;
+          end;
         end;
 
-	if FConsole.FGrabMouse and (not FFullscreen) then
-	begin
+        if FConsole.FGrabMouse and (not FFullscreen) then
+        begin
           if placement.showCmd <> SW_SHOWMINIMIZED then
-	  begin
+          begin
             FConsole.FWindow.ConfineCursor(True);
-	  end;
-	end;
+          end;
+        end;
 
         { activate }
         Activate;
@@ -130,13 +130,13 @@ begin
       if not FCursor then
       begin
         if FFullscreen or (LOWORD(lParam) = HTCLIENT) then
-	begin
+        begin
           { hide cursor }
           SetCursor(0);
 
           { handled }
           Result := 1;
-	end;
+        end;
       end;
     end;
     WM_PALETTECHANGED:
diff --git a/packages/ptc/src/win32/directx/win32directxhookd.inc b/packages/ptc/src/win32/directx/win32directxhookd.inc
index d68c442a08..baeba631b5 100644
--- a/packages/ptc/src/win32/directx/win32directxhookd.inc
+++ b/packages/ptc/src/win32/directx/win32directxhookd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/directx/win32directxlibrary.inc b/packages/ptc/src/win32/directx/win32directxlibrary.inc
index 865d132b72..fc3c3c8d8d 100644
--- a/packages/ptc/src/win32/directx/win32directxlibrary.inc
+++ b/packages/ptc/src/win32/directx/win32directxlibrary.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TDirectXLibrary.Create;
diff --git a/packages/ptc/src/win32/directx/win32directxlibraryd.inc b/packages/ptc/src/win32/directx/win32directxlibraryd.inc
index 0321d4952e..a195df23fd 100644
--- a/packages/ptc/src/win32/directx/win32directxlibraryd.inc
+++ b/packages/ptc/src/win32/directx/win32directxlibraryd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/directx/win32directxprimary.inc b/packages/ptc/src/win32/directx/win32directxprimary.inc
index 8a7d4b2d14..fe143a8e44 100644
--- a/packages/ptc/src/win32/directx/win32directxprimary.inc
+++ b/packages/ptc/src/win32/directx/win32directxprimary.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TDirectXPrimary.Create;
diff --git a/packages/ptc/src/win32/directx/win32directxprimaryd.inc b/packages/ptc/src/win32/directx/win32directxprimaryd.inc
index d351f0d322..18c313e362 100644
--- a/packages/ptc/src/win32/directx/win32directxprimaryd.inc
+++ b/packages/ptc/src/win32/directx/win32directxprimaryd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/directx/win32directxtranslate.inc b/packages/ptc/src/win32/directx/win32directxtranslate.inc
index 7378281868..5b0ecb8e47 100644
--- a/packages/ptc/src/win32/directx/win32directxtranslate.inc
+++ b/packages/ptc/src/win32/directx/win32directxtranslate.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 function DirectXTranslate(const ddpf: TDDPIXELFORMAT): IPTCFormat;
diff --git a/packages/ptc/src/win32/gdi/win32dibd.inc b/packages/ptc/src/win32/gdi/win32dibd.inc
index 8bfe1d0b64..1eff3b4e63 100644
--- a/packages/ptc/src/win32/gdi/win32dibd.inc
+++ b/packages/ptc/src/win32/gdi/win32dibd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/gdi/win32dibi.inc b/packages/ptc/src/win32/gdi/win32dibi.inc
index 78c0efc9c2..fced95a333 100644
--- a/packages/ptc/src/win32/gdi/win32dibi.inc
+++ b/packages/ptc/src/win32/gdi/win32dibi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/ptc/src/win32/gdi/win32gdiconsoled.inc b/packages/ptc/src/win32/gdi/win32gdiconsoled.inc
index 9f07101ce7..9310f1490c 100644
--- a/packages/ptc/src/win32/gdi/win32gdiconsoled.inc
+++ b/packages/ptc/src/win32/gdi/win32gdiconsoled.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2007, 2009-2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2007, 2009-2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -154,7 +154,9 @@ type
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
 
+    function MoveMouseTo(X, Y: Integer): Boolean; override;
+
     procedure OpenGL_SwapBuffers; override;
-	procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
-	function OpenGL_GetSwapInterval: Integer; override;
+    procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
+    function OpenGL_GetSwapInterval: Integer; override;
   end;
diff --git a/packages/ptc/src/win32/gdi/win32gdiconsolei.inc b/packages/ptc/src/win32/gdi/win32gdiconsolei.inc
index 942d568e4e..bcdc2a1919 100644
--- a/packages/ptc/src/win32/gdi/win32gdiconsolei.inc
+++ b/packages/ptc/src/win32/gdi/win32gdiconsolei.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2007, 2009-2013  Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2007, 2009-2013, 2016  Nikolay Nikolov (nickysn@users.sourceforge.net)
 
     This library is free software; you can redistribute it and/or
     modify it under the terms of the GNU Lesser General Public
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TGDIConsole.Create;
@@ -225,7 +225,7 @@ begin
   FKeyboard := TWin32Keyboard.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue);
   FMouse := TWin32Mouse.Create(FWindow.Handle, FWindow.Thread, False, FEventQueue, FFullScreen, AWidth, AHeight);
   if FFullscreen then
-    FMouse.SetWindowArea(0, 0, AWidth, AHeight);
+    FMouse.SetWindowArea(0, 0, AWidth - 1, AHeight - 1);
   if not FFullscreen and FResizable then
     FResize := TWin32Resize.Create(FWindow.Handle, FWindow.Thread, FEventQueue);
 
@@ -730,7 +730,7 @@ begin
     LOG('using WGL_EXT_swap_control');
     LOG('wglSwapIntervalEXT(' + IntToStr(AInterval) + ')');
     if not wglSwapIntervalEXT(AInterval) then
-	  LOG('wglSwapIntervalEXT failed');
+      LOG('wglSwapIntervalEXT failed');
   end
   else
     LOG('no supported extensions found for setting the swap interval');
@@ -761,6 +761,12 @@ begin
     FWindow.InterceptClose := AInterceptClose;
 end;
 
+function TGDIConsole.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  CheckOpen('TGDIConsole.MoveMouseTo');
+  Result := FMouse.MoveMouseTo(X, Y);
+end;
+
 procedure TGDIConsole.CheckOpen(const AMessage: String);
 begin
   if not FOpen then
diff --git a/packages/ptc/src/win32/gdi/win32gdihookd.inc b/packages/ptc/src/win32/gdi/win32gdihookd.inc
index c611fbfcd2..69f6f02aa6 100644
--- a/packages/ptc/src/win32/gdi/win32gdihookd.inc
+++ b/packages/ptc/src/win32/gdi/win32gdihookd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/gdi/win32gdihooki.inc b/packages/ptc/src/win32/gdi/win32gdihooki.inc
index 83ba0b5edb..26bd545b3b 100644
--- a/packages/ptc/src/win32/gdi/win32gdihooki.inc
+++ b/packages/ptc/src/win32/gdi/win32gdihooki.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TGDIHook.Create(AConsole: TGDIConsole; AWindow: HWND; AThread: DWord; ACursor, AManaged, AFullscreen: Boolean);
diff --git a/packages/ptc/src/win32/gdi/win32modesetterd.inc b/packages/ptc/src/win32/gdi/win32modesetterd.inc
index d630d950ce..34c0877e6e 100644
--- a/packages/ptc/src/win32/gdi/win32modesetterd.inc
+++ b/packages/ptc/src/win32/gdi/win32modesetterd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/win32/gdi/win32modesetteri.inc b/packages/ptc/src/win32/gdi/win32modesetteri.inc
index 796ad1ef00..371d2fc8f0 100644
--- a/packages/ptc/src/win32/gdi/win32modesetteri.inc
+++ b/packages/ptc/src/win32/gdi/win32modesetteri.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$ifdef VER2_6}
diff --git a/packages/ptc/src/win32/gdi/win32openglwindowd.inc b/packages/ptc/src/win32/gdi/win32openglwindowd.inc
index 962b0d3725..152e71ac88 100644
--- a/packages/ptc/src/win32/gdi/win32openglwindowd.inc
+++ b/packages/ptc/src/win32/gdi/win32openglwindowd.inc
@@ -26,16 +26,16 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
   TWin32OpenGLWindow = class(TWin32Window)
   private
     FPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
-	FChosenPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
+    FChosenPixelFormatDescriptor: PIXELFORMATDESCRIPTOR;
 
-	procedure SetOpenGLAttributes(const AOpenGLAttributes: IPTCOpenGLAttributes);
+    procedure SetOpenGLAttributes(const AOpenGLAttributes: IPTCOpenGLAttributes);
     function EnumerateAllPixelFormats(hdc: HDC): Boolean;
     function SetupOpenGLPixelFormat(hdc: HDC): Boolean;
     procedure LogPixelFormatDescriptor(const pfd: PIXELFORMATDESCRIPTOR);
diff --git a/packages/ptc/src/win32/gdi/win32openglwindowi.inc b/packages/ptc/src/win32/gdi/win32openglwindowi.inc
index 210e0a1c77..b3cb0a9ba2 100644
--- a/packages/ptc/src/win32/gdi/win32openglwindowi.inc
+++ b/packages/ptc/src/win32/gdi/win32openglwindowi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$ifdef VER2_6}
@@ -160,13 +160,13 @@ begin
     Flags := Flags or PFD_DOUBLEBUFFER_DONTCARE
   else
     if AOpenGLAttributes.DoubleBuffer then
-	  Flags := Flags or PFD_DOUBLEBUFFER;
+      Flags := Flags or PFD_DOUBLEBUFFER;
 
   if AOpenGLAttributes.StereoDontCare then
     Flags := Flags or PFD_STEREO_DONTCARE
   else
     if AOpenGLAttributes.Stereo then
-	  Flags := Flags or PFD_STEREO;
+      Flags := Flags or PFD_STEREO;
 
   FillChar(FPixelFormatDescriptor, SizeOf(FPixelFormatDescriptor), 0);
   FPixelFormatDescriptor.nSize := SizeOf(FPixelFormatDescriptor);
diff --git a/packages/ptc/src/wince/base/wincekeyboardd.inc b/packages/ptc/src/wince/base/wincekeyboardd.inc
index 2c339732e7..88bc938eac 100644
--- a/packages/ptc/src/wince/base/wincekeyboardd.inc
+++ b/packages/ptc/src/wince/base/wincekeyboardd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/base/wincekeyboardi.inc b/packages/ptc/src/wince/base/wincekeyboardi.inc
index 2c0d049fea..f48c0f3345 100644
--- a/packages/ptc/src/wince/base/wincekeyboardi.inc
+++ b/packages/ptc/src/wince/base/wincekeyboardi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWinCEKeyboard.Create(EventQueue: TEventQueue);
diff --git a/packages/ptc/src/wince/base/wincemoused.inc b/packages/ptc/src/wince/base/wincemoused.inc
index 005636ef10..80bf92abed 100644
--- a/packages/ptc/src/wince/base/wincemoused.inc
+++ b/packages/ptc/src/wince/base/wincemoused.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/base/wincemousei.inc b/packages/ptc/src/wince/base/wincemousei.inc
index 40142ebd69..f411249c5e 100644
--- a/packages/ptc/src/wince/base/wincemousei.inc
+++ b/packages/ptc/src/wince/base/wincemousei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWinCEMouse.Create(EventQueue: TEventQueue; FullScreen: Boolean; ConsoleWidth, ConsoleHeight: Integer);
diff --git a/packages/ptc/src/wince/base/wincewindowd.inc b/packages/ptc/src/wince/base/wincewindowd.inc
index 04e8bade8f..ed2abadd5b 100644
--- a/packages/ptc/src/wince/base/wincewindowd.inc
+++ b/packages/ptc/src/wince/base/wincewindowd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/base/wincewindowi.inc b/packages/ptc/src/wince/base/wincewindowi.inc
index bed0e16af5..142963f2ba 100644
--- a/packages/ptc/src/wince/base/wincewindowi.inc
+++ b/packages/ptc/src/wince/base/wincewindowi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/gapi/wincegapiconsoled.inc b/packages/ptc/src/wince/gapi/wincegapiconsoled.inc
index 1a85864b2a..afec0011b7 100644
--- a/packages/ptc/src/wince/gapi/wincegapiconsoled.inc
+++ b/packages/ptc/src/wince/gapi/wincegapiconsoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/gapi/wincegapiconsolei.inc b/packages/ptc/src/wince/gapi/wincegapiconsolei.inc
index dd3801693e..563f8117cb 100644
--- a/packages/ptc/src/wince/gapi/wincegapiconsolei.inc
+++ b/packages/ptc/src/wince/gapi/wincegapiconsolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWinCEGAPIConsole.Create;
diff --git a/packages/ptc/src/wince/gdi/wincebitmapinfod.inc b/packages/ptc/src/wince/gdi/wincebitmapinfod.inc
index 5fbd3a30a5..2d91432491 100644
--- a/packages/ptc/src/wince/gdi/wincebitmapinfod.inc
+++ b/packages/ptc/src/wince/gdi/wincebitmapinfod.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc b/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc
index 91147eceee..2f5918a880 100644
--- a/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc
+++ b/packages/ptc/src/wince/gdi/wincebitmapinfoi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 
diff --git a/packages/ptc/src/wince/gdi/wincegdiconsoled.inc b/packages/ptc/src/wince/gdi/wincegdiconsoled.inc
index 04275d1d2e..cbc2c090f7 100644
--- a/packages/ptc/src/wince/gdi/wincegdiconsoled.inc
+++ b/packages/ptc/src/wince/gdi/wincegdiconsoled.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/wince/gdi/wincegdiconsolei.inc b/packages/ptc/src/wince/gdi/wincegdiconsolei.inc
index d5108baff2..8ce367cb5f 100644
--- a/packages/ptc/src/wince/gdi/wincegdiconsolei.inc
+++ b/packages/ptc/src/wince/gdi/wincegdiconsolei.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TWinCEGDIConsole.Create;
diff --git a/packages/ptc/src/x11/x11check.inc b/packages/ptc/src/x11/x11check.inc
index 226d7d34de..2dcd4a333c 100644
--- a/packages/ptc/src/x11/x11check.inc
+++ b/packages/ptc/src/x11/x11check.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 procedure X11Check(AStatus: TStatus);
diff --git a/packages/ptc/src/x11/x11consoled.inc b/packages/ptc/src/x11/x11consoled.inc
index 45b9e4ac1f..65c830d7a6 100644
--- a/packages/ptc/src/x11/x11consoled.inc
+++ b/packages/ptc/src/x11/x11consoled.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2013, 2016 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -40,6 +40,7 @@ type
 
     procedure UpdateCursor;
     procedure UpdateMouseGrab;
+    function UpdateRelativeMouseMode: Boolean;
 
     function CreateDisplay: TX11Display; { Factory method }
 
@@ -117,6 +118,8 @@ type
     function NextEvent(out AEvent: IPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean; override;
     function PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): IPTCEvent; override;
 
+    function MoveMouseTo(X, Y: Integer): Boolean; override;
+
     procedure OpenGL_SwapBuffers; override;
     procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
     function OpenGL_GetSwapInterval: Integer; override;
diff --git a/packages/ptc/src/x11/x11consolei.inc b/packages/ptc/src/x11/x11consolei.inc
index f0a87d4f25..415fc85eda 100644
--- a/packages/ptc/src/x11/x11consolei.inc
+++ b/packages/ptc/src/x11/x11consolei.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2013, 2016, 2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TX11Console.Create;
@@ -37,7 +37,8 @@ begin
   inherited Create;
 
   { default flags }
-  FFlags := [PTC_X11_TRY_XSHM, PTC_X11_TRY_XF86VIDMODE];
+  FFlags := [PTC_X11_TRY_XSHM, PTC_X11_TRY_XF86VIDMODE, PTC_X11_TRY_XINPUT2,
+             PTC_X11_TRY_XIM];
 
   FTitle := '';
 
@@ -170,6 +171,26 @@ begin
     FFlags := FFlags - [PTC_X11_TRY_XSHM];
     exit;
   end;
+  if (AOption = 'xinput2') or (AOption = 'xinput2 on') then
+  begin
+    FFlags := FFlags + [PTC_X11_TRY_XINPUT2];
+    exit;
+  end;
+  if AOption = 'xinput2 off' then
+  begin
+    FFlags := FFlags - [PTC_X11_TRY_XINPUT2];
+    exit;
+  end;
+  if (AOption = 'xim') or (AOption = 'xim on') then
+  begin
+    FFlags := FFlags + [PTC_X11_TRY_XIM];
+    exit;
+  end;
+  if AOption = 'xim off' then
+  begin
+    FFlags := FFlags - [PTC_X11_TRY_XIM];
+    exit;
+  end;
   if AOption = 'default cursor' then
   begin
     FFlags := FFlags - [PTC_X11_FULLSCREEN_CURSOR_VISIBLE, PTC_X11_WINDOWED_CURSOR_INVISIBLE];
@@ -200,6 +221,18 @@ begin
     UpdateMouseGrab;
     exit;
   end;
+  if AOption = 'relative mouse on' then
+  begin
+    FFlags := FFlags + [PTC_X11_RELATIVE_MOUSE_MODE];
+    Result := UpdateRelativeMouseMode;
+    exit;
+  end;
+  if AOption = 'relative mouse off' then
+  begin
+    FFlags := FFlags - [PTC_X11_RELATIVE_MOUSE_MODE];
+    Result := UpdateRelativeMouseMode;
+    exit;
+  end;
   if AOption = 'intercept window close' then
   begin
     FFlags := FFlags + [PTC_X11_INTERCEPT_WINDOW_CLOSE];
@@ -575,6 +608,22 @@ begin
     FX11Display.SetMouseGrab(PTC_X11_GRAB_MOUSE in FFlags);
 end;
 
+function TX11Console.UpdateRelativeMouseMode: Boolean;
+begin
+  if Assigned(FX11Display) then
+    Result := FX11Display.SetRelativeMouseMode(PTC_X11_RELATIVE_MOUSE_MODE in FFlags)
+  else
+    Result := True;
+end;
+
+function TX11Console.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  if Assigned(FX11Display) then
+    Result := FX11Display.MoveMouseTo(X, Y)
+  else
+    Result := False;
+end;
+
 procedure TX11Console.OpenGL_SwapBuffers;
 begin
   FX11Display.OpenGL_SwapBuffers;
diff --git a/packages/ptc/src/x11/x11dga1displayd.inc b/packages/ptc/src/x11/x11dga1displayd.inc
index 1c79196d37..21f15696eb 100644
--- a/packages/ptc/src/x11/x11dga1displayd.inc
+++ b/packages/ptc/src/x11/x11dga1displayd.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2012, 2016 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
@@ -76,6 +76,7 @@ type
     function IsOpen: Boolean; override;
     procedure SetCursor(AVisible: Boolean); override;
     procedure SetMouseGrab(AGrabMouse: Boolean); override;
+    function SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean; override;
   end;
 
 {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}
diff --git a/packages/ptc/src/x11/x11dga1displayi.inc b/packages/ptc/src/x11/x11dga1displayi.inc
index bf3775d041..a12e8904b4 100644
--- a/packages/ptc/src/x11/x11dga1displayi.inc
+++ b/packages/ptc/src/x11/x11dga1displayi.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2012, 2016 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFDEF ENABLE_X11_EXTENSION_XF86DGA1}
@@ -483,4 +483,10 @@ begin
   {...}
 end;
 
+function TX11DGA1Display.SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean;
+begin
+  {...}
+  Result := not ARelativeMouseMode;
+end;
+
 {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}
diff --git a/packages/ptc/src/x11/x11dga2displayd.inc b/packages/ptc/src/x11/x11dga2displayd.inc
index 558aa06fe0..4110cb708a 100644
--- a/packages/ptc/src/x11/x11dga2displayd.inc
+++ b/packages/ptc/src/x11/x11dga2displayd.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2012, 2016 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
@@ -78,6 +78,7 @@ type
     function IsOpen: Boolean; override;
     procedure SetCursor(visible: Boolean); override;
     procedure SetMouseGrab(AGrabMouse: Boolean); override;
+    function SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean; override;
   end;
 
 {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
diff --git a/packages/ptc/src/x11/x11dga2displayi.inc b/packages/ptc/src/x11/x11dga2displayi.inc
index a5be9a48dd..ab637532fb 100644
--- a/packages/ptc/src/x11/x11dga2displayi.inc
+++ b/packages/ptc/src/x11/x11dga2displayi.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2012, 2016 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFDEF ENABLE_X11_EXTENSION_XF86DGA2}
@@ -560,4 +560,10 @@ begin
   {...}
 end;
 
+function TX11DGA2Display.SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean;
+begin
+  {...}
+  Result := not ARelativeMouseMode;
+end;
+
 {$ENDIF ENABLE_X11_EXTENSION_XF86DGA2}
diff --git a/packages/ptc/src/x11/x11displayd.inc b/packages/ptc/src/x11/x11displayd.inc
index 2946178812..6e34980396 100644
--- a/packages/ptc/src/x11/x11displayd.inc
+++ b/packages/ptc/src/x11/x11displayd.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2013, 2016, 2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -39,10 +39,13 @@ type
                    PTC_X11_TRY_XF86VIDMODE,
                    PTC_X11_TRY_XRANDR,
                    PTC_X11_TRY_XSHM,
+                   PTC_X11_TRY_XINPUT2,
+                   PTC_X11_TRY_XIM,
                    PTC_X11_DITHER,
                    PTC_X11_FULLSCREEN_CURSOR_VISIBLE,
                    PTC_X11_WINDOWED_CURSOR_INVISIBLE,
                    PTC_X11_GRAB_MOUSE,
+                   PTC_X11_RELATIVE_MOUSE_MODE,
                    PTC_X11_INTERCEPT_WINDOW_CLOSE,
                    PTC_X11_RESIZABLE_WINDOW,
                    PTC_X11_USE_OPENGL);
@@ -74,6 +77,9 @@ type
     FFunctionKeys: PInteger;
     FNormalKeys: PInteger;
 
+    FXIM: PXIM;
+    FXIC: PXIC;
+
     function GetInterceptClose: Boolean;
     procedure SetInterceptClose(AInterceptClose: Boolean);
 
@@ -148,6 +154,8 @@ type
     { mouse grab control }
     procedure SetMouseGrab(AGrabMouse: Boolean); virtual; abstract;
 
+    function SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean; virtual; abstract;
+
     { Data access }
     function Clip: IPTCArea;
 
@@ -176,6 +184,8 @@ type
     property Area: IPTCArea read GetArea;
     property Format: IPTCFormat read GetFormat;
 
+    function MoveMouseTo(X, Y: Integer): Boolean; virtual;
+
     procedure OpenGL_SwapBuffers; virtual;
     procedure OpenGL_SetSwapInterval(AInterval: Integer); virtual;
     function OpenGL_GetSwapInterval: Integer; virtual;
diff --git a/packages/ptc/src/x11/x11displayi.inc b/packages/ptc/src/x11/x11displayi.inc
index 250e7e7071..010a097633 100644
--- a/packages/ptc/src/x11/x11displayi.inc
+++ b/packages/ptc/src/x11/x11displayi.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2013, 2015-2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$INCLUDE x11unikey.inc}
@@ -410,6 +410,7 @@ begin
   FNormalKeys[$FF and XK_semicolon] := Integer(PTCKEY_SEMICOLON);
   FNormalKeys[$FF and XK_equal] := Integer(PTCKEY_EQUALS);
   FNormalKeys[$FF and XK_grave] := Integer(PTCKEY_BACKQUOTE);
+  FNormalKeys[$FF and XK_apostrophe] := Integer(PTCKEY_QUOTE);
 
   FNormalKeys[$FF and XK_bracketleft] := Integer(PTCKEY_OPENBRACKET);
   FNormalKeys[$FF and XK_backslash] := Integer(PTCKEY_BACKSLASH);
@@ -452,11 +453,23 @@ var
   uni: Integer;
   key: TPTCKeyEvent;
   buf: array [1..16] of Char;
+  lslen: cint;
+  status: TStatus;
+  eaten_by_im: Boolean = False;
 begin
-  sym := XLookupKeySym(@e, 0);
+  if Assigned(FXIM) and Assigned(FXIC) and (Self is TX11WindowDisplay) then
+  begin
+    eaten_by_im := XFilterEvent(@e, TX11WindowDisplay(Self).FWindow);
+  end;
   XLookupString(@e, @buf, SizeOf(buf), @sym_modded, nil);
+  if (e._type = KeyPress) and Assigned(FXIM) and Assigned(FXIC) then
+  begin
+    lslen := XmbLookupString(FXIC, @e, @buf, SizeOf(buf), @sym_modded, @status);
+//    Writeln(lslen, ' ', status, ' ', buf[1], ' ', XKeysymToString(sym_modded));
+  end;
+  sym := XLookupKeySym(@e, 0);
 //  Writeln('sym_modded = ', sym_modded);
-  uni := X11ConvertKeySymToUnicode(sym_modded);
+//  Writeln(HexStr(e.state, 8));
   modkeys := [];
   if (e.state and Mod1Mask) <> 0 then
     Include(modkeys, pmkAlt);
@@ -464,10 +477,47 @@ begin
     Include(modkeys, pmkShift);
   if (e.state and ControlMask) <> 0 then
     Include(modkeys, pmkControl);
+  if (e.state and LockMask) <> 0 then
+    Include(modkeys, pmkCapsLockActive);
+  if (e.state and Mod2Mask) <> 0 then
+    Include(modkeys, pmkNumLockActive);
+  if X11IsDeadKey(sym_modded) then
+    Include(modkeys, pmkDeadKey);
   if e._type = KeyPress then
-    press := True
+  begin
+    press := True;
+    uni := X11ConvertKeySymToUnicode(sym_modded);
+  end
   else
+  begin
     press := False;
+    uni := -1;
+  end;
+  if (sym_modded = XK_Shift_R) or
+     (sym_modded = XK_Control_R) or
+     (sym_modded = XK_Meta_R) or
+     (sym_modded = XK_Alt_R) then
+    Include(modkeys, pmkRightKey);
+  if (sym_modded = XK_KP_Insert) or
+     (sym_modded = XK_KP_Delete) or
+     (sym_modded = XK_KP_Home) or
+     (sym_modded = XK_KP_End) or
+     (sym_modded = XK_KP_Prior) or
+     (sym_modded = XK_KP_Next) or
+     (sym_modded = XK_KP_Begin) or
+     (sym_modded = XK_KP_Left) or
+     (sym_modded = XK_KP_Right) or
+     (sym_modded = XK_KP_Up) or
+     (sym_modded = XK_KP_Down) or
+     (sym_modded = XK_KP_Divide) or
+     (sym_modded = XK_KP_Multiply) or
+     (sym_modded = XK_KP_Subtract) or
+     (sym_modded = XK_KP_Add) or
+     (sym_modded = XK_KP_Enter) or
+     (sym_modded = XK_KP_Decimal) or
+     ((sym_modded >= XK_KP_0) and (sym_modded <= XK_KP_9)) or
+     (sym_modded = XK_Num_Lock) then
+    Include(modkeys, pmkNumPadKey);
 
   // XK_ISO_Left_Tab is Shift-Tab
   if sym_modded = XK_ISO_Left_Tab then
@@ -496,9 +546,10 @@ begin
     0: key := TPTCKeyEvent.Create(FNormalKeys[sym_modded and $FF], uni, modkeys, press);
     $FF: key := TPTCKeyEvent.Create(FFunctionKeys[sym_modded and $FF], uni, modkeys, press);
     else
-      key := TPTCKeyEvent.Create;
+      key := TPTCKeyEvent.Create(PTCKEY_UNDEFINED, uni, modkeys, press);
   end;
-  FEventQueue.AddEvent(key);
+  if (not eaten_by_im) or (pmkDeadKey in modkeys) then
+    FEventQueue.AddEvent(key);
 end;
 
 function TX11Display.GetInterceptClose: Boolean;
@@ -519,6 +570,11 @@ begin
   raise TPTCError.Create('Console not in windowed mode');
 end;
 
+function TX11Display.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  Result := False;
+end;
+
 procedure TX11Display.OpenGL_SwapBuffers;
 begin
   raise TPTCError.Create('Not in OpenGL mode');
diff --git a/packages/ptc/src/x11/x11extensions.inc b/packages/ptc/src/x11/x11extensions.inc
index 581a2e34e9..374b882663 100644
--- a/packages/ptc/src/x11/x11extensions.inc
+++ b/packages/ptc/src/x11/x11extensions.inc
@@ -5,3 +5,4 @@
 {$DEFINE ENABLE_X11_EXTENSION_XF86DGA2}
 {$DEFINE ENABLE_X11_EXTENSION_XSHM}
 {$DEFINE ENABLE_X11_EXTENSION_GLX}
+{$DEFINE ENABLE_X11_EXTENSION_XINPUT2}
diff --git a/packages/ptc/src/x11/x11glxfbconfigd.inc b/packages/ptc/src/x11/x11glxfbconfigd.inc
index 9e5601322d..d82b3b7ed3 100644
--- a/packages/ptc/src/x11/x11glxfbconfigd.inc
+++ b/packages/ptc/src/x11/x11glxfbconfigd.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFDEF ENABLE_X11_EXTENSION_GLX}
diff --git a/packages/ptc/src/x11/x11glxfbconfigi.inc b/packages/ptc/src/x11/x11glxfbconfigi.inc
index 21b33eb9cd..995c3bb14b 100644
--- a/packages/ptc/src/x11/x11glxfbconfigi.inc
+++ b/packages/ptc/src/x11/x11glxfbconfigi.inc
@@ -26,7 +26,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 {$IFDEF ENABLE_X11_EXTENSION_GLX}
diff --git a/packages/ptc/src/x11/x11imaged.inc b/packages/ptc/src/x11/x11imaged.inc
index 55687ea059..359b4e84eb 100644
--- a/packages/ptc/src/x11/x11imaged.inc
+++ b/packages/ptc/src/x11/x11imaged.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/x11/x11imagei.inc b/packages/ptc/src/x11/x11imagei.inc
index b417869bb3..349eb17f1d 100644
--- a/packages/ptc/src/x11/x11imagei.inc
+++ b/packages/ptc/src/x11/x11imagei.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TX11Image.Create(ADisplay: PDisplay; AScreen, AWidth, AHeight: Integer; AFormat: IPTCFormat);
diff --git a/packages/ptc/src/x11/x11modesd.inc b/packages/ptc/src/x11/x11modesd.inc
index 2dc519b5a9..6b8d85dd94 100644
--- a/packages/ptc/src/x11/x11modesd.inc
+++ b/packages/ptc/src/x11/x11modesd.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
diff --git a/packages/ptc/src/x11/x11modesi.inc b/packages/ptc/src/x11/x11modesi.inc
index 128c1dac95..0aa8853447 100644
--- a/packages/ptc/src/x11/x11modesi.inc
+++ b/packages/ptc/src/x11/x11modesi.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TX11Modes.Create(ADisplay: PDisplay; AScreen: cint);
diff --git a/packages/ptc/src/x11/x11unikey.inc b/packages/ptc/src/x11/x11unikey.inc
index 34944ff5c9..c276daa7ff 100644
--- a/packages/ptc/src/x11/x11unikey.inc
+++ b/packages/ptc/src/x11/x11unikey.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2012 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2012,2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,9 +27,28 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
+function X11IsDeadKey(sym: TKeySym): Boolean;
+begin
+  case sym of
+    XK_dead_grave, XK_dead_acute, XK_dead_circumflex,
+    XK_dead_tilde, XK_dead_macron, XK_dead_breve, XK_dead_abovedot,
+    XK_dead_diaeresis, XK_dead_abovering, XK_dead_doubleacute, XK_dead_caron,
+    XK_dead_cedilla, XK_dead_ogonek, XK_dead_iota, XK_dead_voiced_sound,
+    XK_dead_semivoiced_sound, XK_dead_belowdot, XK_dead_hook, XK_dead_horn,
+    XK_dead_stroke, XK_dead_abovecomma, XK_dead_abovereversedcomma,
+    XK_dead_doublegrave, XK_dead_belowring, XK_dead_belowmacron,
+    XK_dead_belowcircumflex, XK_dead_belowtilde, XK_dead_belowbreve,
+    XK_dead_belowdiaeresis, XK_dead_invertedbreve, XK_dead_belowcomma,
+    XK_dead_currency:
+      Result := True;
+    else
+      Result := False;
+  end;
+end;
+
 function X11ConvertKeySymToUnicode(sym: TKeySym): Integer;
 begin
   if (sym >= 0) and (sym <= $FF) then
@@ -61,206 +80,724 @@ begin
     XK_Escape: exit(27);
   End;
   case sym of
-    XKc_Cyrillic_GHE_bar     : exit($492);
-    XK_Cyrillic_ghe_bar      : exit($493);
-    XKc_Cyrillic_ZHE_descender: exit($496);
-    XK_Cyrillic_zhe_descender: exit($497);
-    XKc_Cyrillic_KA_descender: exit($49A);
-    XK_Cyrillic_ka_descender : exit($49B);
-    XKc_Cyrillic_KA_vertstroke: exit($49C);
-    XK_Cyrillic_ka_vertstroke: exit($49D);
-    XKc_Cyrillic_EN_descender: exit($4A2);
-    XK_Cyrillic_en_descender : exit($4A3);
-    XKc_Cyrillic_U_straight  : exit($4AE);
-    XK_Cyrillic_u_straight   : exit($4AF);
-    XKc_Cyrillic_U_straight_bar: exit($4B0);
-    XK_Cyrillic_u_straight_bar: exit($4B1);
-    XKc_Cyrillic_HA_descender: exit($4B2);
-    XK_Cyrillic_ha_descender : exit($4B3);
-    XKc_Cyrillic_CHE_descender: exit($4B6);
-    XK_Cyrillic_che_descender: exit($4B7);
-    XKc_Cyrillic_CHE_vertstroke: exit($4B8);
-    XK_Cyrillic_che_vertstroke: exit($4B9);
-    XKc_Cyrillic_SHHA        : exit($4BA);
-    XK_Cyrillic_shha         : exit($4BB);
+    { Latin 2 }
+    XKc_Aogonek      : exit($0104);  { U+0104 LATIN CAPITAL LETTER A WITH OGONEK }
+    XK_breve         : exit($02D8);  { U+02D8 BREVE }
+    XKc_Lstroke      : exit($0141);  { U+0141 LATIN CAPITAL LETTER L WITH STROKE }
+    XKc_Lcaron       : exit($013D);  { U+013D LATIN CAPITAL LETTER L WITH CARON }
+    XKc_Sacute       : exit($015A);  { U+015A LATIN CAPITAL LETTER S WITH ACUTE }
+    XKc_Scaron       : exit($0160);  { U+0160 LATIN CAPITAL LETTER S WITH CARON }
+    XKc_Scedilla     : exit($015E);  { U+015E LATIN CAPITAL LETTER S WITH CEDILLA }
+    XKc_Tcaron       : exit($0164);  { U+0164 LATIN CAPITAL LETTER T WITH CARON }
+    XKc_Zacute       : exit($0179);  { U+0179 LATIN CAPITAL LETTER Z WITH ACUTE }
+    XKc_Zcaron       : exit($017D);  { U+017D LATIN CAPITAL LETTER Z WITH CARON }
+    XKc_Zabovedot    : exit($017B);  { U+017B LATIN CAPITAL LETTER Z WITH DOT ABOVE }
+    XK_aogonek       : exit($0105);  { U+0105 LATIN SMALL LETTER A WITH OGONEK }
+    XK_ogonek        : exit($02DB);  { U+02DB OGONEK }
+    XK_lstroke       : exit($0142);  { U+0142 LATIN SMALL LETTER L WITH STROKE }
+    XK_lcaron        : exit($013E);  { U+013E LATIN SMALL LETTER L WITH CARON }
+    XK_sacute        : exit($015B);  { U+015B LATIN SMALL LETTER S WITH ACUTE }
+    XK_caron         : exit($02C7);  { U+02C7 CARON }
+    XK_scaron        : exit($0161);  { U+0161 LATIN SMALL LETTER S WITH CARON }
+    XK_scedilla      : exit($015F);  { U+015F LATIN SMALL LETTER S WITH CEDILLA }
+    XK_tcaron        : exit($0165);  { U+0165 LATIN SMALL LETTER T WITH CARON }
+    XK_zacute        : exit($017A);  { U+017A LATIN SMALL LETTER Z WITH ACUTE }
+    XK_doubleacute   : exit($02DD);  { U+02DD DOUBLE ACUTE ACCENT }
+    XK_zcaron        : exit($017E);  { U+017E LATIN SMALL LETTER Z WITH CARON }
+    XK_zabovedot     : exit($017C);  { U+017C LATIN SMALL LETTER Z WITH DOT ABOVE }
+    XKc_Racute       : exit($0154);  { U+0154 LATIN CAPITAL LETTER R WITH ACUTE }
+    XKc_Abreve       : exit($0102);  { U+0102 LATIN CAPITAL LETTER A WITH BREVE }
+    XKc_Lacute       : exit($0139);  { U+0139 LATIN CAPITAL LETTER L WITH ACUTE }
+    XKc_Cacute       : exit($0106);  { U+0106 LATIN CAPITAL LETTER C WITH ACUTE }
+    XKc_Ccaron       : exit($010C);  { U+010C LATIN CAPITAL LETTER C WITH CARON }
+    XKc_Eogonek      : exit($0118);  { U+0118 LATIN CAPITAL LETTER E WITH OGONEK }
+    XKc_Ecaron       : exit($011A);  { U+011A LATIN CAPITAL LETTER E WITH CARON }
+    XKc_Dcaron       : exit($010E);  { U+010E LATIN CAPITAL LETTER D WITH CARON }
+    XKc_Dstroke      : exit($0110);  { U+0110 LATIN CAPITAL LETTER D WITH STROKE }
+    XKc_Nacute       : exit($0143);  { U+0143 LATIN CAPITAL LETTER N WITH ACUTE }
+    XKc_Ncaron       : exit($0147);  { U+0147 LATIN CAPITAL LETTER N WITH CARON }
+    XKc_Odoubleacute : exit($0150);  { U+0150 LATIN CAPITAL LETTER O WITH DOUBLE ACUTE }
+    XKc_Rcaron       : exit($0158);  { U+0158 LATIN CAPITAL LETTER R WITH CARON }
+    XKc_Uring        : exit($016E);  { U+016E LATIN CAPITAL LETTER U WITH RING ABOVE }
+    XKc_Udoubleacute : exit($0170);  { U+0170 LATIN CAPITAL LETTER U WITH DOUBLE ACUTE }
+    XKc_Tcedilla     : exit($0162);  { U+0162 LATIN CAPITAL LETTER T WITH CEDILLA }
+    XK_racute        : exit($0155);  { U+0155 LATIN SMALL LETTER R WITH ACUTE }
+    XK_abreve        : exit($0103);  { U+0103 LATIN SMALL LETTER A WITH BREVE }
+    XK_lacute        : exit($013A);  { U+013A LATIN SMALL LETTER L WITH ACUTE }
+    XK_cacute        : exit($0107);  { U+0107 LATIN SMALL LETTER C WITH ACUTE }
+    XK_ccaron        : exit($010D);  { U+010D LATIN SMALL LETTER C WITH CARON }
+    XK_eogonek       : exit($0119);  { U+0119 LATIN SMALL LETTER E WITH OGONEK }
+    XK_ecaron        : exit($011B);  { U+011B LATIN SMALL LETTER E WITH CARON }
+    XK_dcaron        : exit($010F);  { U+010F LATIN SMALL LETTER D WITH CARON }
+    XK_dstroke       : exit($0111);  { U+0111 LATIN SMALL LETTER D WITH STROKE }
+    XK_nacute        : exit($0144);  { U+0144 LATIN SMALL LETTER N WITH ACUTE }
+    XK_ncaron        : exit($0148);  { U+0148 LATIN SMALL LETTER N WITH CARON }
+    XK_odoubleacute  : exit($0151);  { U+0151 LATIN SMALL LETTER O WITH DOUBLE ACUTE }
+    XK_rcaron        : exit($0159);  { U+0159 LATIN SMALL LETTER R WITH CARON }
+    XK_uring         : exit($016F);  { U+016F LATIN SMALL LETTER U WITH RING ABOVE }
+    XK_udoubleacute  : exit($0171);  { U+0171 LATIN SMALL LETTER U WITH DOUBLE ACUTE }
+    XK_tcedilla      : exit($0163);  { U+0163 LATIN SMALL LETTER T WITH CEDILLA }
+    XK_abovedot      : exit($02D9);  { U+02D9 DOT ABOVE }
+
+    { Latin 3 }
+    XKc_Hstroke     : exit($0126);  { U+0126 LATIN CAPITAL LETTER H WITH STROKE }
+    XKc_Hcircumflex : exit($0124);  { U+0124 LATIN CAPITAL LETTER H WITH CIRCUMFLEX }
+    XKc_Iabovedot   : exit($0130);  { U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE }
+    XKc_Gbreve      : exit($011E);  { U+011E LATIN CAPITAL LETTER G WITH BREVE }
+    XKc_Jcircumflex : exit($0134);  { U+0134 LATIN CAPITAL LETTER J WITH CIRCUMFLEX }
+    XK_hstroke      : exit($0127);  { U+0127 LATIN SMALL LETTER H WITH STROKE }
+    XK_hcircumflex  : exit($0125);  { U+0125 LATIN SMALL LETTER H WITH CIRCUMFLEX }
+    XK_idotless     : exit($0131);  { U+0131 LATIN SMALL LETTER DOTLESS I }
+    XK_gbreve       : exit($011F);  { U+011F LATIN SMALL LETTER G WITH BREVE }
+    XK_jcircumflex  : exit($0135);  { U+0135 LATIN SMALL LETTER J WITH CIRCUMFLEX }
+    XKc_Cabovedot   : exit($010A);  { U+010A LATIN CAPITAL LETTER C WITH DOT ABOVE }
+    XKc_Ccircumflex : exit($0108);  { U+0108 LATIN CAPITAL LETTER C WITH CIRCUMFLEX }
+    XKc_Gabovedot   : exit($0120);  { U+0120 LATIN CAPITAL LETTER G WITH DOT ABOVE }
+    XKc_Gcircumflex : exit($011C);  { U+011C LATIN CAPITAL LETTER G WITH CIRCUMFLEX }
+    XKc_Ubreve      : exit($016C);  { U+016C LATIN CAPITAL LETTER U WITH BREVE }
+    XKc_Scircumflex : exit($015C);  { U+015C LATIN CAPITAL LETTER S WITH CIRCUMFLEX }
+    XK_cabovedot    : exit($010B);  { U+010B LATIN SMALL LETTER C WITH DOT ABOVE }
+    XK_ccircumflex  : exit($0109);  { U+0109 LATIN SMALL LETTER C WITH CIRCUMFLEX }
+    XK_gabovedot    : exit($0121);  { U+0121 LATIN SMALL LETTER G WITH DOT ABOVE }
+    XK_gcircumflex  : exit($011D);  { U+011D LATIN SMALL LETTER G WITH CIRCUMFLEX }
+    XK_ubreve       : exit($016D);  { U+016D LATIN SMALL LETTER U WITH BREVE }
+    XK_scircumflex  : exit($015D);  { U+015D LATIN SMALL LETTER S WITH CIRCUMFLEX }
+
+    { Latin 4 }
+    XK_kra        : exit($0138);  { U+0138 LATIN SMALL LETTER KRA }
+    XKc_Rcedilla  : exit($0156);  { U+0156 LATIN CAPITAL LETTER R WITH CEDILLA }
+    XKc_Itilde    : exit($0128);  { U+0128 LATIN CAPITAL LETTER I WITH TILDE }
+    XKc_Lcedilla  : exit($013B);  { U+013B LATIN CAPITAL LETTER L WITH CEDILLA }
+    XKc_Emacron   : exit($0112);  { U+0112 LATIN CAPITAL LETTER E WITH MACRON }
+    XKc_Gcedilla  : exit($0122);  { U+0122 LATIN CAPITAL LETTER G WITH CEDILLA }
+    XKc_Tslash    : exit($0166);  { U+0166 LATIN CAPITAL LETTER T WITH STROKE }
+    XK_rcedilla   : exit($0157);  { U+0157 LATIN SMALL LETTER R WITH CEDILLA }
+    XK_itilde     : exit($0129);  { U+0129 LATIN SMALL LETTER I WITH TILDE }
+    XK_lcedilla   : exit($013C);  { U+013C LATIN SMALL LETTER L WITH CEDILLA }
+    XK_emacron    : exit($0113);  { U+0113 LATIN SMALL LETTER E WITH MACRON }
+    XK_gcedilla   : exit($0123);  { U+0123 LATIN SMALL LETTER G WITH CEDILLA }
+    XK_tslash     : exit($0167);  { U+0167 LATIN SMALL LETTER T WITH STROKE }
+    XKc_ENG       : exit($014A);  { U+014A LATIN CAPITAL LETTER ENG }
+    XK_eng        : exit($014B);  { U+014B LATIN SMALL LETTER ENG }
+    XKc_Amacron   : exit($0100);  { U+0100 LATIN CAPITAL LETTER A WITH MACRON }
+    XKc_Iogonek   : exit($012E);  { U+012E LATIN CAPITAL LETTER I WITH OGONEK }
+    XKc_Eabovedot : exit($0116);  { U+0116 LATIN CAPITAL LETTER E WITH DOT ABOVE }
+    XKc_Imacron   : exit($012A);  { U+012A LATIN CAPITAL LETTER I WITH MACRON }
+    XKc_Ncedilla  : exit($0145);  { U+0145 LATIN CAPITAL LETTER N WITH CEDILLA }
+    XKc_Omacron   : exit($014C);  { U+014C LATIN CAPITAL LETTER O WITH MACRON }
+    XKc_Kcedilla  : exit($0136);  { U+0136 LATIN CAPITAL LETTER K WITH CEDILLA }
+    XKc_Uogonek   : exit($0172);  { U+0172 LATIN CAPITAL LETTER U WITH OGONEK }
+    XKc_Utilde    : exit($0168);  { U+0168 LATIN CAPITAL LETTER U WITH TILDE }
+    XKc_Umacron   : exit($016A);  { U+016A LATIN CAPITAL LETTER U WITH MACRON }
+    XK_amacron    : exit($0101);  { U+0101 LATIN SMALL LETTER A WITH MACRON }
+    XK_iogonek    : exit($012F);  { U+012F LATIN SMALL LETTER I WITH OGONEK }
+    XK_eabovedot  : exit($0117);  { U+0117 LATIN SMALL LETTER E WITH DOT ABOVE }
+    XK_imacron    : exit($012B);  { U+012B LATIN SMALL LETTER I WITH MACRON }
+    XK_ncedilla   : exit($0146);  { U+0146 LATIN SMALL LETTER N WITH CEDILLA }
+    XK_omacron    : exit($014D);  { U+014D LATIN SMALL LETTER O WITH MACRON }
+    XK_kcedilla   : exit($0137);  { U+0137 LATIN SMALL LETTER K WITH CEDILLA }
+    XK_uogonek    : exit($0173);  { U+0173 LATIN SMALL LETTER U WITH OGONEK }
+    XK_utilde     : exit($0169);  { U+0169 LATIN SMALL LETTER U WITH TILDE }
+    XK_umacron    : exit($016B);  { U+016B LATIN SMALL LETTER U WITH MACRON }
+
+    { Latin 9 }
+    XKc_OE         : exit($0152);  { U+0152 LATIN CAPITAL LIGATURE OE }
+    XK_oe          : exit($0153);  { U+0153 LATIN SMALL LIGATURE OE }
+    XKc_Ydiaeresis : exit($0178);  { U+0178 LATIN CAPITAL LETTER Y WITH DIAERESIS }
+
+    { Katakana }
+    XK_overline            : exit($203E);  { U+203E OVERLINE }
+    XK_kana_fullstop       : exit($3002);  { U+3002 IDEOGRAPHIC FULL STOP }
+    XK_kana_openingbracket : exit($300C);  { U+300C LEFT CORNER BRACKET }
+    XK_kana_closingbracket : exit($300D);  { U+300D RIGHT CORNER BRACKET }
+    XK_kana_comma          : exit($3001);  { U+3001 IDEOGRAPHIC COMMA }
+    XK_kana_conjunctive    : exit($30FB);  { U+30FB KATAKANA MIDDLE DOT }
+    XKc_kana_WO            : exit($30F2);  { U+30F2 KATAKANA LETTER WO }
+    XK_kana_a              : exit($30A1);  { U+30A1 KATAKANA LETTER SMALL A }
+    XK_kana_i              : exit($30A3);  { U+30A3 KATAKANA LETTER SMALL I }
+    XK_kana_u              : exit($30A5);  { U+30A5 KATAKANA LETTER SMALL U }
+    XK_kana_e              : exit($30A7);  { U+30A7 KATAKANA LETTER SMALL E }
+    XK_kana_o              : exit($30A9);  { U+30A9 KATAKANA LETTER SMALL O }
+    XK_kana_ya             : exit($30E3);  { U+30E3 KATAKANA LETTER SMALL YA }
+    XK_kana_yu             : exit($30E5);  { U+30E5 KATAKANA LETTER SMALL YU }
+    XK_kana_yo             : exit($30E7);  { U+30E7 KATAKANA LETTER SMALL YO }
+    XK_kana_tsu            : exit($30C3);  { U+30C3 KATAKANA LETTER SMALL TU }
+    XK_prolongedsound      : exit($30FC);  { U+30FC KATAKANA-HIRAGANA PROLONGED SOUND MARK }
+    XKc_kana_A             : exit($30A2);  { U+30A2 KATAKANA LETTER A }
+    XKc_kana_I             : exit($30A4);  { U+30A4 KATAKANA LETTER I }
+    XKc_kana_U             : exit($30A6);  { U+30A6 KATAKANA LETTER U }
+    XKc_kana_E             : exit($30A8);  { U+30A8 KATAKANA LETTER E }
+    XKc_kana_O             : exit($30AA);  { U+30AA KATAKANA LETTER O }
+    XKc_kana_KA            : exit($30AB);  { U+30AB KATAKANA LETTER KA }
+    XKc_kana_KI            : exit($30AD);  { U+30AD KATAKANA LETTER KI }
+    XKc_kana_KU            : exit($30AF);  { U+30AF KATAKANA LETTER KU }
+    XKc_kana_KE            : exit($30B1);  { U+30B1 KATAKANA LETTER KE }
+    XKc_kana_KO            : exit($30B3);  { U+30B3 KATAKANA LETTER KO }
+    XKc_kana_SA            : exit($30B5);  { U+30B5 KATAKANA LETTER SA }
+    XKc_kana_SHI           : exit($30B7);  { U+30B7 KATAKANA LETTER SI }
+    XKc_kana_SU            : exit($30B9);  { U+30B9 KATAKANA LETTER SU }
+    XKc_kana_SE            : exit($30BB);  { U+30BB KATAKANA LETTER SE }
+    XKc_kana_SO            : exit($30BD);  { U+30BD KATAKANA LETTER SO }
+    XKc_kana_TA            : exit($30BF);  { U+30BF KATAKANA LETTER TA }
+    XKc_kana_CHI           : exit($30C1);  { U+30C1 KATAKANA LETTER TI }
+    XKc_kana_TSU           : exit($30C4);  { U+30C4 KATAKANA LETTER TU }
+    XKc_kana_TE            : exit($30C6);  { U+30C6 KATAKANA LETTER TE }
+    XKc_kana_TO            : exit($30C8);  { U+30C8 KATAKANA LETTER TO }
+    XKc_kana_NA            : exit($30CA);  { U+30CA KATAKANA LETTER NA }
+    XKc_kana_NI            : exit($30CB);  { U+30CB KATAKANA LETTER NI }
+    XKc_kana_NU            : exit($30CC);  { U+30CC KATAKANA LETTER NU }
+    XKc_kana_NE            : exit($30CD);  { U+30CD KATAKANA LETTER NE }
+    XKc_kana_NO            : exit($30CE);  { U+30CE KATAKANA LETTER NO }
+    XKc_kana_HA            : exit($30CF);  { U+30CF KATAKANA LETTER HA }
+    XKc_kana_HI            : exit($30D2);  { U+30D2 KATAKANA LETTER HI }
+    XKc_kana_FU            : exit($30D5);  { U+30D5 KATAKANA LETTER HU }
+    XKc_kana_HE            : exit($30D8);  { U+30D8 KATAKANA LETTER HE }
+    XKc_kana_HO            : exit($30DB);  { U+30DB KATAKANA LETTER HO }
+    XKc_kana_MA            : exit($30DE);  { U+30DE KATAKANA LETTER MA }
+    XKc_kana_MI            : exit($30DF);  { U+30DF KATAKANA LETTER MI }
+    XKc_kana_MU            : exit($30E0);  { U+30E0 KATAKANA LETTER MU }
+    XKc_kana_ME            : exit($30E1);  { U+30E1 KATAKANA LETTER ME }
+    XKc_kana_MO            : exit($30E2);  { U+30E2 KATAKANA LETTER MO }
+    XKc_kana_YA            : exit($30E4);  { U+30E4 KATAKANA LETTER YA }
+    XKc_kana_YU            : exit($30E6);  { U+30E6 KATAKANA LETTER YU }
+    XKc_kana_YO            : exit($30E8);  { U+30E8 KATAKANA LETTER YO }
+    XKc_kana_RA            : exit($30E9);  { U+30E9 KATAKANA LETTER RA }
+    XKc_kana_RI            : exit($30EA);  { U+30EA KATAKANA LETTER RI }
+    XKc_kana_RU            : exit($30EB);  { U+30EB KATAKANA LETTER RU }
+    XKc_kana_RE            : exit($30EC);  { U+30EC KATAKANA LETTER RE }
+    XKc_kana_RO            : exit($30ED);  { U+30ED KATAKANA LETTER RO }
+    XKc_kana_WA            : exit($30EF);  { U+30EF KATAKANA LETTER WA }
+    XKc_kana_N             : exit($30F3);  { U+30F3 KATAKANA LETTER N }
+    XK_voicedsound         : exit($309B);  { U+309B KATAKANA-HIRAGANA VOICED SOUND MARK }
+    XK_semivoicedsound     : exit($309C);  { U+309C KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK }
 
-    XKc_Cyrillic_SCHWA       : exit($4D8);
-    XK_Cyrillic_schwa        : exit($4D9);
-    XKc_Cyrillic_I_macron    : exit($4E2);
-    XK_Cyrillic_i_macron     : exit($4E3);
-    XKc_Cyrillic_O_bar       : exit($4E8);
-    XK_Cyrillic_o_bar        : exit($4E9);
-    XKc_Cyrillic_U_macron    : exit($4EE);
-    XK_Cyrillic_u_macron     : exit($4EF);
+    { Arabic }
+    XK_Arabic_comma          : exit($060C);     { U+060C ARABIC COMMA }
+    XK_Arabic_semicolon      : exit($061B);     { U+061B ARABIC SEMICOLON }
+    XK_Arabic_question_mark  : exit($061F);     { U+061F ARABIC QUESTION MARK }
+    XK_Arabic_hamza          : exit($0621);     { U+0621 ARABIC LETTER HAMZA }
+    XK_Arabic_maddaonalef    : exit($0622);     { U+0622 ARABIC LETTER ALEF WITH MADDA ABOVE }
+    XK_Arabic_hamzaonalef    : exit($0623);     { U+0623 ARABIC LETTER ALEF WITH HAMZA ABOVE }
+    XK_Arabic_hamzaonwaw     : exit($0624);     { U+0624 ARABIC LETTER WAW WITH HAMZA ABOVE }
+    XK_Arabic_hamzaunderalef : exit($0625);     { U+0625 ARABIC LETTER ALEF WITH HAMZA BELOW }
+    XK_Arabic_hamzaonyeh     : exit($0626);     { U+0626 ARABIC LETTER YEH WITH HAMZA ABOVE }
+    XK_Arabic_alef           : exit($0627);     { U+0627 ARABIC LETTER ALEF }
+    XK_Arabic_beh            : exit($0628);     { U+0628 ARABIC LETTER BEH }
+    XK_Arabic_tehmarbuta     : exit($0629);     { U+0629 ARABIC LETTER TEH MARBUTA }
+    XK_Arabic_teh            : exit($062A);     { U+062A ARABIC LETTER TEH }
+    XK_Arabic_theh           : exit($062B);     { U+062B ARABIC LETTER THEH }
+    XK_Arabic_jeem           : exit($062C);     { U+062C ARABIC LETTER JEEM }
+    XK_Arabic_hah            : exit($062D);     { U+062D ARABIC LETTER HAH }
+    XK_Arabic_khah           : exit($062E);     { U+062E ARABIC LETTER KHAH }
+    XK_Arabic_dal            : exit($062F);     { U+062F ARABIC LETTER DAL }
+    XK_Arabic_thal           : exit($0630);     { U+0630 ARABIC LETTER THAL }
+    XK_Arabic_ra             : exit($0631);     { U+0631 ARABIC LETTER REH }
+    XK_Arabic_zain           : exit($0632);     { U+0632 ARABIC LETTER ZAIN }
+    XK_Arabic_seen           : exit($0633);     { U+0633 ARABIC LETTER SEEN }
+    XK_Arabic_sheen          : exit($0634);     { U+0634 ARABIC LETTER SHEEN }
+    XK_Arabic_sad            : exit($0635);     { U+0635 ARABIC LETTER SAD }
+    XK_Arabic_dad            : exit($0636);     { U+0636 ARABIC LETTER DAD }
+    XK_Arabic_tah            : exit($0637);     { U+0637 ARABIC LETTER TAH }
+    XK_Arabic_zah            : exit($0638);     { U+0638 ARABIC LETTER ZAH }
+    XK_Arabic_ain            : exit($0639);     { U+0639 ARABIC LETTER AIN }
+    XK_Arabic_ghain          : exit($063A);     { U+063A ARABIC LETTER GHAIN }
+    XK_Arabic_tatweel        : exit($0640);     { U+0640 ARABIC TATWEEL }
+    XK_Arabic_feh            : exit($0641);     { U+0641 ARABIC LETTER FEH }
+    XK_Arabic_qaf            : exit($0642);     { U+0642 ARABIC LETTER QAF }
+    XK_Arabic_kaf            : exit($0643);     { U+0643 ARABIC LETTER KAF }
+    XK_Arabic_lam            : exit($0644);     { U+0644 ARABIC LETTER LAM }
+    XK_Arabic_meem           : exit($0645);     { U+0645 ARABIC LETTER MEEM }
+    XK_Arabic_noon           : exit($0646);     { U+0646 ARABIC LETTER NOON }
+    XK_Arabic_ha             : exit($0647);     { U+0647 ARABIC LETTER HEH }
+    XK_Arabic_waw            : exit($0648);     { U+0648 ARABIC LETTER WAW }
+    XK_Arabic_alefmaksura    : exit($0649);     { U+0649 ARABIC LETTER ALEF MAKSURA }
+    XK_Arabic_yeh            : exit($064A);     { U+064A ARABIC LETTER YEH }
+    XK_Arabic_fathatan       : exit($064B);     { U+064B ARABIC FATHATAN }
+    XK_Arabic_dammatan       : exit($064C);     { U+064C ARABIC DAMMATAN }
+    XK_Arabic_kasratan       : exit($064D);     { U+064D ARABIC KASRATAN }
+    XK_Arabic_fatha          : exit($064E);     { U+064E ARABIC FATHA }
+    XK_Arabic_damma          : exit($064F);     { U+064F ARABIC DAMMA }
+    XK_Arabic_kasra          : exit($0650);     { U+0650 ARABIC KASRA }
+    XK_Arabic_shadda         : exit($0651);     { U+0651 ARABIC SHADDA }
+    XK_Arabic_sukun          : exit($0652);     { U+0652 ARABIC SUKUN }
 
-    XK_Serbian_dje           : exit($452);
-    XK_Macedonia_gje         : exit($453);
-    XK_Cyrillic_io           : exit($451);
-    XK_Ukrainian_ie          : exit($454);
-    XK_Macedonia_dse         : exit($455);
-    XK_Ukrainian_i           : exit($456);
-    XK_Ukrainian_yi          : exit($457);
-    XK_Cyrillic_je           : exit($458);
-    XK_Cyrillic_lje          : exit($459);
-    XK_Cyrillic_nje          : exit($45A);
-    XK_Serbian_tshe          : exit($45B);
-    XK_Macedonia_kje         : exit($45C);
-    XK_Ukrainian_ghe_with_upturn: exit($491);
-    XK_Byelorussian_shortu   : exit($45E);
-    XK_Cyrillic_dzhe         : exit($45F);
-    XK_numerosign            : exit($2116);
-    XKc_Serbian_DJE          : exit($402);
-    XKc_Macedonia_GJE        : exit($403);
-    XKc_Cyrillic_IO          : exit($401);
-    XKc_Ukrainian_IE         : exit($404);
-    XKc_Macedonia_DSE        : exit($405);
-    XKc_Ukrainian_I          : exit($406);
-    XKc_Ukrainian_YI         : exit($407);
-    XKc_Cyrillic_JE          : exit($408);
-    XKc_Cyrillic_LJE         : exit($409);
-    XKc_Cyrillic_NJE         : exit($40A);
-    XKc_Serbian_TSHE         : exit($40B);
-    XKc_Macedonia_KJE        : exit($40C);
-    XKc_Ukrainian_GHE_WITH_UPTURN: exit($490);
-    XKc_Byelorussian_SHORTU  : exit($40E);
-    XKc_Cyrillic_DZHE        : exit($40F);
-    XK_Cyrillic_yu           : exit($44E);
-    XK_Cyrillic_a            : exit($430);
-    XK_Cyrillic_be           : exit($431);
-    XK_Cyrillic_tse          : exit($446);
-    XK_Cyrillic_de           : exit($434);
-    XK_Cyrillic_ie           : exit($435);
-    XK_Cyrillic_ef           : exit($444);
-    XK_Cyrillic_ghe          : exit($433);
-    XK_Cyrillic_ha           : exit($445);
-    XK_Cyrillic_i            : exit($438);
-    XK_Cyrillic_shorti       : exit($439);
-    XK_Cyrillic_ka           : exit($43A);
-    XK_Cyrillic_el           : exit($43B);
-    XK_Cyrillic_em           : exit($43C);
-    XK_Cyrillic_en           : exit($43D);
-    XK_Cyrillic_o            : exit($43E);
-    XK_Cyrillic_pe           : exit($43F);
-    XK_Cyrillic_ya           : exit($44F);
-    XK_Cyrillic_er           : exit($440);
-    XK_Cyrillic_es           : exit($441);
-    XK_Cyrillic_te           : exit($442);
-    XK_Cyrillic_u            : exit($443);
-    XK_Cyrillic_zhe          : exit($436);
-    XK_Cyrillic_ve           : exit($432);
-    XK_Cyrillic_softsign     : exit($44C);
-    XK_Cyrillic_yeru         : exit($44B);
-    XK_Cyrillic_ze           : exit($437);
-    XK_Cyrillic_sha          : exit($448);
-    XK_Cyrillic_e            : exit($44D);
-    XK_Cyrillic_shcha        : exit($449);
-    XK_Cyrillic_che          : exit($447);
-    XK_Cyrillic_hardsign     : exit($44A);
-    XKc_Cyrillic_YU          : exit($42E);
-    XKc_Cyrillic_A           : exit($410);
-    XKc_Cyrillic_BE          : exit($411);
-    XKc_Cyrillic_TSE         : exit($426);
-    XKc_Cyrillic_DE          : exit($414);
-    XKc_Cyrillic_IE          : exit($415);
-    XKc_Cyrillic_EF          : exit($424);
-    XKc_Cyrillic_GHE         : exit($413);
-    XKc_Cyrillic_HA          : exit($425);
-    XKc_Cyrillic_I           : exit($418);
-    XKc_Cyrillic_SHORTI      : exit($419);
-    XKc_Cyrillic_KA          : exit($41A);
-    XKc_Cyrillic_EL          : exit($41B);
-    XKc_Cyrillic_EM          : exit($41C);
-    XKc_Cyrillic_EN          : exit($41D);
-    XKc_Cyrillic_O           : exit($41E);
-    XKc_Cyrillic_PE          : exit($41F);
-    XKc_Cyrillic_YA          : exit($42F);
-    XKc_Cyrillic_ER          : exit($420);
-    XKc_Cyrillic_ES          : exit($421);
-    XKc_Cyrillic_TE          : exit($422);
-    XKc_Cyrillic_U           : exit($423);
-    XKc_Cyrillic_ZHE         : exit($416);
-    XKc_Cyrillic_VE          : exit($412);
-    XKc_Cyrillic_SOFTSIGN    : exit($42C);
-    XKc_Cyrillic_YERU        : exit($42B);
-    XKc_Cyrillic_ZE          : exit($417);
-    XKc_Cyrillic_SHA         : exit($428);
-    XKc_Cyrillic_E           : exit($42D);
-    XKc_Cyrillic_SHCHA       : exit($429);
-    XKc_Cyrillic_CHE         : exit($427);
-    XKc_Cyrillic_HARDSIGN    : exit($42A);
+    { Cyrillic }
+    XK_Serbian_dje                : exit($0452);  { U+0452 CYRILLIC SMALL LETTER DJE }
+    XK_Macedonia_gje              : exit($0453);  { U+0453 CYRILLIC SMALL LETTER GJE }
+    XK_Cyrillic_io                : exit($0451);  { U+0451 CYRILLIC SMALL LETTER IO }
+    XK_Ukrainian_ie               : exit($0454);  { U+0454 CYRILLIC SMALL LETTER UKRAINIAN IE }
+    XK_Macedonia_dse              : exit($0455);  { U+0455 CYRILLIC SMALL LETTER DZE }
+    XK_Ukrainian_i                : exit($0456);  { U+0456 CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I }
+    XK_Ukrainian_yi               : exit($0457);  { U+0457 CYRILLIC SMALL LETTER YI }
+    XK_Cyrillic_je                : exit($0458);  { U+0458 CYRILLIC SMALL LETTER JE }
+    XK_Cyrillic_lje               : exit($0459);  { U+0459 CYRILLIC SMALL LETTER LJE }
+    XK_Cyrillic_nje               : exit($045A);  { U+045A CYRILLIC SMALL LETTER NJE }
+    XK_Serbian_tshe               : exit($045B);  { U+045B CYRILLIC SMALL LETTER TSHE }
+    XK_Macedonia_kje              : exit($045C);  { U+045C CYRILLIC SMALL LETTER KJE }
+    XK_Ukrainian_ghe_with_upturn  : exit($0491);  { U+0491 CYRILLIC SMALL LETTER GHE WITH UPTURN }
+    XK_Byelorussian_shortu        : exit($045E);  { U+045E CYRILLIC SMALL LETTER SHORT U }
+    XK_Cyrillic_dzhe              : exit($045F);  { U+045F CYRILLIC SMALL LETTER DZHE }
+    XK_numerosign                 : exit($2116);  { U+2116 NUMERO SIGN }
+    XKc_Serbian_DJE               : exit($0402);  { U+0402 CYRILLIC CAPITAL LETTER DJE }
+    XKc_Macedonia_GJE             : exit($0403);  { U+0403 CYRILLIC CAPITAL LETTER GJE }
+    XKc_Cyrillic_IO               : exit($0401);  { U+0401 CYRILLIC CAPITAL LETTER IO }
+    XKc_Ukrainian_IE              : exit($0404);  { U+0404 CYRILLIC CAPITAL LETTER UKRAINIAN IE }
+    XKc_Macedonia_DSE             : exit($0405);  { U+0405 CYRILLIC CAPITAL LETTER DZE }
+    XKc_Ukrainian_I               : exit($0406);  { U+0406 CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I }
+    XKc_Ukrainian_YI              : exit($0407);  { U+0407 CYRILLIC CAPITAL LETTER YI }
+    XKc_Cyrillic_JE               : exit($0408);  { U+0408 CYRILLIC CAPITAL LETTER JE }
+    XKc_Cyrillic_LJE              : exit($0409);  { U+0409 CYRILLIC CAPITAL LETTER LJE }
+    XKc_Cyrillic_NJE              : exit($040A);  { U+040A CYRILLIC CAPITAL LETTER NJE }
+    XKc_Serbian_TSHE              : exit($040B);  { U+040B CYRILLIC CAPITAL LETTER TSHE }
+    XKc_Macedonia_KJE             : exit($040C);  { U+040C CYRILLIC CAPITAL LETTER KJE }
+    XKc_Ukrainian_GHE_WITH_UPTURN : exit($0490);  { U+0490 CYRILLIC CAPITAL LETTER GHE WITH UPTURN }
+    XKc_Byelorussian_SHORTU       : exit($040E);  { U+040E CYRILLIC CAPITAL LETTER SHORT U }
+    XKc_Cyrillic_DZHE             : exit($040F);  { U+040F CYRILLIC CAPITAL LETTER DZHE }
+    XK_Cyrillic_yu                : exit($044E);  { U+044E CYRILLIC SMALL LETTER YU }
+    XK_Cyrillic_a                 : exit($0430);  { U+0430 CYRILLIC SMALL LETTER A }
+    XK_Cyrillic_be                : exit($0431);  { U+0431 CYRILLIC SMALL LETTER BE }
+    XK_Cyrillic_tse               : exit($0446);  { U+0446 CYRILLIC SMALL LETTER TSE }
+    XK_Cyrillic_de                : exit($0434);  { U+0434 CYRILLIC SMALL LETTER DE }
+    XK_Cyrillic_ie                : exit($0435);  { U+0435 CYRILLIC SMALL LETTER IE }
+    XK_Cyrillic_ef                : exit($0444);  { U+0444 CYRILLIC SMALL LETTER EF }
+    XK_Cyrillic_ghe               : exit($0433);  { U+0433 CYRILLIC SMALL LETTER GHE }
+    XK_Cyrillic_ha                : exit($0445);  { U+0445 CYRILLIC SMALL LETTER HA }
+    XK_Cyrillic_i                 : exit($0438);  { U+0438 CYRILLIC SMALL LETTER I }
+    XK_Cyrillic_shorti            : exit($0439);  { U+0439 CYRILLIC SMALL LETTER SHORT I }
+    XK_Cyrillic_ka                : exit($043A);  { U+043A CYRILLIC SMALL LETTER KA }
+    XK_Cyrillic_el                : exit($043B);  { U+043B CYRILLIC SMALL LETTER EL }
+    XK_Cyrillic_em                : exit($043C);  { U+043C CYRILLIC SMALL LETTER EM }
+    XK_Cyrillic_en                : exit($043D);  { U+043D CYRILLIC SMALL LETTER EN }
+    XK_Cyrillic_o                 : exit($043E);  { U+043E CYRILLIC SMALL LETTER O }
+    XK_Cyrillic_pe                : exit($043F);  { U+043F CYRILLIC SMALL LETTER PE }
+    XK_Cyrillic_ya                : exit($044F);  { U+044F CYRILLIC SMALL LETTER YA }
+    XK_Cyrillic_er                : exit($0440);  { U+0440 CYRILLIC SMALL LETTER ER }
+    XK_Cyrillic_es                : exit($0441);  { U+0441 CYRILLIC SMALL LETTER ES }
+    XK_Cyrillic_te                : exit($0442);  { U+0442 CYRILLIC SMALL LETTER TE }
+    XK_Cyrillic_u                 : exit($0443);  { U+0443 CYRILLIC SMALL LETTER U }
+    XK_Cyrillic_zhe               : exit($0436);  { U+0436 CYRILLIC SMALL LETTER ZHE }
+    XK_Cyrillic_ve                : exit($0432);  { U+0432 CYRILLIC SMALL LETTER VE }
+    XK_Cyrillic_softsign          : exit($044C);  { U+044C CYRILLIC SMALL LETTER SOFT SIGN }
+    XK_Cyrillic_yeru              : exit($044B);  { U+044B CYRILLIC SMALL LETTER YERU }
+    XK_Cyrillic_ze                : exit($0437);  { U+0437 CYRILLIC SMALL LETTER ZE }
+    XK_Cyrillic_sha               : exit($0448);  { U+0448 CYRILLIC SMALL LETTER SHA }
+    XK_Cyrillic_e                 : exit($044D);  { U+044D CYRILLIC SMALL LETTER E }
+    XK_Cyrillic_shcha             : exit($0449);  { U+0449 CYRILLIC SMALL LETTER SHCHA }
+    XK_Cyrillic_che               : exit($0447);  { U+0447 CYRILLIC SMALL LETTER CHE }
+    XK_Cyrillic_hardsign          : exit($044A);  { U+044A CYRILLIC SMALL LETTER HARD SIGN }
+    XKc_Cyrillic_YU               : exit($042E);  { U+042E CYRILLIC CAPITAL LETTER YU }
+    XKc_Cyrillic_A                : exit($0410);  { U+0410 CYRILLIC CAPITAL LETTER A }
+    XKc_Cyrillic_BE               : exit($0411);  { U+0411 CYRILLIC CAPITAL LETTER BE }
+    XKc_Cyrillic_TSE              : exit($0426);  { U+0426 CYRILLIC CAPITAL LETTER TSE }
+    XKc_Cyrillic_DE               : exit($0414);  { U+0414 CYRILLIC CAPITAL LETTER DE }
+    XKc_Cyrillic_IE               : exit($0415);  { U+0415 CYRILLIC CAPITAL LETTER IE }
+    XKc_Cyrillic_EF               : exit($0424);  { U+0424 CYRILLIC CAPITAL LETTER EF }
+    XKc_Cyrillic_GHE              : exit($0413);  { U+0413 CYRILLIC CAPITAL LETTER GHE }
+    XKc_Cyrillic_HA               : exit($0425);  { U+0425 CYRILLIC CAPITAL LETTER HA }
+    XKc_Cyrillic_I                : exit($0418);  { U+0418 CYRILLIC CAPITAL LETTER I }
+    XKc_Cyrillic_SHORTI           : exit($0419);  { U+0419 CYRILLIC CAPITAL LETTER SHORT I }
+    XKc_Cyrillic_KA               : exit($041A);  { U+041A CYRILLIC CAPITAL LETTER KA }
+    XKc_Cyrillic_EL               : exit($041B);  { U+041B CYRILLIC CAPITAL LETTER EL }
+    XKc_Cyrillic_EM               : exit($041C);  { U+041C CYRILLIC CAPITAL LETTER EM }
+    XKc_Cyrillic_EN               : exit($041D);  { U+041D CYRILLIC CAPITAL LETTER EN }
+    XKc_Cyrillic_O                : exit($041E);  { U+041E CYRILLIC CAPITAL LETTER O }
+    XKc_Cyrillic_PE               : exit($041F);  { U+041F CYRILLIC CAPITAL LETTER PE }
+    XKc_Cyrillic_YA               : exit($042F);  { U+042F CYRILLIC CAPITAL LETTER YA }
+    XKc_Cyrillic_ER               : exit($0420);  { U+0420 CYRILLIC CAPITAL LETTER ER }
+    XKc_Cyrillic_ES               : exit($0421);  { U+0421 CYRILLIC CAPITAL LETTER ES }
+    XKc_Cyrillic_TE               : exit($0422);  { U+0422 CYRILLIC CAPITAL LETTER TE }
+    XKc_Cyrillic_U                : exit($0423);  { U+0423 CYRILLIC CAPITAL LETTER U }
+    XKc_Cyrillic_ZHE              : exit($0416);  { U+0416 CYRILLIC CAPITAL LETTER ZHE }
+    XKc_Cyrillic_VE               : exit($0412);  { U+0412 CYRILLIC CAPITAL LETTER VE }
+    XKc_Cyrillic_SOFTSIGN         : exit($042C);  { U+042C CYRILLIC CAPITAL LETTER SOFT SIGN }
+    XKc_Cyrillic_YERU             : exit($042B);  { U+042B CYRILLIC CAPITAL LETTER YERU }
+    XKc_Cyrillic_ZE               : exit($0417);  { U+0417 CYRILLIC CAPITAL LETTER ZE }
+    XKc_Cyrillic_SHA              : exit($0428);  { U+0428 CYRILLIC CAPITAL LETTER SHA }
+    XKc_Cyrillic_E                : exit($042D);  { U+042D CYRILLIC CAPITAL LETTER E }
+    XKc_Cyrillic_SHCHA            : exit($0429);  { U+0429 CYRILLIC CAPITAL LETTER SHCHA }
+    XKc_Cyrillic_CHE              : exit($0427);  { U+0427 CYRILLIC CAPITAL LETTER CHE }
+    XKc_Cyrillic_HARDSIGN         : exit($042A);  { U+042A CYRILLIC CAPITAL LETTER HARD SIGN }
 
-{    XKc_Greek_ALPHAaccent    : exit($);
-    XKc_Greek_EPSILONaccent  : exit($);
-    XKc_Greek_ETAaccent      : exit($);
-    XKc_Greek_IOTAaccent     : exit($);
-    XKc_Greek_IOTAdieresis   : exit($);
-    XKc_Greek_OMICRONaccent  : exit($);
-    XKc_Greek_UPSILONaccent  : exit($);
-    XKc_Greek_UPSILONdieresis: exit($);
-    XKc_Greek_OMEGAaccent    : exit($);
-    XK_Greek_accentdieresis  : exit($);
-    XK_Greek_horizbar        : exit($);
-    XK_Greek_alphaaccent     : exit($);
-    XK_Greek_epsilonaccent   : exit($);
-    XK_Greek_etaaccent       : exit($);
-    XK_Greek_iotaaccent      : exit($);
-    XK_Greek_iotadieresis    : exit($);
-    XK_Greek_iotaaccentdieresis: exit($);
-    XK_Greek_omicronaccent   : exit($);
-    XK_Greek_upsilonaccent   : exit($);
-    XK_Greek_upsilondieresis : exit($);
-    XK_Greek_upsilonaccentdieresis: exit($);
-    XK_Greek_omegaaccent     : exit($);}
-    XKc_Greek_ALPHA          : exit($391);
-    XKc_Greek_BETA           : exit($392);
-    XKc_Greek_GAMMA          : exit($393);
-    XKc_Greek_DELTA          : exit($394);
-    XKc_Greek_EPSILON        : exit($395);
-    XKc_Greek_ZETA           : exit($396);
-    XKc_Greek_ETA            : exit($397);
-    XKc_Greek_THETA          : exit($398);
-    XKc_Greek_IOTA           : exit($399);
-    XKc_Greek_KAPPA          : exit($39A);
-    XKc_Greek_LAMDA          : exit($39B);
-    XKc_Greek_MU             : exit($39C);
-    XKc_Greek_NU             : exit($39D);
-    XKc_Greek_XI             : exit($39E);
-    XKc_Greek_OMICRON        : exit($39F);
-    XKc_Greek_PI             : exit($3A0);
-    XKc_Greek_RHO            : exit($3A1);
-    XKc_Greek_SIGMA          : exit($3A3);
-    XKc_Greek_TAU            : exit($3A4);
-    XKc_Greek_UPSILON        : exit($3A5);
-    XKc_Greek_PHI            : exit($3A6);
-    XKc_Greek_CHI            : exit($3A7);
-    XKc_Greek_PSI            : exit($3A8);
-    XKc_Greek_OMEGA          : exit($3A9);
-    XK_Greek_alpha           : exit($3B1);
-    XK_Greek_beta            : exit($3B2);
-    XK_Greek_gamma           : exit($3B3);
-    XK_Greek_delta           : exit($3B4);
-    XK_Greek_epsilon         : exit($3B5);
-    XK_Greek_zeta            : exit($3B6);
-    XK_Greek_eta             : exit($3B7);
-    XK_Greek_theta           : exit($3B8);
-    XK_Greek_iota            : exit($3B9);
-    XK_Greek_kappa           : exit($3BA);
-    XK_Greek_lamda           : exit($3BB);
-    XK_Greek_mu              : exit($3BC);
-    XK_Greek_nu              : exit($3BD);
-    XK_Greek_xi              : exit($3BE);
-    XK_Greek_omicron         : exit($3BF);
-    XK_Greek_pi              : exit($3C0);
-    XK_Greek_rho             : exit($3C1);
-    XK_Greek_sigma           : exit($3C2);
-    XK_Greek_finalsmallsigma : exit($3C3);
-    XK_Greek_tau             : exit($3C4);
-    XK_Greek_upsilon         : exit($3C5);
-    XK_Greek_phi             : exit($3C6);
-    XK_Greek_chi             : exit($3C7);
-    XK_Greek_psi             : exit($3C8);
-    XK_Greek_omega           : exit($3C9);
+    { Greek }
+    XKc_Greek_ALPHAaccent          : exit($0386);  { U+0386 GREEK CAPITAL LETTER ALPHA WITH TONOS }
+    XKc_Greek_EPSILONaccent        : exit($0388);  { U+0388 GREEK CAPITAL LETTER EPSILON WITH TONOS }
+    XKc_Greek_ETAaccent            : exit($0389);  { U+0389 GREEK CAPITAL LETTER ETA WITH TONOS }
+    XKc_Greek_IOTAaccent           : exit($038A);  { U+038A GREEK CAPITAL LETTER IOTA WITH TONOS }
+    XKc_Greek_IOTAdieresis         : exit($03AA);  { U+03AA GREEK CAPITAL LETTER IOTA WITH DIALYTIKA }
+    XKc_Greek_OMICRONaccent        : exit($038C);  { U+038C GREEK CAPITAL LETTER OMICRON WITH TONOS }
+    XKc_Greek_UPSILONaccent        : exit($038E);  { U+038E GREEK CAPITAL LETTER UPSILON WITH TONOS }
+    XKc_Greek_UPSILONdieresis      : exit($03AB);  { U+03AB GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA }
+    XKc_Greek_OMEGAaccent          : exit($038F);  { U+038F GREEK CAPITAL LETTER OMEGA WITH TONOS }
+    XK_Greek_accentdieresis        : exit($0385);  { U+0385 GREEK DIALYTIKA TONOS }
+    XK_Greek_horizbar              : exit($2015);  { U+2015 HORIZONTAL BAR }
+    XK_Greek_alphaaccent           : exit($03AC);  { U+03AC GREEK SMALL LETTER ALPHA WITH TONOS }
+    XK_Greek_epsilonaccent         : exit($03AD);  { U+03AD GREEK SMALL LETTER EPSILON WITH TONOS }
+    XK_Greek_etaaccent             : exit($03AE);  { U+03AE GREEK SMALL LETTER ETA WITH TONOS }
+    XK_Greek_iotaaccent            : exit($03AF);  { U+03AF GREEK SMALL LETTER IOTA WITH TONOS }
+    XK_Greek_iotadieresis          : exit($03CA);  { U+03CA GREEK SMALL LETTER IOTA WITH DIALYTIKA }
+    XK_Greek_iotaaccentdieresis    : exit($0390);  { U+0390 GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS }
+    XK_Greek_omicronaccent         : exit($03CC);  { U+03CC GREEK SMALL LETTER OMICRON WITH TONOS }
+    XK_Greek_upsilonaccent         : exit($03CD);  { U+03CD GREEK SMALL LETTER UPSILON WITH TONOS }
+    XK_Greek_upsilondieresis       : exit($03CB);  { U+03CB GREEK SMALL LETTER UPSILON WITH DIALYTIKA }
+    XK_Greek_upsilonaccentdieresis : exit($03B0);  { U+03B0 GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS }
+    XK_Greek_omegaaccent           : exit($03CE);  { U+03CE GREEK SMALL LETTER OMEGA WITH TONOS }
+    XKc_Greek_ALPHA                : exit($0391);  { U+0391 GREEK CAPITAL LETTER ALPHA }
+    XKc_Greek_BETA                 : exit($0392);  { U+0392 GREEK CAPITAL LETTER BETA }
+    XKc_Greek_GAMMA                : exit($0393);  { U+0393 GREEK CAPITAL LETTER GAMMA }
+    XKc_Greek_DELTA                : exit($0394);  { U+0394 GREEK CAPITAL LETTER DELTA }
+    XKc_Greek_EPSILON              : exit($0395);  { U+0395 GREEK CAPITAL LETTER EPSILON }
+    XKc_Greek_ZETA                 : exit($0396);  { U+0396 GREEK CAPITAL LETTER ZETA }
+    XKc_Greek_ETA                  : exit($0397);  { U+0397 GREEK CAPITAL LETTER ETA }
+    XKc_Greek_THETA                : exit($0398);  { U+0398 GREEK CAPITAL LETTER THETA }
+    XKc_Greek_IOTA                 : exit($0399);  { U+0399 GREEK CAPITAL LETTER IOTA }
+    XKc_Greek_KAPPA                : exit($039A);  { U+039A GREEK CAPITAL LETTER KAPPA }
+    XKc_Greek_LAMDA                : exit($039B);  { U+039B GREEK CAPITAL LETTER LAMDA }
+    XKc_Greek_MU                   : exit($039C);  { U+039C GREEK CAPITAL LETTER MU }
+    XKc_Greek_NU                   : exit($039D);  { U+039D GREEK CAPITAL LETTER NU }
+    XKc_Greek_XI                   : exit($039E);  { U+039E GREEK CAPITAL LETTER XI }
+    XKc_Greek_OMICRON              : exit($039F);  { U+039F GREEK CAPITAL LETTER OMICRON }
+    XKc_Greek_PI                   : exit($03A0);  { U+03A0 GREEK CAPITAL LETTER PI }
+    XKc_Greek_RHO                  : exit($03A1);  { U+03A1 GREEK CAPITAL LETTER RHO }
+    XKc_Greek_SIGMA                : exit($03A3);  { U+03A3 GREEK CAPITAL LETTER SIGMA }
+    XKc_Greek_TAU                  : exit($03A4);  { U+03A4 GREEK CAPITAL LETTER TAU }
+    XKc_Greek_UPSILON              : exit($03A5);  { U+03A5 GREEK CAPITAL LETTER UPSILON }
+    XKc_Greek_PHI                  : exit($03A6);  { U+03A6 GREEK CAPITAL LETTER PHI }
+    XKc_Greek_CHI                  : exit($03A7);  { U+03A7 GREEK CAPITAL LETTER CHI }
+    XKc_Greek_PSI                  : exit($03A8);  { U+03A8 GREEK CAPITAL LETTER PSI }
+    XKc_Greek_OMEGA                : exit($03A9);  { U+03A9 GREEK CAPITAL LETTER OMEGA }
+    XK_Greek_alpha                 : exit($03B1);  { U+03B1 GREEK SMALL LETTER ALPHA }
+    XK_Greek_beta                  : exit($03B2);  { U+03B2 GREEK SMALL LETTER BETA }
+    XK_Greek_gamma                 : exit($03B3);  { U+03B3 GREEK SMALL LETTER GAMMA }
+    XK_Greek_delta                 : exit($03B4);  { U+03B4 GREEK SMALL LETTER DELTA }
+    XK_Greek_epsilon               : exit($03B5);  { U+03B5 GREEK SMALL LETTER EPSILON }
+    XK_Greek_zeta                  : exit($03B6);  { U+03B6 GREEK SMALL LETTER ZETA }
+    XK_Greek_eta                   : exit($03B7);  { U+03B7 GREEK SMALL LETTER ETA }
+    XK_Greek_theta                 : exit($03B8);  { U+03B8 GREEK SMALL LETTER THETA }
+    XK_Greek_iota                  : exit($03B9);  { U+03B9 GREEK SMALL LETTER IOTA }
+    XK_Greek_kappa                 : exit($03BA);  { U+03BA GREEK SMALL LETTER KAPPA }
+    XK_Greek_lamda                 : exit($03BB);  { U+03BB GREEK SMALL LETTER LAMDA }
+    XK_Greek_mu                    : exit($03BC);  { U+03BC GREEK SMALL LETTER MU }
+    XK_Greek_nu                    : exit($03BD);  { U+03BD GREEK SMALL LETTER NU }
+    XK_Greek_xi                    : exit($03BE);  { U+03BE GREEK SMALL LETTER XI }
+    XK_Greek_omicron               : exit($03BF);  { U+03BF GREEK SMALL LETTER OMICRON }
+    XK_Greek_pi                    : exit($03C0);  { U+03C0 GREEK SMALL LETTER PI }
+    XK_Greek_rho                   : exit($03C1);  { U+03C1 GREEK SMALL LETTER RHO }
+    XK_Greek_sigma                 : exit($03C2);  { U+03C3 GREEK SMALL LETTER SIGMA }
+    XK_Greek_finalsmallsigma       : exit($03C3);  { U+03C2 GREEK SMALL LETTER FINAL SIGMA }
+    XK_Greek_tau                   : exit($03C4);  { U+03C4 GREEK SMALL LETTER TAU }
+    XK_Greek_upsilon               : exit($03C5);  { U+03C5 GREEK SMALL LETTER UPSILON }
+    XK_Greek_phi                   : exit($03C6);  { U+03C6 GREEK SMALL LETTER PHI }
+    XK_Greek_chi                   : exit($03C7);  { U+03C7 GREEK SMALL LETTER CHI }
+    XK_Greek_psi                   : exit($03C8);  { U+03C8 GREEK SMALL LETTER PSI }
+    XK_Greek_omega                 : exit($03C9);  { U+03C9 GREEK SMALL LETTER OMEGA }
+
+    { Technical }
+    XK_leftradical               : exit($23B7);  { U+23B7 RADICAL SYMBOL BOTTOM }
+    XK_topleftradical            : exit($250C);  {(U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT)}
+    XK_horizconnector            : exit($2500);  {(U+2500 BOX DRAWINGS LIGHT HORIZONTAL)}
+    XK_topintegral               : exit($2320);  { U+2320 TOP HALF INTEGRAL }
+    XK_botintegral               : exit($2321);  { U+2321 BOTTOM HALF INTEGRAL }
+    XK_vertconnector             : exit($2502);  {(U+2502 BOX DRAWINGS LIGHT VERTICAL)}
+    XK_topleftsqbracket          : exit($23A1);  { U+23A1 LEFT SQUARE BRACKET UPPER CORNER }
+    XK_botleftsqbracket          : exit($23A3);  { U+23A3 LEFT SQUARE BRACKET LOWER CORNER }
+    XK_toprightsqbracket         : exit($23A4);  { U+23A4 RIGHT SQUARE BRACKET UPPER CORNER }
+    XK_botrightsqbracket         : exit($23A6);  { U+23A6 RIGHT SQUARE BRACKET LOWER CORNER }
+    XK_topleftparens             : exit($239B);  { U+239B LEFT PARENTHESIS UPPER HOOK }
+    XK_botleftparens             : exit($239D);  { U+239D LEFT PARENTHESIS LOWER HOOK }
+    XK_toprightparens            : exit($239E);  { U+239E RIGHT PARENTHESIS UPPER HOOK }
+    XK_botrightparens            : exit($23A0);  { U+23A0 RIGHT PARENTHESIS LOWER HOOK }
+    XK_leftmiddlecurlybrace      : exit($23A8);  { U+23A8 LEFT CURLY BRACKET MIDDLE PIECE }
+    XK_rightmiddlecurlybrace     : exit($23AC);  { U+23AC RIGHT CURLY BRACKET MIDDLE PIECE }
+{    XK_topleftsummation          : exit($);
+    XK_botleftsummation          : exit($);
+    XK_topvertsummationconnector : exit($);
+    XK_botvertsummationconnector : exit($);
+    XK_toprightsummation         : exit($);
+    XK_botrightsummation         : exit($);
+    XK_rightmiddlesummation      : exit($);}
+    XK_lessthanequal             : exit($2264);  { U+2264 LESS-THAN OR EQUAL TO }
+    XK_notequal                  : exit($2260);  { U+2260 NOT EQUAL TO }
+    XK_greaterthanequal          : exit($2265);  { U+2265 GREATER-THAN OR EQUAL TO }
+    XK_integral                  : exit($222B);  { U+222B INTEGRAL }
+    XK_therefore                 : exit($2234);  { U+2234 THEREFORE }
+    XK_variation                 : exit($221D);  { U+221D PROPORTIONAL TO }
+    XK_infinity                  : exit($221E);  { U+221E INFINITY }
+    XK_nabla                     : exit($2207);  { U+2207 NABLA }
+    XK_approximate               : exit($223C);  { U+223C TILDE OPERATOR }
+    XK_similarequal              : exit($2243);  { U+2243 ASYMPTOTICALLY EQUAL TO }
+    XK_ifonlyif                  : exit($21D4);  { U+21D4 LEFT RIGHT DOUBLE ARROW }
+    XK_implies                   : exit($21D2);  { U+21D2 RIGHTWARDS DOUBLE ARROW }
+    XK_identical                 : exit($2261);  { U+2261 IDENTICAL TO }
+    XK_radical                   : exit($221A);  { U+221A SQUARE ROOT }
+    XK_includedin                : exit($2282);  { U+2282 SUBSET OF }
+    XK_includes                  : exit($2283);  { U+2283 SUPERSET OF }
+    XK_intersection              : exit($2229);  { U+2229 INTERSECTION }
+    XK_union                     : exit($222A);  { U+222A UNION }
+    XK_logicaland                : exit($2227);  { U+2227 LOGICAL AND }
+    XK_logicalor                 : exit($2228);  { U+2228 LOGICAL OR }
+    XK_partialderivative         : exit($2202);  { U+2202 PARTIAL DIFFERENTIAL }
+    XK_function                  : exit($0192);  { U+0192 LATIN SMALL LETTER F WITH HOOK }
+    XK_leftarrow                 : exit($2190);  { U+2190 LEFTWARDS ARROW }
+    XK_uparrow                   : exit($2191);  { U+2191 UPWARDS ARROW }
+    XK_rightarrow                : exit($2192);  { U+2192 RIGHTWARDS ARROW }
+    XK_downarrow                 : exit($2193);  { U+2193 DOWNWARDS ARROW }
+
+    { Special }
+{    XK_blank          : exit($);}
+    XK_soliddiamond   : exit($25C6);  { U+25C6 BLACK DIAMOND }
+    XK_checkerboard   : exit($2592);  { U+2592 MEDIUM SHADE }
+    XK_ht             : exit($2409);  { U+2409 SYMBOL FOR HORIZONTAL TABULATION }
+    XK_ff             : exit($240C);  { U+240C SYMBOL FOR FORM FEED }
+    XK_cr             : exit($240D);  { U+240D SYMBOL FOR CARRIAGE RETURN }
+    XK_lf             : exit($240A);  { U+240A SYMBOL FOR LINE FEED }
+    XK_nl             : exit($2424);  { U+2424 SYMBOL FOR NEWLINE }
+    XK_vt             : exit($240B);  { U+240B SYMBOL FOR VERTICAL TABULATION }
+    XK_lowrightcorner : exit($2518);  { U+2518 BOX DRAWINGS LIGHT UP AND LEFT }
+    XK_uprightcorner  : exit($2510);  { U+2510 BOX DRAWINGS LIGHT DOWN AND LEFT }
+    XK_upleftcorner   : exit($250C);  { U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT }
+    XK_lowleftcorner  : exit($2514);  { U+2514 BOX DRAWINGS LIGHT UP AND RIGHT }
+    XK_crossinglines  : exit($253C);  { U+253C BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL }
+    XK_horizlinescan1 : exit($23BA);  { U+23BA HORIZONTAL SCAN LINE-1 }
+    XK_horizlinescan3 : exit($23BB);  { U+23BB HORIZONTAL SCAN LINE-3 }
+    XK_horizlinescan5 : exit($2500);  { U+2500 BOX DRAWINGS LIGHT HORIZONTAL }
+    XK_horizlinescan7 : exit($23BC);  { U+23BC HORIZONTAL SCAN LINE-7 }
+    XK_horizlinescan9 : exit($23BD);  { U+23BD HORIZONTAL SCAN LINE-9 }
+    XK_leftt          : exit($251C);  { U+251C BOX DRAWINGS LIGHT VERTICAL AND RIGHT }
+    XK_rightt         : exit($2524);  { U+2524 BOX DRAWINGS LIGHT VERTICAL AND LEFT }
+    XK_bott           : exit($2534);  { U+2534 BOX DRAWINGS LIGHT UP AND HORIZONTAL }
+    XK_topt           : exit($252C);  { U+252C BOX DRAWINGS LIGHT DOWN AND HORIZONTAL }
+    XK_vertbar        : exit($2502);  { U+2502 BOX DRAWINGS LIGHT VERTICAL }
+
+    { Publishing }
+    XK_emspace              : exit($2003);  { U+2003 EM SPACE }
+    XK_enspace              : exit($2002);  { U+2002 EN SPACE }
+    XK_em3space             : exit($2004);  { U+2004 THREE-PER-EM SPACE }
+    XK_em4space             : exit($2005);  { U+2005 FOUR-PER-EM SPACE }
+    XK_digitspace           : exit($2007);  { U+2007 FIGURE SPACE }
+    XK_punctspace           : exit($2008);  { U+2008 PUNCTUATION SPACE }
+    XK_thinspace            : exit($2009);  { U+2009 THIN SPACE }
+    XK_hairspace            : exit($200A);  { U+200A HAIR SPACE }
+    XK_emdash               : exit($2014);  { U+2014 EM DASH }
+    XK_endash               : exit($2013);  { U+2013 EN DASH }
+    XK_signifblank          : exit($2423);  {(U+2423 OPEN BOX)}
+    XK_ellipsis             : exit($2026);  { U+2026 HORIZONTAL ELLIPSIS }
+    XK_doubbaselinedot      : exit($2025);  { U+2025 TWO DOT LEADER }
+    XK_onethird             : exit($2153);  { U+2153 VULGAR FRACTION ONE THIRD }
+    XK_twothirds            : exit($2154);  { U+2154 VULGAR FRACTION TWO THIRDS }
+    XK_onefifth             : exit($2155);  { U+2155 VULGAR FRACTION ONE FIFTH }
+    XK_twofifths            : exit($2156);  { U+2156 VULGAR FRACTION TWO FIFTHS }
+    XK_threefifths          : exit($2157);  { U+2157 VULGAR FRACTION THREE FIFTHS }
+    XK_fourfifths           : exit($2158);  { U+2158 VULGAR FRACTION FOUR FIFTHS }
+    XK_onesixth             : exit($2159);  { U+2159 VULGAR FRACTION ONE SIXTH }
+    XK_fivesixths           : exit($215A);  { U+215A VULGAR FRACTION FIVE SIXTHS }
+    XK_careof               : exit($2105);  { U+2105 CARE OF }
+    XK_figdash              : exit($2012);  { U+2012 FIGURE DASH }
+    XK_leftanglebracket     : exit($27E8);  {(U+27E8 MATHEMATICAL LEFT ANGLE BRACKET)}
+    XK_decimalpoint         : exit($002E);  {(U+002E FULL STOP)}
+    XK_rightanglebracket    : exit($27E9);  {(U+27E9 MATHEMATICAL RIGHT ANGLE BRACKET)}
+{    XK_marker               : exit($);}
+    XK_oneeighth            : exit($215B);  { U+215B VULGAR FRACTION ONE EIGHTH }
+    XK_threeeighths         : exit($215C);  { U+215C VULGAR FRACTION THREE EIGHTHS }
+    XK_fiveeighths          : exit($215D);  { U+215D VULGAR FRACTION FIVE EIGHTHS }
+    XK_seveneighths         : exit($215E);  { U+215E VULGAR FRACTION SEVEN EIGHTHS }
+    XK_trademark            : exit($2122);  { U+2122 TRADE MARK SIGN }
+    XK_signaturemark        : exit($2613);  {(U+2613 SALTIRE)}
+{    XK_trademarkincircle    : exit($);}
+    XK_leftopentriangle     : exit($25C1);  {(U+25C1 WHITE LEFT-POINTING TRIANGLE)}
+    XK_rightopentriangle    : exit($25B7);  {(U+25B7 WHITE RIGHT-POINTING TRIANGLE)}
+    XK_emopencircle         : exit($25CB);  {(U+25CB WHITE CIRCLE)}
+    XK_emopenrectangle      : exit($25AF);  {(U+25AF WHITE VERTICAL RECTANGLE)}
+    XK_leftsinglequotemark  : exit($2018);  { U+2018 LEFT SINGLE QUOTATION MARK }
+    XK_rightsinglequotemark : exit($2019);  { U+2019 RIGHT SINGLE QUOTATION MARK }
+    XK_leftdoublequotemark  : exit($201C);  { U+201C LEFT DOUBLE QUOTATION MARK }
+    XK_rightdoublequotemark : exit($201D);  { U+201D RIGHT DOUBLE QUOTATION MARK }
+    XK_prescription         : exit($211E);  { U+211E PRESCRIPTION TAKE }
+    XK_permille             : exit($2030);  { U+2030 PER MILLE SIGN }
+    XK_minutes              : exit($2032);  { U+2032 PRIME }
+    XK_seconds              : exit($2033);  { U+2033 DOUBLE PRIME }
+    XK_latincross           : exit($271D);  { U+271D LATIN CROSS }
+{    XK_hexagram             : exit($);}
+    XK_filledrectbullet     : exit($25AC);  {(U+25AC BLACK RECTANGLE)}
+    XK_filledlefttribullet  : exit($25C0);  {(U+25C0 BLACK LEFT-POINTING TRIANGLE)}
+    XK_filledrighttribullet : exit($25B6);  {(U+25B6 BLACK RIGHT-POINTING TRIANGLE)}
+    XK_emfilledcircle       : exit($25CF);  {(U+25CF BLACK CIRCLE)}
+    XK_emfilledrect         : exit($25AE);  {(U+25AE BLACK VERTICAL RECTANGLE)}
+    XK_enopencircbullet     : exit($25E6);  {(U+25E6 WHITE BULLET)}
+    XK_enopensquarebullet   : exit($25AB);  {(U+25AB WHITE SMALL SQUARE)}
+    XK_openrectbullet       : exit($25AD);  {(U+25AD WHITE RECTANGLE)}
+    XK_opentribulletup      : exit($25B3);  {(U+25B3 WHITE UP-POINTING TRIANGLE)}
+    XK_opentribulletdown    : exit($25BD);  {(U+25BD WHITE DOWN-POINTING TRIANGLE)}
+    XK_openstar             : exit($2606);  {(U+2606 WHITE STAR)}
+    XK_enfilledcircbullet   : exit($2022);  {(U+2022 BULLET)}
+    XK_enfilledsqbullet     : exit($25AA);  {(U+25AA BLACK SMALL SQUARE)}
+    XK_filledtribulletup    : exit($25B2);  {(U+25B2 BLACK UP-POINTING TRIANGLE)}
+    XK_filledtribulletdown  : exit($25BC);  {(U+25BC BLACK DOWN-POINTING TRIANGLE)}
+    XK_leftpointer          : exit($261C);  {(U+261C WHITE LEFT POINTING INDEX)}
+    XK_rightpointer         : exit($261E);  {(U+261E WHITE RIGHT POINTING INDEX)}
+    XK_club                 : exit($2663);  { U+2663 BLACK CLUB SUIT }
+    XK_diamond              : exit($2666);  { U+2666 BLACK DIAMOND SUIT }
+    XK_heart                : exit($2665);  { U+2665 BLACK HEART SUIT }
+    XK_maltesecross         : exit($2720);  { U+2720 MALTESE CROSS }
+    XK_dagger               : exit($2020);  { U+2020 DAGGER }
+    XK_doubledagger         : exit($2021);  { U+2021 DOUBLE DAGGER }
+    XK_checkmark            : exit($2713);  { U+2713 CHECK MARK }
+    XK_ballotcross          : exit($2717);  { U+2717 BALLOT X }
+    XK_musicalsharp         : exit($266F);  { U+266F MUSIC SHARP SIGN }
+    XK_musicalflat          : exit($266D);  { U+266D MUSIC FLAT SIGN }
+    XK_malesymbol           : exit($2642);  { U+2642 MALE SIGN }
+    XK_femalesymbol         : exit($2640);  { U+2640 FEMALE SIGN }
+    XK_telephone            : exit($260E);  { U+260E BLACK TELEPHONE }
+    XK_telephonerecorder    : exit($2315);  { U+2315 TELEPHONE RECORDER }
+    XK_phonographcopyright  : exit($2117);  { U+2117 SOUND RECORDING COPYRIGHT }
+    XK_caret                : exit($2038);  { U+2038 CARET }
+    XK_singlelowquotemark   : exit($201A);  { U+201A SINGLE LOW-9 QUOTATION MARK }
+    XK_doublelowquotemark   : exit($201E);  { U+201E DOUBLE LOW-9 QUOTATION MARK }
+{    XK_cursor               : exit($);}
+
+    { APL }
+    XK_leftcaret  : exit($003C);  {(U+003C LESS-THAN SIGN)}
+    XK_rightcaret : exit($003E);  {(U+003E GREATER-THAN SIGN)}
+    XK_downcaret  : exit($2228);  {(U+2228 LOGICAL OR)}
+    XK_upcaret    : exit($2227);  {(U+2227 LOGICAL AND)}
+    XK_overbar    : exit($00AF);  {(U+00AF MACRON)}
+    XK_downtack   : exit($22A4);  { U+22A4 DOWN TACK }
+    XK_upshoe     : exit($2229);  {(U+2229 INTERSECTION)}
+    XK_downstile  : exit($230A);  { U+230A LEFT FLOOR }
+    XK_underbar   : exit($005F);  {(U+005F LOW LINE)}
+    XK_jot        : exit($2218);  { U+2218 RING OPERATOR }
+    XK_quad       : exit($2395);  { U+2395 APL FUNCTIONAL SYMBOL QUAD }
+    XK_uptack     : exit($22A5);  { U+22A5 UP TACK }
+    XK_circle     : exit($25CB);  { U+25CB WHITE CIRCLE }
+    XK_upstile    : exit($2308);  { U+2308 LEFT CEILING }
+    XK_downshoe   : exit($222A);  {(U+222A UNION)}
+    XK_rightshoe  : exit($2283);  {(U+2283 SUPERSET OF)}
+    XK_leftshoe   : exit($2282);  {(U+2282 SUBSET OF)}
+    XK_lefttack   : exit($22A3);  { U+22A3 LEFT TACK }
+    XK_righttack  : exit($22A2);  { U+22A2 RIGHT TACK }
+
+    { Hebrew }
+    XK_hebrew_doublelowline : exit($2017);  { U+2017 DOUBLE LOW LINE }
+    XK_hebrew_aleph         : exit($05D0);  { U+05D0 HEBREW LETTER ALEF }
+    XK_hebrew_bet           : exit($05D1);  { U+05D1 HEBREW LETTER BET }
+    XK_hebrew_gimel         : exit($05D2);  { U+05D2 HEBREW LETTER GIMEL }
+    XK_hebrew_dalet         : exit($05D3);  { U+05D3 HEBREW LETTER DALET }
+    XK_hebrew_he            : exit($05D4);  { U+05D4 HEBREW LETTER HE }
+    XK_hebrew_waw           : exit($05D5);  { U+05D5 HEBREW LETTER VAV }
+    XK_hebrew_zain          : exit($05D6);  { U+05D6 HEBREW LETTER ZAYIN }
+    XK_hebrew_chet          : exit($05D7);  { U+05D7 HEBREW LETTER HET }
+    XK_hebrew_tet           : exit($05D8);  { U+05D8 HEBREW LETTER TET }
+    XK_hebrew_yod           : exit($05D9);  { U+05D9 HEBREW LETTER YOD }
+    XK_hebrew_finalkaph     : exit($05DA);  { U+05DA HEBREW LETTER FINAL KAF }
+    XK_hebrew_kaph          : exit($05DB);  { U+05DB HEBREW LETTER KAF }
+    XK_hebrew_lamed         : exit($05DC);  { U+05DC HEBREW LETTER LAMED }
+    XK_hebrew_finalmem      : exit($05DD);  { U+05DD HEBREW LETTER FINAL MEM }
+    XK_hebrew_mem           : exit($05DE);  { U+05DE HEBREW LETTER MEM }
+    XK_hebrew_finalnun      : exit($05DF);  { U+05DF HEBREW LETTER FINAL NUN }
+    XK_hebrew_nun           : exit($05E0);  { U+05E0 HEBREW LETTER NUN }
+    XK_hebrew_samech        : exit($05E1);  { U+05E1 HEBREW LETTER SAMEKH }
+    XK_hebrew_ayin          : exit($05E2);  { U+05E2 HEBREW LETTER AYIN }
+    XK_hebrew_finalpe       : exit($05E3);  { U+05E3 HEBREW LETTER FINAL PE }
+    XK_hebrew_pe            : exit($05E4);  { U+05E4 HEBREW LETTER PE }
+    XK_hebrew_finalzade     : exit($05E5);  { U+05E5 HEBREW LETTER FINAL TSADI }
+    XK_hebrew_zade          : exit($05E6);  { U+05E6 HEBREW LETTER TSADI }
+    XK_hebrew_qoph          : exit($05E7);  { U+05E7 HEBREW LETTER QOF }
+    XK_hebrew_resh          : exit($05E8);  { U+05E8 HEBREW LETTER RESH }
+    XK_hebrew_shin          : exit($05E9);  { U+05E9 HEBREW LETTER SHIN }
+    XK_hebrew_taw           : exit($05EA);  { U+05EA HEBREW LETTER TAV }
+
+    { Thai }
+    XK_Thai_kokai             : exit($0E01);  { U+0E01 THAI CHARACTER KO KAI }
+    XK_Thai_khokhai           : exit($0E02);  { U+0E02 THAI CHARACTER KHO KHAI }
+    XK_Thai_khokhuat          : exit($0E03);  { U+0E03 THAI CHARACTER KHO KHUAT }
+    XK_Thai_khokhwai          : exit($0E04);  { U+0E04 THAI CHARACTER KHO KHWAI }
+    XK_Thai_khokhon           : exit($0E05);  { U+0E05 THAI CHARACTER KHO KHON }
+    XK_Thai_khorakhang        : exit($0E06);  { U+0E06 THAI CHARACTER KHO RAKHANG }
+    XK_Thai_ngongu            : exit($0E07);  { U+0E07 THAI CHARACTER NGO NGU }
+    XK_Thai_chochan           : exit($0E08);  { U+0E08 THAI CHARACTER CHO CHAN }
+    XK_Thai_choching          : exit($0E09);  { U+0E09 THAI CHARACTER CHO CHING }
+    XK_Thai_chochang          : exit($0E0A);  { U+0E0A THAI CHARACTER CHO CHANG }
+    XK_Thai_soso              : exit($0E0B);  { U+0E0B THAI CHARACTER SO SO }
+    XK_Thai_chochoe           : exit($0E0C);  { U+0E0C THAI CHARACTER CHO CHOE }
+    XK_Thai_yoying            : exit($0E0D);  { U+0E0D THAI CHARACTER YO YING }
+    XK_Thai_dochada           : exit($0E0E);  { U+0E0E THAI CHARACTER DO CHADA }
+    XK_Thai_topatak           : exit($0E0F);  { U+0E0F THAI CHARACTER TO PATAK }
+    XK_Thai_thothan           : exit($0E10);  { U+0E10 THAI CHARACTER THO THAN }
+    XK_Thai_thonangmontho     : exit($0E11);  { U+0E11 THAI CHARACTER THO NANGMONTHO }
+    XK_Thai_thophuthao        : exit($0E12);  { U+0E12 THAI CHARACTER THO PHUTHAO }
+    XK_Thai_nonen             : exit($0E13);  { U+0E13 THAI CHARACTER NO NEN }
+    XK_Thai_dodek             : exit($0E14);  { U+0E14 THAI CHARACTER DO DEK }
+    XK_Thai_totao             : exit($0E15);  { U+0E15 THAI CHARACTER TO TAO }
+    XK_Thai_thothung          : exit($0E16);  { U+0E16 THAI CHARACTER THO THUNG }
+    XK_Thai_thothahan         : exit($0E17);  { U+0E17 THAI CHARACTER THO THAHAN }
+    XK_Thai_thothong          : exit($0E18);  { U+0E18 THAI CHARACTER THO THONG }
+    XK_Thai_nonu              : exit($0E19);  { U+0E19 THAI CHARACTER NO NU }
+    XK_Thai_bobaimai          : exit($0E1A);  { U+0E1A THAI CHARACTER BO BAIMAI }
+    XK_Thai_popla             : exit($0E1B);  { U+0E1B THAI CHARACTER PO PLA }
+    XK_Thai_phophung          : exit($0E1C);  { U+0E1C THAI CHARACTER PHO PHUNG }
+    XK_Thai_fofa              : exit($0E1D);  { U+0E1D THAI CHARACTER FO FA }
+    XK_Thai_phophan           : exit($0E1E);  { U+0E1E THAI CHARACTER PHO PHAN }
+    XK_Thai_fofan             : exit($0E1F);  { U+0E1F THAI CHARACTER FO FAN }
+    XK_Thai_phosamphao        : exit($0E20);  { U+0E20 THAI CHARACTER PHO SAMPHAO }
+    XK_Thai_moma              : exit($0E21);  { U+0E21 THAI CHARACTER MO MA }
+    XK_Thai_yoyak             : exit($0E22);  { U+0E22 THAI CHARACTER YO YAK }
+    XK_Thai_rorua             : exit($0E23);  { U+0E23 THAI CHARACTER RO RUA }
+    XK_Thai_ru                : exit($0E24);  { U+0E24 THAI CHARACTER RU }
+    XK_Thai_loling            : exit($0E25);  { U+0E25 THAI CHARACTER LO LING }
+    XK_Thai_lu                : exit($0E26);  { U+0E26 THAI CHARACTER LU }
+    XK_Thai_wowaen            : exit($0E27);  { U+0E27 THAI CHARACTER WO WAEN }
+    XK_Thai_sosala            : exit($0E28);  { U+0E28 THAI CHARACTER SO SALA }
+    XK_Thai_sorusi            : exit($0E29);  { U+0E29 THAI CHARACTER SO RUSI }
+    XK_Thai_sosua             : exit($0E2A);  { U+0E2A THAI CHARACTER SO SUA }
+    XK_Thai_hohip             : exit($0E2B);  { U+0E2B THAI CHARACTER HO HIP }
+    XK_Thai_lochula           : exit($0E2C);  { U+0E2C THAI CHARACTER LO CHULA }
+    XK_Thai_oang              : exit($0E2D);  { U+0E2D THAI CHARACTER O ANG }
+    XK_Thai_honokhuk          : exit($0E2E);  { U+0E2E THAI CHARACTER HO NOKHUK }
+    XK_Thai_paiyannoi         : exit($0E2F);  { U+0E2F THAI CHARACTER PAIYANNOI }
+    XK_Thai_saraa             : exit($0E30);  { U+0E30 THAI CHARACTER SARA A }
+    XK_Thai_maihanakat        : exit($0E31);  { U+0E31 THAI CHARACTER MAI HAN-AKAT }
+    XK_Thai_saraaa            : exit($0E32);  { U+0E32 THAI CHARACTER SARA AA }
+    XK_Thai_saraam            : exit($0E33);  { U+0E33 THAI CHARACTER SARA AM }
+    XK_Thai_sarai             : exit($0E34);  { U+0E34 THAI CHARACTER SARA I }
+    XK_Thai_saraii            : exit($0E35);  { U+0E35 THAI CHARACTER SARA II }
+    XK_Thai_saraue            : exit($0E36);  { U+0E36 THAI CHARACTER SARA UE }
+    XK_Thai_sarauee           : exit($0E37);  { U+0E37 THAI CHARACTER SARA UEE }
+    XK_Thai_sarau             : exit($0E38);  { U+0E38 THAI CHARACTER SARA U }
+    XK_Thai_sarauu            : exit($0E39);  { U+0E39 THAI CHARACTER SARA UU }
+    XK_Thai_phinthu           : exit($0E3A);  { U+0E3A THAI CHARACTER PHINTHU }
+{    XK_Thai_maihanakat_maitho : exit($);}
+    XK_Thai_baht              : exit($0E3F);  { U+0E3F THAI CURRENCY SYMBOL BAHT }
+    XK_Thai_sarae             : exit($0E40);  { U+0E40 THAI CHARACTER SARA E }
+    XK_Thai_saraae            : exit($0E41);  { U+0E41 THAI CHARACTER SARA AE }
+    XK_Thai_sarao             : exit($0E42);  { U+0E42 THAI CHARACTER SARA O }
+    XK_Thai_saraaimaimuan     : exit($0E43);  { U+0E43 THAI CHARACTER SARA AI MAIMUAN }
+    XK_Thai_saraaimaimalai    : exit($0E44);  { U+0E44 THAI CHARACTER SARA AI MAIMALAI }
+    XK_Thai_lakkhangyao       : exit($0E45);  { U+0E45 THAI CHARACTER LAKKHANGYAO }
+    XK_Thai_maiyamok          : exit($0E46);  { U+0E46 THAI CHARACTER MAIYAMOK }
+    XK_Thai_maitaikhu         : exit($0E47);  { U+0E47 THAI CHARACTER MAITAIKHU }
+    XK_Thai_maiek             : exit($0E48);  { U+0E48 THAI CHARACTER MAI EK }
+    XK_Thai_maitho            : exit($0E49);  { U+0E49 THAI CHARACTER MAI THO }
+    XK_Thai_maitri            : exit($0E4A);  { U+0E4A THAI CHARACTER MAI TRI }
+    XK_Thai_maichattawa       : exit($0E4B);  { U+0E4B THAI CHARACTER MAI CHATTAWA }
+    XK_Thai_thanthakhat       : exit($0E4C);  { U+0E4C THAI CHARACTER THANTHAKHAT }
+    XK_Thai_nikhahit          : exit($0E4D);  { U+0E4D THAI CHARACTER NIKHAHIT }
+    XK_Thai_leksun            : exit($0E50);  { U+0E50 THAI DIGIT ZERO }
+    XK_Thai_leknung           : exit($0E51);  { U+0E51 THAI DIGIT ONE }
+    XK_Thai_leksong           : exit($0E52);  { U+0E52 THAI DIGIT TWO }
+    XK_Thai_leksam            : exit($0E53);  { U+0E53 THAI DIGIT THREE }
+    XK_Thai_leksi             : exit($0E54);  { U+0E54 THAI DIGIT FOUR }
+    XK_Thai_lekha             : exit($0E55);  { U+0E55 THAI DIGIT FIVE }
+    XK_Thai_lekhok            : exit($0E56);  { U+0E56 THAI DIGIT SIX }
+    XK_Thai_lekchet           : exit($0E57);  { U+0E57 THAI DIGIT SEVEN }
+    XK_Thai_lekpaet           : exit($0E58);  { U+0E58 THAI DIGIT EIGHT }
+    XK_Thai_lekkao            : exit($0E59);  { U+0E59 THAI DIGIT NINE }
+
+    { Korean }
+    XK_Korean_Won : exit($20A9);  {(U+20A9 WON SIGN)}
+
+    { Currency }
+    XK_EuroSign : exit($20ac);     { U+20AC EURO SIGN }
 
   end;
   X11ConvertKeySymToUnicode := -1;
 end;
+
diff --git a/packages/ptc/src/x11/x11windowdisplayd.inc b/packages/ptc/src/x11/x11windowdisplayd.inc
index f928f60cc4..cf7a43321c 100644
--- a/packages/ptc/src/x11/x11windowdisplayd.inc
+++ b/packages/ptc/src/x11/x11windowdisplayd.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2013, 2016 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 type
@@ -44,6 +44,7 @@ type
     FCursorVisible: Boolean;
     FGrabMouse: Boolean;
     FMouseGrabbed: Boolean;
+    FRelativeMouseMode: Boolean;
     FX11InvisibleCursor: TCursor; { Blank cursor }
     FFullScreen: Boolean; { Keeps a snapshot of the PTC_X11_FULLSCREEN option
                              taken at the time 'open' was called }
@@ -62,6 +63,13 @@ type
     FGLXFBConfig: TX11GLXFBConfig;
 {$ENDIF ENABLE_X11_EXTENSION_GLX}
 
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+    FXInput2Enabled: Boolean;
+    FXInput2MajorOpCode: cint;
+    FXInput2FirstEvent: cint;
+    FXInput2FirstError: cint;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+
     procedure EnterFullScreen;
     procedure LeaveFullScreen;
     procedure internal_ShowCursor(AVisible: Boolean);
@@ -99,6 +107,8 @@ type
     function IsOpen: Boolean; override;
     procedure SetCursor(AVisible: Boolean); override;
     procedure SetMouseGrab(AGrabMouse: Boolean); override;
+    function SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean; override;
+    function MoveMouseTo(X, Y: Integer): Boolean; override;
 {$IFDEF ENABLE_X11_EXTENSION_GLX}
     procedure OpenGL_SwapBuffers; override;
     procedure OpenGL_SetSwapInterval(AInterval: Integer); override;
diff --git a/packages/ptc/src/x11/x11windowdisplayi.inc b/packages/ptc/src/x11/x11windowdisplayi.inc
index e2c97a33f5..9531e27d18 100644
--- a/packages/ptc/src/x11/x11windowdisplayi.inc
+++ b/packages/ptc/src/x11/x11windowdisplayi.inc
@@ -1,6 +1,6 @@
 {
     This file is part of the PTCPas framebuffer library
-    Copyright (C) 2001-2013 Nikolay Nikolov (nickysn@users.sourceforge.net)
+    Copyright (C) 2001-2013, 2016, 2017 Nikolay Nikolov (nickysn@users.sourceforge.net)
     Original C++ version by Christian Nentwich (c.nentwich@cs.ucl.ac.uk)
 
     This library is free software; you can redistribute it and/or
@@ -27,10 +27,15 @@
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 }
 
 constructor TX11WindowDisplay.Create(ADisplay: PDisplay; AScreen: Integer; const AFlags: TX11Flags);
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+var
+  MajorVer, MinorVer: cint;
+  QueryVersionResult: TStatus;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
 begin
   inherited;
   FFocus := True;
@@ -38,6 +43,34 @@ begin
   FCursorVisible := True;
   FGrabMouse := False;
   FMouseGrabbed := False;
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+  if PTC_X11_TRY_XINPUT2 in FFlags then
+  begin
+    LOG('Querying the XInput2 extension...');
+    if XQueryExtension(FDisplay, 'XInputExtension', @FXInput2MajorOpCode, @FXInput2FirstEvent, @FXInput2FirstError) then
+    begin
+      LOG('There is an XInput extension, now let''s query its version...');
+      MajorVer := 2;
+      MinorVer := 0;
+      LOG('We want version ' + IntToStr(MajorVer) + '.' + IntToStr(MinorVer));
+      QueryVersionResult := XIQueryVersion(FDisplay, @MajorVer, @MinorVer);
+      if QueryVersionResult = Success then
+      begin
+        LOG('XInput2 extension is available (version ' + IntToStr(MajorVer) + '.' + IntToStr(MinorVer) + ')');
+        FXInput2Enabled := True;
+      end
+      else
+      begin
+        LOG('The required XInput version is not available (version ' + IntToStr(MajorVer) + '.' + IntToStr(MinorVer) + ' only)');
+      end;
+    end
+    else
+    begin
+      LOG('XInput2 extension not available');
+      FXInput2Enabled := False;
+    end;
+  end;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
 end;
 
 destructor TX11WindowDisplay.Destroy;
@@ -46,6 +79,14 @@ begin
   inherited Destroy;
 end;
 
+{$warning remove, when fix added to xlib}
+function XGetIMValues(para1:PXIM; dotdotdot:array of const):Pchar;cdecl;external libX11;
+function XGetICValues(para1:PXIC; dotdotdot:array of const):Pchar;cdecl;external libX11;
+
+{function fpsetlocale(category: cint; locale: Pchar): PChar;cdecl;external 'c' name 'setlocale';
+const
+  LC_ALL = 6;}
+
 procedure TX11WindowDisplay.Open(ATitle: AnsiString; AWidth, AHeight: Integer; AFormat: IPTCFormat; const AOpenGLAttributes: IPTCOpenGLAttributes);
 var
   xgcv: TXGCValues;
@@ -62,6 +103,119 @@ var
   BlankCursorData: array [1..8] of Byte = (0, 0, 0, 0, 0, 0, 0, 0);
   CreateWindow_Depth: cint;
   CreateWindow_Visual: PVisual;
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+  XInput2EventMask: TXIEventMask;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+  selected_im_style: TXIMStyle = 0;
+  im_event_mask: clong = 0;
+
+  function IMStyleToStr(style: TXIMStyle): string;
+  begin
+    Result := '';
+    if (style and XIMPreeditArea) <> 0 then
+      Result := Result + ' XIMPreeditArea';
+    if (style and XIMPreeditCallbacks) <> 0 then
+      Result := Result + ' XIMPreeditCallbacks';
+    if (style and XIMPreeditPosition) <> 0 then
+      Result := Result + ' XIMPreeditPosition';
+    if (style and XIMPreeditNothing) <> 0 then
+      Result := Result + ' XIMPreeditNothing';
+    if (style and XIMPreeditNone) <> 0 then
+      Result := Result + ' XIMPreeditNone';
+    if (style and XIMStatusArea) <> 0 then
+      Result := Result + ' XIMStatusArea';
+    if (style and XIMStatusCallbacks) <> 0 then
+      Result := Result + ' XIMStatusCallbacks';
+    if (style and XIMStatusNothing) <> 0 then
+      Result := Result + ' XIMStatusNothing';
+    if (style and XIMStatusNone) <> 0 then
+      Result := Result + ' XIMStatusNone';
+    if Length(Result) > 0 then
+      Delete(Result, 1, 1);
+    Result := IntToStr(style) + ' (' + Result + ')';
+  end;
+
+  procedure TryCreateIM;
+  const
+    PreferredStyle = XIMPreeditNothing or XIMStatusNothing;
+{    PreferredStyle = XIMPreeditNone or XIMStatusNone;}
+  var
+    im_supported_styles: PXIMStyles;
+    locale_modifiers: PChar;
+    I: Integer;
+  begin
+{    LOG('setting locale');
+    if fpsetlocale(LC_ALL, '') = nil then
+      LOG('set locale failed');}
+
+    { Check if X11 supports the current locale }
+    LOG('checking X11 support for the current locale');
+    if XSupportsLocale = 0 then
+    begin
+      LOG('locale not supported');
+      exit;
+    end;
+    LOG('locale supported');
+
+    LOG('setting locale modifiers');
+    locale_modifiers := XSetLocaleModifiers('@im=none');
+    if locale_modifiers = nil then
+    begin
+      LOG('XSetLocaleModifiers failed');
+    end
+    else
+    begin
+      LOG('XSetLocaleModifiers success; returned', locale_modifiers);
+    end;
+
+    { Open IM }
+    LOG('opening input method');
+    FXIM := XOpenIM(FDisplay, nil, '', '');
+    LOG('input method (ptr)', HexStr(FXIM));
+
+    { Select IM input style }
+    if Assigned(FXIM) then
+    begin
+      LOG('querying the supported input styles');
+      XGetIMValues(FXIM, [XNQueryInputStyle, @im_supported_styles, nil]);
+
+      if Assigned(im_supported_styles) then
+      begin
+        LOG('number of styles', im_supported_styles^.count_styles);
+        for I := 0 to im_supported_styles^.count_styles - 1 do
+        begin
+          LOG('style', IMStyleToStr(im_supported_styles^.supported_styles[I]));
+          if (im_supported_styles^.supported_styles[I] and PreferredStyle) = PreferredStyle then
+            selected_im_style := im_supported_styles^.supported_styles[I];
+        end;
+        XFree(im_supported_styles);
+        LOG('selected style', IMStyleToStr(selected_im_style));
+      end;
+    end;
+  end;
+
+  procedure TryCreateIC;
+  begin
+    if Assigned(FXIM) and (selected_im_style <> 0) then
+    begin
+      LOG('creating input context');
+      FXIC := XCreateIC(FXIM, [XNInputStyle, selected_im_style,
+                               XNClientWindow, FWindow,
+                               XNFocusWindow, FWindow, nil]);
+      LOG('input context (ptr)', HexStr(FXIC));
+
+      if Assigned(FXIC) then
+      begin
+        LOG('setting input context focus');
+        XSetICFocus(FXIC);
+
+        LOG('getting the IM event mask');
+        XGetICValues(FXIC, [XNFilterEvents, @im_event_mask, nil]);
+        LOG('IM event mask', im_event_mask);
+      end;
+    end;
+  end;
+
 begin
   FHeight := AHeight;
   FWidth := AWidth;
@@ -82,6 +236,10 @@ begin
   BlackColor.green := 0;
   BlackColor.blue := 0;
 
+  { Try to open an input method }
+  if PTC_X11_TRY_XIM in FFlags then
+    TryCreateIM;
+
   { Create the mode switcher object }
   if (FModeSwitcher = Nil) and FFullScreen then
     FModeSwitcher := CreateModeSwitcher;
@@ -205,13 +363,40 @@ begin
     if e._type = MapNotify then
       Break;
   until False;
+
+  { Try to create an input context for the input method }
+  if PTC_X11_TRY_XIM in FFlags then
+    TryCreateIC;
+
   { Get keyboard input and sync }
   XSelectInput(FDisplay, FWindow, KeyPressMask or KeyReleaseMask or
                                   StructureNotifyMask or FocusChangeMask or
                                   ButtonPressMask or ButtonReleaseMask or
-                                  PointerMotionMask or ExposureMask);
+                                  PointerMotionMask or ExposureMask or
+                                  EnterWindowMask or LeaveWindowMask or im_event_mask);
   XSync(FDisplay, False);
 
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+  { enable XInput2 raw mouse input for the window as well }
+  if FXInput2Enabled then
+  begin
+    FillChar(XInput2EventMask, SizeOf(XInput2EventMask), 0);
+    XInput2EventMask.deviceid := XIAllMasterDevices;
+
+    XInput2EventMask.mask_len := XIMaskLen(XI_LASTEVENT);
+    XInput2EventMask.mask := AllocMem(XInput2EventMask.mask_len);
+    try
+      XISetMask(XInput2EventMask.mask, XI_RawMotion);
+      XISetMask(XInput2EventMask.mask, XI_RawButtonPress);
+      XISetMask(XInput2EventMask.mask, XI_RawButtonRelease);
+
+      XISelectEvents(FDisplay, RootWindow(FDisplay, FScreen){FWindow}, @XInput2EventMask, 1);
+    finally
+      FreeMem(XInput2EventMask.mask);
+    end;
+  end;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+
   if not (PTC_X11_USE_OPENGL in FFlags) then
   begin
     { Create XImage using factory method }
@@ -267,6 +452,20 @@ begin
   FreeAndNil(FGLXFBConfig);
 {$ENDIF ENABLE_X11_EXTENSION_GLX}
 
+  if Assigned(FXIC) then
+  begin
+    LOG('destroying input context');
+    XDestroyIC(FXIC);
+    FXIC := nil;
+  end;
+
+  if Assigned(FXIM) then
+  begin
+    LOG('closing input method');
+    XCloseIM(FXIM);
+    FXIM := nil;
+  end;
+
   {pthreads?!}
   if FCMap <> 0 then
   begin
@@ -392,6 +591,15 @@ begin
     internal_GrabMouse(FGrabMouse);
 end;
 
+function TX11WindowDisplay.SetRelativeMouseMode(ARelativeMouseMode: Boolean): Boolean;
+begin
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+  if FXInput2Enabled then
+    FRelativeMouseMode := ARelativeMouseMode;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+  Result := ARelativeMouseMode = FRelativeMouseMode;
+end;
+
 procedure TX11WindowDisplay.EnterFullScreen;
 begin
   { try to switch mode }
@@ -480,6 +688,22 @@ var
     before, after: Boolean;
     cstate: TPTCMouseButtonState;
   begin
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+    { if XInput2 is enabled, and we're in relative mouse mode, then don't handle
+    the regular mouse events -> use the XInput2 raw mouse events in this case }
+    if FXInput2Enabled and FRelativeMouseMode then
+      exit;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+    if not FPreviousMousePositionSaved then
+    begin
+      FPreviousMouseX := -1; { -1 indicates relative mouse mode }
+      FPreviousMouseY := -1; { -1 indicates relative mouse mode }
+      FPreviousMouseButtonState := [];
+      PTCMouseButtonState := [];
+    end
+    else
+      PTCMouseButtonState := FPreviousMouseButtonState
+        - [PTCMouseButton1, PTCMouseButton2, PTCMouseButton3, PTCMouseButton4, PTCMouseButton5];
     case e._type of
       MotionNotify: begin
         x := e.xmotion.x;
@@ -498,6 +722,8 @@ var
             Button3: state := state or Button3Mask;
             Button4: state := state or Button4Mask;
             Button5: state := state or Button5Mask;
+            6..Ord(High(TPTCMouseButton))+1:
+              Include(PTCMouseButtonState, TPTCMouseButton((Ord(PTCMouseButton6)-6)+e.xbutton.button));
           end;
         end
         else
@@ -508,6 +734,8 @@ var
             Button3: state := state and (not Button3Mask);
             Button4: state := state and (not Button4Mask);
             Button5: state := state and (not Button5Mask);
+            6..Ord(High(TPTCMouseButton))+1:
+              Exclude(PTCMouseButtonState, TPTCMouseButton((Ord(PTCMouseButton6)-6)+e.xbutton.button));
           end;
         end;
       end;
@@ -515,10 +743,8 @@ var
         raise TPTCError.Create('Internal Error');
     end;
 
-    if (state and Button1Mask) = 0 then
-      PTCMouseButtonState := []
-    else
-      PTCMouseButtonState := [PTCMouseButton1];
+    if (state and Button1Mask) <> 0 then
+      PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton1];
     if (state and Button2Mask) <> 0 then
       PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
     if (state and Button3Mask) <> 0 then
@@ -535,6 +761,12 @@ var
         FPreviousMouseX := x; { first DeltaX will be 0 }
         FPreviousMouseY := y; { first DeltaY will be 0 }
         FPreviousMouseButtonState := [];
+      end
+      { there's a previous mouse state saved, but it was in relative mouse mode? }
+      else if (FPreviousMouseX = -1) or (FPreviousMouseY = -1) then
+      begin
+        FPreviousMouseX := x; { first DeltaX after relative mouse mode will be 0 }
+        FPreviousMouseY := y; { first DeltaY after relative mouse mode will be 0 }
       end;
 
       { movement? }
@@ -581,11 +813,149 @@ var
     FPreviousHeight := e.xconfigure.height;
   end;
 
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+  procedure HandleXInput2RawEvent(const xi2e: TXIRawEvent);
+  var
+    I: Integer;
+    MovementXAccelerated: cdouble = 0;
+    MovementXRaw: cdouble = 0;
+    MovementXRawInt: Integer = 0;
+    MovementXAvailable: Boolean = False;
+    MovementYAccelerated: cdouble = 0;
+    MovementYRaw: cdouble = 0;
+    MovementYRawInt: Integer = 0;
+    MovementYAvailable: Boolean = False;
+    valptr, rawptr: Pcdouble;
+    PTCMouseButtonState: TPTCMouseButtonState;
+
+    button: TPTCMouseButton;
+    before, after: Boolean;
+    cstate: TPTCMouseButtonState;
+  begin
+{    Writeln(xi2e.evtype, ' ', xi2e.detail);
+    valptr := xi2e.valuators.values;
+    rawptr := xi2e.raw_values;
+    for I := 0 to xi2e.valuators.mask_len*8 - 1 do
+      if XIMaskIsSet(xi2e.valuators.mask, I) then
+      begin
+        Writeln('Valuator ', I, ' value=', valptr^:0:50, ' raw=', rawptr^:0:50);
+        Inc(valptr);
+        Inc(rawptr);
+      end;}
+
+    { when not in relative mouse mode, we use the regular X11 mouse events }
+    if not FRelativeMouseMode then
+      exit;
+
+    if not FPreviousMousePositionSaved then
+    begin
+      FPreviousMouseX := -1; { -1 indicates relative mouse mode }
+      FPreviousMouseY := -1; { -1 indicates relative mouse mode }
+      FPreviousMouseButtonState := [];
+    end;
+
+    if (xi2e.evtype = XI_RawButtonPress) or (xi2e.evtype = XI_RawButtonRelease) then
+    begin
+      PTCMouseButtonState := FPreviousMouseButtonState;
+      if xi2e.evtype = XI_RawButtonPress then
+        case xi2e.detail of
+          Button1: PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton1];
+          Button2: PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton3];
+          Button3: PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton2];
+          Button4: PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton4];
+          Button5: PTCMouseButtonState := PTCMouseButtonState + [PTCMouseButton5];
+          6..Ord(High(TPTCMouseButton))+1:
+            Include(PTCMouseButtonState, TPTCMouseButton((Ord(PTCMouseButton6)-6)+xi2e.detail));
+        end
+      else
+        case xi2e.detail of
+          Button1: PTCMouseButtonState := PTCMouseButtonState - [PTCMouseButton1];
+          Button2: PTCMouseButtonState := PTCMouseButtonState - [PTCMouseButton3];
+          Button3: PTCMouseButtonState := PTCMouseButtonState - [PTCMouseButton2];
+          Button4: PTCMouseButtonState := PTCMouseButtonState - [PTCMouseButton4];
+          Button5: PTCMouseButtonState := PTCMouseButtonState - [PTCMouseButton5];
+          6..Ord(High(TPTCMouseButton))+1:
+            Exclude(PTCMouseButtonState, TPTCMouseButton((Ord(PTCMouseButton6)-6)+xi2e.detail));
+        end;
+    end
+    else
+      PTCMouseButtonState := FPreviousMouseButtonState;
+
+    if xi2e.valuators.mask_len > 0 then
+    begin
+      valptr := xi2e.valuators.values;
+      rawptr := xi2e.raw_values;
+      if XIMaskIsSet(xi2e.valuators.mask, 0) then
+      begin
+        MovementXAccelerated := valptr^;
+        MovementXRaw := rawptr^;
+        MovementXRawInt := Round(MovementXRaw);
+        MovementXAvailable := True;
+        Inc(valptr);
+        Inc(rawptr);
+      end;
+      if XIMaskIsSet(xi2e.valuators.mask, 1) then
+      begin
+        MovementYAccelerated := valptr^;
+        MovementYRaw := rawptr^;
+        MovementYRawInt := Round(MovementYRaw);
+        MovementYAvailable := True;
+        Inc(valptr);
+        Inc(rawptr);
+      end;
+    end;
+
+    { movement? }
+    if (MovementXRawInt <> 0) or (MovementYRawInt <> 0) then
+      FEventQueue.AddEvent(TPTCMouseEvent.Create(-1, -1, MovementXRawInt, MovementYRawInt, FPreviousMouseButtonState));
+
+    { button presses/releases? }
+    cstate := FPreviousMouseButtonState;
+    for button := Low(button) to High(button) do
+    begin
+      before := button In FPreviousMouseButtonState;
+      after := button In PTCMouseButtonState;
+      if after and (not before) then
+      begin
+        { button was pressed }
+        cstate := cstate + [button];
+        FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(-1, -1, 0, 0, cstate, True, button));
+      end
+      else
+        if before and (not after) then
+        begin
+          { button was released }
+          cstate := cstate - [button];
+          FEventQueue.AddEvent(TPTCMouseButtonEvent.Create(-1, -1, 0, 0, cstate, False, button));
+        end;
+    end;
+
+    FPreviousMouseX := -1;
+    FPreviousMouseY := -1;
+    FPreviousMouseButtonState := PTCMouseButtonState;
+    FPreviousMousePositionSaved := True;
+  end;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+
+var
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+  XInput2Event: PXIDeviceEvent;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
+  eaten_by_im: Boolean = False;
 begin
   NewFocusSpecified := False;
   while UsefulEventsPending do
   begin
     XNextEvent(FDisplay, @e);
+    { maybe send the event to the Input Method for processing. Only non-key
+      events are sent here (key events are sent in HandleKeyEvent instead) }
+    if Assigned(FXIM) and Assigned(FXIC) and
+      (e._type <> KeyPress) and (e._type <> KeyRelease) then
+    begin
+      eaten_by_im := XFilterEvent(@e, FWindow);
+      if eaten_by_im then
+        exit;
+    end;
     case e._type of
       FocusIn: begin
         NewFocus := True;
@@ -609,6 +979,30 @@ begin
       ConfigureNotify: HandleConfigureNotifyEvent;
       KeyPress, KeyRelease: HandleKeyEvent(e.xkey);
       ButtonPress, ButtonRelease, MotionNotify: HandleMouseEvent;
+      EnterNotify: begin
+        { clear the high (>=6) numbered mouse buttons, because the mouse events contain no state information for them }
+        FPreviousMouseButtonState := FPreviousMouseButtonState
+          * [PTCMouseButton1, PTCMouseButton2, PTCMouseButton3, PTCMouseButton4, PTCMouseButton5];
+      end;
+{$IFDEF ENABLE_X11_EXTENSION_XINPUT2}
+      GenericEvent: begin
+        if e.xcookie.extension = FXInput2MajorOpCode then
+        begin
+          if XGetEventData(FDisplay, @e.xcookie) then
+            try
+              XInput2Event := e.xcookie.data;
+              case XInput2Event^.evtype of
+                XI_RawButtonPress,
+                XI_RawButtonRelease,
+                XI_RawMotion:
+                  HandleXInput2RawEvent(PXIRawEvent(XInput2Event)^);
+              end;
+            finally
+              XFreeEventData(FDisplay, @e.xcookie);
+            end;
+        end;
+      end;
+{$ENDIF ENABLE_X11_EXTENSION_XINPUT2}
     end;
   end;
   if NewFocusSpecified then
@@ -618,6 +1012,14 @@ begin
     internal_GrabMouse(FGrabMouse);
 end;
 
+function TX11WindowDisplay.MoveMouseTo(X, Y: Integer): Boolean;
+begin
+  if not FOpen or (X < 0) or (Y < 0) or (X >= FWidth) or (Y >= FHeight) then
+    exit(False);
+  XWarpPointer(FDisplay, None, FWindow, 0, 0, 0, 0, X, Y);
+  Result := True;
+end;
+
 procedure TX11WindowDisplay.Draw;
 begin
   if not (PTC_X11_USE_OPENGL in FFlags) then
diff --git a/packages/ptc/tests/crtkeys/crtkeys.pas b/packages/ptc/tests/crtkeys/crtkeys.pas
new file mode 100644
index 0000000000..d933bbb763
--- /dev/null
+++ b/packages/ptc/tests/crtkeys/crtkeys.pas
@@ -0,0 +1,19 @@
+program crtkeys;
+uses
+  crt;
+var
+  Ch, Ex: Char;
+  Done: Boolean;
+begin
+  Done := False;
+  repeat
+    Ch := ReadKey;
+    if Ch = #0 then
+      Ex := ReadKey
+    else
+      Ex := #0;
+    Writeln(Ord(Ch), ' ', Ord(Ex));
+    if Ch = 'q' then
+      Done := True;
+  until Done;
+end.
diff --git a/packages/ptc/tests/crtkeys/crtkeys_fpwincrt.txt b/packages/ptc/tests/crtkeys/crtkeys_fpwincrt.txt
new file mode 100644
index 0000000000..124ededad7
--- /dev/null
+++ b/packages/ptc/tests/crtkeys/crtkeys_fpwincrt.txt
@@ -0,0 +1,124 @@
+Test results from the Win32 crt unit (from FPC 3.0.2), run under 32-bit Windows 7, US keyboard:
+
+Ctrl in the table means: Ctrl or Ctrl+Shift
+Alt in the table means: Alt or Alt+Shift or Alt+Ctrl or Alt+Ctrl+Shift
+
+key                |  -  |Shift|Ctrl |Alt  |NumLk|NumLk|NumLk|NumLk|
+                   |     |     |     |     |     |Shift|Ctrl |Alt  |
+-------------------+-----+-----+-----+-----+-----+-----+-----+-----+
+Esc                |27 0 |27 0 |*WIN*|*WIN*|27 0 |27 0 |*WIN*|*WIN*|
+F1                 |0 59 |0 84 |0 94 |0 104|0 59 |0 84 |0 94 |0 104|
+F2                 |0 60 |0 85 |0 95 |0 105|0 60 |0 85 |0 95 |0 105|
+F3                 |0 61 |0 86 |0 96 |0 106|0 61 |0 86 |0 96 |0 106|
+F4                 |0 62 |0 87 |0 97 |0 107|0 62 |0 87 |0 97 |0 107|
+F5                 |0 63 |0 88 |0 98 |0 108|0 63 |0 88 |0 98 |0 108|
+F6                 |0 64 |0 89 |0 99 |0 109|0 64 |0 89 |0 99 |0 109|
+F7                 |0 65 |0 90 |0 100|0 110|0 65 |0 90 |0 100|0 110|
+F8                 |0 66 |0 91 |0 101|0 111|0 66 |0 91 |0 101|0 111|
+F9                 |0 67 |0 92 |0 102|0 112|0 67 |0 92 |0 102|0 112|
+F10                |0 68 |0 93 |0 103|0 113|0 68 |0 93 |0 103|0 113|
+F11                |0 133|0 135|0 137|0 139|0 133|0 135|0 137|0 139|
+F12                |0 134|0 136|0 138|0 140|0 134|0 136|0 138|0 140|
+Print Screen/SysRq |     |     |     |     |     |     |     |     |
+Scroll Lock        |     |     |*BRK*|     |     |     |*BRK*|     |
+Pause/Break        |     |     |*BRK*|     |     |     |*BRK*|     |
+`                  |96 0 |126 0|0 41 |0 41 |96 0 |126 0|0 41 |0 41 |
+1                  |49 0 |33 0 |0 2  |0 120|49 0 |33 0 |0 2  |0 120|
+2                  |50 0 |64 0 |0 3  |0 121|50 0 |64 0 |0 3  |0 121|
+3                  |51 0 |35 0 |0 4  |0 122|51 0 |35 0 |0 4  |0 122|
+4                  |52 0 |36 0 |0 5  |0 123|52 0 |36 0 |0 5  |0 123|
+5                  |53 0 |37 0 |0 6  |0 124|53 0 |37 0 |0 6  |0 124|
+6                  |54 0 |94 0 |0 7  |0 125|54 0 |94 0 |0 7  |0 125|
+7                  |55 0 |38 0 |0 8  |0 126|55 0 |38 0 |0 8  |0 126|
+8                  |56 0 |42 0 |0 9  |0 127|56 0 |42 0 |0 9  |0 127|
+9                  |57 0 |40 0 |0 10 |0 128|57 0 |40 0 |0 10 |0 128|
+0                  |48 0 |41 0 |0 11 |0 129|48 0 |41 0 |0 11 |0 129|
+-                  |45 0 |95 0 |0 12 |0 130|45 0 |95 0 |0 12 |0 130|
+=                  |61 0 |43 0 |0 13 |0 131|61 0 |43 0 |0 13 |0 131|
+<- Backspace       |8 0  |8 0  |127 0|0 14 |8 0  |8 0  |127 0|0 14 |
+Tab                |9 0  |0 15 |0 148|*WIN*|9 0  |0 15 |0 148|*WIN*|
+q                  |113 0|81 0 |17 0 |0 16 |113 0|81 0 |17 0 |0 16 |
+w                  |119 0|87 0 |23 0 |0 17 |119 0|87 0 |23 0 |0 17 |
+e                  |101 0|69 0 |5 0  |0 18 |101 0|69 0 |5 0  |0 18 |
+r                  |114 0|82 0 |18 0 |0 19 |114 0|82 0 |18 0 |0 19 |
+t                  |116 0|84 0 |20 0 |0 20 |116 0|84 0 |20 0 |0 20 |
+y                  |121 0|89 0 |25 0 |0 21 |121 0|89 0 |25 0 |0 21 |
+u                  |117 0|85 0 |21 0 |0 22 |117 0|85 0 |21 0 |0 22 |
+i                  |105 0|73 0 |9 0  |0 23 |105 0|73 0 |9 0  |0 23 |
+o                  |111 0|79 0 |15 0 |0 24 |111 0|79 0 |15 0 |0 24 |
+p                  |112 0|80 0 |16 0 |0 25 |112 0|80 0 |16 0 |0 25 |
+[                  |91 0 |123 0|27 0 |0 26 |91 0 |123 0|27 0 |0 26 |
+]                  |93 0 |125 0|29 0 |0 27 |93 0 |125 0|29 0 |0 27 |
+\                  |92 0 |124 0|28 0 |0 43 |92 0 |124 0|28 0 |0 43 |
+Caps Lock          |     |     |     |     |     |     |     |     |
+a                  |97 0 |65 0 |1 0  |0 30 |97 0 |65 0 |1 0  |0 30 |
+s                  |115 0|83 0 |PAUSE|0 31 |115 0|83 0 |PAUSE|0 31 |
+d                  |100 0|68 0 |4 0  |0 32 |100 0|68 0 |4 0  |0 32 |
+f                  |102 0|70 0 |6 0  |0 33 |102 0|70 0 |6 0  |0 33 |
+g                  |103 0|71 0 |7 0  |0 34 |103 0|71 0 |7 0  |0 34 |
+h                  |104 0|72 0 |8 0  |0 35 |104 0|72 0 |8 0  |0 35 |
+j                  |106 0|74 0 |10 0 |0 36 |106 0|74 0 |10 0 |0 36 |
+k                  |107 0|75 0 |11 0 |0 37 |107 0|75 0 |11 0 |0 37 |
+l                  |108 0|76 0 |12 0 |0 38 |108 0|76 0 |12 0 |0 38 |
+;                  |59 0 |58 0 |0 39 |0 39 |59 0 |58 0 |0 39 |0 39 |
+'                  |39 0 |34 0 |0 40 |0 40 |39 0 |34 0 |0 40 |0 40 |
+Enter              |13 0 |13 0 |10 0 |*WIN*|13 0 |13 0 |10 0 |*WIN*|
+Left Shift         |     |     |     |     |     |     |     |     |
+z                  |122 0|90 0 |26 0 |0 44 |122 0|90 0 |26 0 |0 44 |
+x                  |120 0|88 0 |24 0 |0 45 |120 0|88 0 |24 0 |0 45 |
+c                  |99 0 |67 0 |*BRK*|0 46 |99 0 |67 0 |*BRK*|0 46 |
+v                  |118 0|86 0 |22 0 |0 47 |118 0|86 0 |22 0 |0 47 |
+b                  |98 0 |66 0 |2 0  |0 48 |98 0 |66 0 |2 0  |0 48 |
+n                  |110 0|78 0 |14 0 |0 49 |110 0|78 0 |14 0 |0 49 |
+m                  |109 0|77 0 |13 0 |0 50 |109 0|77 0 |13 0 |0 50 |
+,                  |44 0 |60 0 |0 51 |0 51 |44 0 |60 0 |0 51 |0 51 |
+.                  |46 0 |62 0 |0 52 |0 52 |46 0 |62 0 |0 52 |0 52 |
+/                  |47 0 |63 0 |0 149|0 164|47 0 |63 0 |0 149|0 164|
+Right Shift        |     |     |     |     |     |     |     |     |
+Left Ctrl          |     |     |     |     |     |     |     |     |
+Left Alt           |     |     |     |     |     |     |     |     |
+Space              |32 0 |32 0 |32 0 |*WIN*|32 0 |32 0 |32 0 |*WIN*|
+Right Alt          |     |     |     |     |     |     |     |     |
+Right Ctrl         |     |     |     |     |     |     |     |     |
+Insert             |0 82 |0 82 |0 146|NUMSC|0 82 |0 82 |0 146|NUMSC|
+Delete             |0 83 |0 83 |0 147|0 163|0 83 |0 83 |0 147|0 163|
+Home               |0 71 |0 71 |0 119|NUMSC|0 71 |0 71 |0 119|NUMSC|
+End                |0 79 |0 79 |0 117|NUMSC|0 79 |0 79 |0 117|NUMSC|
+Page Up            |0 73 |0 73 |0 132|NUMSC|0 73 |0 73 |0 132|NUMSC|
+Page Down          |0 81 |0 81 |0 118|NUMSC|0 81 |0 81 |0 118|NUMSC|
+Up Arrow           |0 72 |0 72 |0 141|NUMSC|0 72 |0 72 |0 141|NUMSC|
+Left Arrow         |0 75 |0 75 |0 115|NUMSC|0 75 |0 75 |0 115|NUMSC|
+Right Arrow        |0 77 |0 77 |0 116|NUMSC|0 77 |0 77 |0 116|NUMSC|
+Down Arrow         |0 80 |0 80 |0 145|NUMSC|0 80 |0 80 |0 145|NUMSC|
+Num Lock           |     |     |     |     |     |     |     |     |
+Num /              |0 53 |0 53 |0 149|0 164|0 53 |0 53 |0 149|0 164|
+Num *              |42 0 |42 0 |0 150|0 55 |42 0 |42 0 |0 150|0 55 |
+Num -              |45 0 |45 0 |0 142|0 74 |45 0 |45 0 |0 142|0 74 |
+Num +              |43 0 |43 0 |0 78 |0 78 |43 0 |43 0 |0 78 |0 78 |
+Num Enter          |13 0 |13 0 |10 0 |*WIN*|13 0 |13 0 |10 0 |*WIN*|
+Num 0/Ins          |0 82 |0 82 |0 146|NUMSC|48 0 |0 82 |0 146|NUMSC|
+Num ./Del          |0 83 |0 83 |0 147|0 163|46 0 |0 83 |0 147|0 163|
+Num 1/End          |0 79 |0 79 |0 117|NUMSC|49 0 |0 79 |0 117|NUMSC|
+Num 2/Down Arrow   |0 80 |0 80 |0 145|NUMSC|50 0 |0 80 |0 145|NUMSC|
+Num 3/PgDn         |0 81 |0 81 |0 118|NUMSC|51 0 |0 81 |0 118|NUMSC|
+Num 4/Left Arrow   |0 75 |0 75 |0 115|NUMSC|52 0 |0 75 |0 115|NUMSC|
+Num 5              |0 76 |0 76 |0 143|NUMSC|53 0 |0 76 |0 143|NUMSC|
+Num 6/Right Arrow  |0 77 |0 77 |0 116|NUMSC|54 0 |0 77 |0 116|NUMSC|
+Num 7/Home         |0 71 |0 71 |0 119|NUMSC|55 0 |0 71 |0 119|NUMSC|
+Num 8/Up Arrow     |0 72 |0 72 |0 141|NUMSC|56 0 |0 72 |0 141|NUMSC|
+Num 9/PgUp         |0 73 |0 73 |0 132|NUMSC|57 0 |0 73 |0 132|NUMSC|
+
+
+Special:
+  Ctrl+Shift+6: 30 0
+  Ctrl+Shift+-: 31 0
+  Ctrl+Shift+Backspace: 0 14
+  Ctrl+Shift+Space: 0 57
+  Alt+Ctrl+Space: 0 57
+  Alt+Ctrl+Shift+Space: 0 57
+  Alt+Ctrl+Enter: 0 166
+  Alt+Ctrl+Shift+Enter: 0 166
+
+*WIN* = Windows special key
+*BRK* = Ctrl+Break
+NUMSC = Numeric ASCII entry
diff --git a/packages/ptc/tests/crtkeys/crtkeys_go32v2.txt b/packages/ptc/tests/crtkeys/crtkeys_go32v2.txt
new file mode 100644
index 0000000000..7b3f779d38
--- /dev/null
+++ b/packages/ptc/tests/crtkeys/crtkeys_go32v2.txt
@@ -0,0 +1,117 @@
+Test results from the GO32V2 crt unit, run under DOS, on a PS/2 Model 76, 101-key US keyboard:
+
+Ctrl in the table means: Ctrl or Ctrl+Shift
+Alt in the table means: Alt or Alt+Shift or Alt+Ctrl or Alt+Ctrl+Shift
+
+key                |  -  |Shift|Ctrl |Alt  |NumLk|NumLk|NumLk|NumLk|
+                   |     |     |     |     |     |Shift|Ctrl |Alt  |
+-------------------+-----+-----+-----+-----+-----+-----+-----+-----+
+Esc                |27 0 |27 0 |27 0 |0 1  |27 0 |27 0 |27 0 |0 1  |
+F1                 |0 59 |0 84 |0 94 |0 104|0 59 |0 84 |0 94 |0 104|
+F2                 |0 60 |0 85 |0 95 |0 105|0 60 |0 85 |0 95 |0 105|
+F3                 |0 61 |0 86 |0 96 |0 106|0 61 |0 86 |0 96 |0 106|
+F4                 |0 62 |0 87 |0 97 |0 107|0 62 |0 87 |0 97 |0 107|
+F5                 |0 63 |0 88 |0 98 |0 108|0 63 |0 88 |0 98 |0 108|
+F6                 |0 64 |0 89 |0 99 |0 109|0 64 |0 89 |0 99 |0 109|
+F7                 |0 65 |0 90 |0 100|0 110|0 65 |0 90 |0 100|0 110|
+F8                 |0 66 |0 91 |0 101|0 111|0 66 |0 91 |0 101|0 111|
+F9                 |0 67 |0 92 |0 102|0 112|0 67 |0 92 |0 102|0 112|
+F10                |0 68 |0 93 |0 103|0 113|0 68 |0 93 |0 103|0 113|
+F11                |0 133|0 135|0 137|0 139|0 133|0 135|0 137|0 139|
+F12                |0 134|0 136|0 138|0 140|0 134|0 136|0 138|0 140|
+Print Screen/SysRq |     |     |0 114|     |     |     |0 114|     |
+Scroll Lock        |     |     |     |     |     |     |     |     |
+Pause/Break        |     |     |*BRK*|     |     |     |*BRK*|     |
+`                  |96 0 |126 0|     |0 41 |96 0 |126 0|     |0 41 |
+1                  |49 0 |33 0 |     |0 120|49 0 |33 0 |     |0 120|
+2                  |50 0 |64 0 |0 3  |0 121|50 0 |64 0 |0 3  |0 121|
+3                  |51 0 |35 0 |     |0 122|51 0 |35 0 |     |0 122|
+4                  |52 0 |36 0 |     |0 123|52 0 |36 0 |     |0 123|
+5                  |53 0 |37 0 |     |0 124|53 0 |37 0 |     |0 124|
+6                  |54 0 |94 0 |30 0 |0 125|54 0 |94 0 |30 0 |0 125|
+7                  |55 0 |38 0 |     |0 126|55 0 |38 0 |     |0 126|
+8                  |56 0 |42 0 |     |0 127|56 0 |42 0 |     |0 127|
+9                  |57 0 |40 0 |     |0 128|57 0 |40 0 |     |0 128|
+0                  |48 0 |41 0 |     |0 129|48 0 |41 0 |     |0 129|
+-                  |45 0 |95 0 |31 0 |0 130|45 0 |95 0 |31 0 |0 130|
+=                  |61 0 |43 0 |     |0 131|61 0 |43 0 |     |0 131|
+<- Backspace       |8 0  |8 0  |127 0|0 14 |8 0  |8 0  |127 0|0 14 |
+Tab                |9 0  |0 15 |0 148|0 165|9 0  |0 15 |0 148|0 165|
+q                  |113 0|81 0 |17 0 |0 16 |113 0|81 0 |17 0 |0 16 |
+w                  |119 0|87 0 |23 0 |0 17 |119 0|87 0 |23 0 |0 17 |
+e                  |101 0|69 0 |5 0  |0 18 |101 0|69 0 |5 0  |0 18 |
+r                  |114 0|82 0 |18 0 |0 19 |114 0|82 0 |18 0 |0 19 |
+t                  |116 0|84 0 |20 0 |0 20 |116 0|84 0 |20 0 |0 20 |
+y                  |121 0|89 0 |25 0 |0 21 |121 0|89 0 |25 0 |0 21 |
+u                  |117 0|85 0 |21 0 |0 22 |117 0|85 0 |21 0 |0 22 |
+i                  |105 0|73 0 |9 0  |0 23 |105 0|73 0 |9 0  |0 23 |
+o                  |111 0|79 0 |15 0 |0 24 |111 0|79 0 |15 0 |0 24 |
+p                  |112 0|80 0 |16 0 |0 25 |112 0|80 0 |16 0 |0 25 |
+[                  |91 0 |123 0|27 0 |0 26 |91 0 |123 0|27 0 |0 26 |
+]                  |93 0 |125 0|29 0 |0 27 |93 0 |125 0|29 0 |0 27 |
+\                  |92 0 |124 0|28 0 |0 43 |92 0 |124 0|28 0 |0 43 |
+Caps Lock          |     |     |     |     |     |     |     |     |
+a                  |97 0 |65 0 |1 0  |0 30 |97 0 |65 0 |1 0  |0 30 |
+s                  |115 0|83 0 |19 0 |0 31 |115 0|83 0 |19 0 |0 31 |
+d                  |100 0|68 0 |4 0  |0 32 |100 0|68 0 |4 0  |0 32 |
+f                  |102 0|70 0 |6 0  |0 33 |102 0|70 0 |6 0  |0 33 |
+g                  |103 0|71 0 |7 0  |0 34 |103 0|71 0 |7 0  |0 34 |
+h                  |104 0|72 0 |8 0  |0 35 |104 0|72 0 |8 0  |0 35 |
+j                  |106 0|74 0 |10 0 |0 36 |106 0|74 0 |10 0 |0 36 |
+k                  |107 0|75 0 |11 0 |0 37 |107 0|75 0 |11 0 |0 37 |
+l                  |108 0|76 0 |12 0 |0 38 |108 0|76 0 |12 0 |0 38 |
+;                  |59 0 |58 0 |     |0 39 |59 0 |58 0 |     |0 39 |
+'                  |39 0 |34 0 |     |0 40 |39 0 |34 0 |     |0 40 |
+Enter              |13 0 |13 0 |10 0 |0 28 |13 0 |13 0 |10 0 |0 28 |
+Left Shift         |     |     |     |     |     |     |     |     |
+z                  |122 0|90 0 |26 0 |0 44 |122 0|90 0 |26 0 |0 44 |
+x                  |120 0|88 0 |24 0 |0 45 |120 0|88 0 |24 0 |0 45 |
+c                  |99 0 |67 0 |3 0  |0 46 |99 0 |67 0 |3 0  |0 46 |
+v                  |118 0|86 0 |22 0 |0 47 |118 0|86 0 |22 0 |0 47 |
+b                  |98 0 |66 0 |2 0  |0 48 |98 0 |66 0 |2 0  |0 48 |
+n                  |110 0|78 0 |14 0 |0 49 |110 0|78 0 |14 0 |0 49 |
+m                  |109 0|77 0 |13 0 |0 50 |109 0|77 0 |13 0 |0 50 |
+,                  |44 0 |60 0 |     |0 51 |44 0 |60 0 |     |0 51 |
+.                  |46 0 |62 0 |     |0 52 |46 0 |62 0 |     |0 52 |
+/                  |47 0 |63 0 |     |0 53 |47 0 |63 0 |     |0 53 |
+Right Shift        |     |     |     |     |     |     |     |     |
+Left Ctrl          |     |     |     |     |     |     |     |     |
+Left Alt           |     |     |     |     |     |     |     |     |
+Space              |32 0 |32 0 |32 0 |32 0 |32 0 |32 0 |32 0 |32 0 |
+Right Alt          |     |     |     |     |     |     |     |     |
+Right Ctrl         |     |     |     |     |     |     |     |     |
+Insert             |0 82 |0 82 |0 146|0 162|0 82 |0 82 |0 146|0 162|
+Delete             |0 83 |0 83 |0 147|0 163|0 83 |0 83 |0 147|0 163|
+Home               |0 71 |0 71 |0 119|0 151|0 71 |0 71 |0 119|0 151|
+End                |0 79 |0 79 |0 117|0 159|0 79 |0 79 |0 117|0 159|
+Page Up            |0 73 |0 73 |0 132|0 153|0 73 |0 73 |0 132|0 153|
+Page Down          |0 81 |0 81 |0 118|0 161|0 81 |0 81 |0 118|0 161|
+Up Arrow           |0 72 |0 72 |0 141|0 152|0 72 |0 72 |0 141|0 152|
+Left Arrow         |0 75 |0 75 |0 115|0 155|0 75 |0 75 |0 115|0 155|
+Right Arrow        |0 77 |0 77 |0 116|0 157|0 77 |0 77 |0 116|0 157|
+Down Arrow         |0 80 |0 80 |0 145|0 160|0 80 |0 80 |0 145|0 160|
+Num Lock           |     |     |     |     |     |     |     |     |
+Num /              |47 0 |47 0 |0 149|0 164|47 0 |47 0 |0 149|0 164|
+Num *              |42 0 |42 0 |0 150|0 55 |42 0 |42 0 |0 150|0 55 |
+Num -              |45 0 |45 0 |0 142|0 74 |45 0 |45 0 |0 142|0 74 |
+Num +              |43 0 |43 0 |0 144|0 78 |43 0 |43 0 |0 144|0 78 |
+Num Enter          |13 0 |13 0 |10 0 |0 166|13 0 |13 0 |10 0 |0 166|
+Num 0/Ins          |0 82 |48 0 |0 146|NUMSC|48 0 |0 82 |0 146|NUMSC|
+Num ./Del          |0 83 |46 0 |0 147|     |46 0 |0 83 |0 147|     |
+Num 1/End          |0 79 |49 0 |0 117|NUMSC|49 0 |0 79 |0 117|NUMSC|
+Num 2/Down Arrow   |0 80 |50 0 |0 145|NUMSC|50 0 |0 80 |0 145|NUMSC|
+Num 3/PgDn         |0 81 |51 0 |0 118|NUMSC|51 0 |0 81 |0 118|NUMSC|
+Num 4/Left Arrow   |0 75 |52 0 |0 115|NUMSC|52 0 |0 75 |0 115|NUMSC|
+Num 5              |0 76 |53 0 |0 143|NUMSC|53 0 |0 76 |0 143|NUMSC|
+Num 6/Right Arrow  |0 77 |54 0 |0 116|NUMSC|54 0 |0 77 |0 116|NUMSC|
+Num 7/Home         |0 71 |55 0 |0 119|NUMSC|55 0 |0 71 |0 119|NUMSC|
+Num 8/Up Arrow     |0 72 |56 0 |0 141|NUMSC|56 0 |0 72 |0 141|NUMSC|
+Num 9/PgUp         |0 73 |57 0 |0 132|NUMSC|57 0 |0 73 |0 132|NUMSC|
+
+
+Special:
+  Ctrl+Alt+Caps or Ctrl+Alt+Shift+Caps: 0 64
+  Ctrl+Alt+Del or Ctrl+Alt+Shift+Del: reboot
+
+*BRK* = Ctrl+Break
+NUMSC = Numeric ASCII entry
diff --git a/packages/ptc/tests/crtkeys/crtkeys_tp7.txt b/packages/ptc/tests/crtkeys/crtkeys_tp7.txt
new file mode 100644
index 0000000000..c021f4750f
--- /dev/null
+++ b/packages/ptc/tests/crtkeys/crtkeys_tp7.txt
@@ -0,0 +1,116 @@
+Test results from the Turbo Pascal 7 crt unit, run under DOS, on a PS/2 Model 76, 101-key US keyboard:
+
+Ctrl in the table means: Ctrl or Ctrl+Shift
+Alt in the table means: Alt or Alt+Shift or Alt+Ctrl or Alt+Ctrl+Shift
+
+key                |  -  |Shift|Ctrl |Alt  |NumLk|NumLk|NumLk|NumLk|
+                   |     |     |     |     |     |Shift|Ctrl |Alt  |
+-------------------+-----+-----+-----+-----+-----+-----+-----+-----+
+Esc                |27 0 |27 0 |27 0 |     |27 0 |27 0 |27 0 |     |
+F1                 |0 59 |0 84 |0 94 |0 104|0 59 |0 84 |0 94 |0 104|
+F2                 |0 60 |0 85 |0 95 |0 105|0 60 |0 85 |0 95 |0 105|
+F3                 |0 61 |0 86 |0 96 |0 106|0 61 |0 86 |0 96 |0 106|
+F4                 |0 62 |0 87 |0 97 |0 107|0 62 |0 87 |0 97 |0 107|
+F5                 |0 63 |0 88 |0 98 |0 108|0 63 |0 88 |0 98 |0 108|
+F6                 |0 64 |0 89 |0 99 |0 109|0 64 |0 89 |0 99 |0 109|
+F7                 |0 65 |0 90 |0 100|0 110|0 65 |0 90 |0 100|0 110|
+F8                 |0 66 |0 91 |0 101|0 111|0 66 |0 91 |0 101|0 111|
+F9                 |0 67 |0 92 |0 102|0 112|0 67 |0 92 |0 102|0 112|
+F10                |0 68 |0 93 |0 103|0 113|0 68 |0 93 |0 103|0 113|
+F11                |     |     |     |     |     |     |     |     |
+F12                |     |     |     |     |     |     |     |     |
+Print Screen/SysRq |     |     |0 114|     |     |     |0 114|     |
+Scroll Lock        |     |     |     |     |     |     |     |     |
+Pause/Break        |     |     |*BRK*|     |     |     |*BRK*|     |
+`                  |96 0 |126 0|     |     |96 0 |126 0|     |     |
+1                  |49 0 |33 0 |     |0 120|49 0 |33 0 |     |0 120|
+2                  |50 0 |64 0 |0 3  |0 121|50 0 |64 0 |0 3  |0 121|
+3                  |51 0 |35 0 |     |0 122|51 0 |35 0 |     |0 122|
+4                  |52 0 |36 0 |     |0 123|52 0 |36 0 |     |0 123|
+5                  |53 0 |37 0 |     |0 124|53 0 |37 0 |     |0 124|
+6                  |54 0 |94 0 |30 0 |0 125|54 0 |94 0 |30 0 |0 125|
+7                  |55 0 |38 0 |     |0 126|55 0 |38 0 |     |0 126|
+8                  |56 0 |42 0 |     |0 127|56 0 |42 0 |     |0 127|
+9                  |57 0 |40 0 |     |0 128|57 0 |40 0 |     |0 128|
+0                  |48 0 |41 0 |     |0 129|48 0 |41 0 |     |0 129|
+-                  |45 0 |95 0 |31 0 |0 130|45 0 |95 0 |31 0 |0 130|
+=                  |61 0 |43 0 |     |0 131|61 0 |43 0 |     |0 131|
+<- Backspace       |8 0  |8 0  |127 0|     |8 0  |8 0  |127 0|     |
+Tab                |9 0  |0 15 |     |     |9 0  |0 15 |     |     |
+q                  |113 0|81 0 |17 0 |0 16 |113 0|81 0 |17 0 |0 16 |
+w                  |119 0|87 0 |23 0 |0 17 |119 0|87 0 |23 0 |0 17 |
+e                  |101 0|69 0 |5 0  |0 18 |101 0|69 0 |5 0  |0 18 |
+r                  |114 0|82 0 |18 0 |0 19 |114 0|82 0 |18 0 |0 19 |
+t                  |116 0|84 0 |20 0 |0 20 |116 0|84 0 |20 0 |0 20 |
+y                  |121 0|89 0 |25 0 |0 21 |121 0|89 0 |25 0 |0 21 |
+u                  |117 0|85 0 |21 0 |0 22 |117 0|85 0 |21 0 |0 22 |
+i                  |105 0|73 0 |9 0  |0 23 |105 0|73 0 |9 0  |0 23 |
+o                  |111 0|79 0 |15 0 |0 24 |111 0|79 0 |15 0 |0 24 |
+p                  |112 0|80 0 |16 0 |0 25 |112 0|80 0 |16 0 |0 25 |
+[                  |91 0 |123 0|27 0 |     |91 0 |123 0|27 0 |     |
+]                  |93 0 |125 0|29 0 |     |93 0 |125 0|29 0 |     |
+\                  |92 0 |124 0|28 0 |     |92 0 |124 0|28 0 |     |
+Caps Lock          |     |     |     |     |     |     |     |     |
+a                  |97 0 |65 0 |1 0  |0 30 |97 0 |65 0 |1 0  |0 30 |
+s                  |115 0|83 0 |19 0 |0 31 |115 0|83 0 |19 0 |0 31 |
+d                  |100 0|68 0 |4 0  |0 32 |100 0|68 0 |4 0  |0 32 |
+f                  |102 0|70 0 |6 0  |0 33 |102 0|70 0 |6 0  |0 33 |
+g                  |103 0|71 0 |7 0  |0 34 |103 0|71 0 |7 0  |0 34 |
+h                  |104 0|72 0 |8 0  |0 35 |104 0|72 0 |8 0  |0 35 |
+j                  |106 0|74 0 |10 0 |0 36 |106 0|74 0 |10 0 |0 36 |
+k                  |107 0|75 0 |11 0 |0 37 |107 0|75 0 |11 0 |0 37 |
+l                  |108 0|76 0 |12 0 |0 38 |108 0|76 0 |12 0 |0 38 |
+;                  |59 0 |58 0 |     |     |59 0 |58 0 |     |     |
+'                  |39 0 |34 0 |     |     |39 0 |34 0 |     |     |
+Enter              |13 0 |13 0 |10 0 |     |13 0 |13 0 |10 0 |     |
+Left Shift         |     |     |     |     |     |     |     |     |
+z                  |122 0|90 0 |26 0 |0 44 |122 0|90 0 |26 0 |0 44 |
+x                  |120 0|88 0 |24 0 |0 45 |120 0|88 0 |24 0 |0 45 |
+c                  |99 0 |67 0 |3 0  |0 46 |99 0 |67 0 |3 0  |0 46 |
+v                  |118 0|86 0 |22 0 |0 47 |118 0|86 0 |22 0 |0 47 |
+b                  |98 0 |66 0 |2 0  |0 48 |98 0 |66 0 |2 0  |0 48 |
+n                  |110 0|78 0 |14 0 |0 49 |110 0|78 0 |14 0 |0 49 |
+m                  |109 0|77 0 |13 0 |0 50 |109 0|77 0 |13 0 |0 50 |
+,                  |44 0 |60 0 |     |     |44 0 |60 0 |     |     |
+.                  |46 0 |62 0 |     |     |46 0 |62 0 |     |     |
+/                  |47 0 |63 0 |     |     |47 0 |63 0 |     |     |
+Right Shift        |     |     |     |     |     |     |     |     |
+Left Ctrl          |     |     |     |     |     |     |     |     |
+Left Alt           |     |     |     |     |     |     |     |     |
+Space              |32 0 |32 0 |32 0 |32 0 |32 0 |32 0 |32 0 |32 0 |
+Right Alt          |     |     |     |     |     |     |     |     |
+Right Ctrl         |     |     |     |     |     |     |     |     |
+Insert             |0 82 |0 82 |     |     |0 82 |0 82 |     |     |
+Delete             |0 83 |0 83 |     |     |0 83 |0 83 |     |     |
+Home               |0 71 |0 71 |0 119|     |0 71 |0 71 |0 119|     |
+End                |0 79 |0 79 |0 117|     |0 79 |0 79 |0 117|     |
+Page Up            |0 73 |0 73 |0 132|     |0 73 |0 73 |0 132|     |
+Page Down          |0 81 |0 81 |0 118|     |0 81 |0 81 |0 118|     |
+Up Arrow           |0 72 |0 72 |     |     |0 72 |0 72 |     |     |
+Left Arrow         |0 75 |0 75 |0 115|     |0 75 |0 75 |0 115|     |
+Right Arrow        |0 77 |0 77 |0 116|     |0 77 |0 77 |0 116|     |
+Down Arrow         |0 80 |0 80 |     |     |0 80 |0 80 |     |     |
+Num Lock           |     |     |     |     |     |     |     |     |
+Num /              |47 0 |47 0 |     |     |47 0 |47 0 |     |     |
+Num *              |42 0 |42 0 |     |     |42 0 |42 0 |     |     |
+Num -              |45 0 |45 0 |     |     |45 0 |45 0 |     |     |
+Num +              |43 0 |43 0 |     |     |43 0 |43 0 |     |     |
+Num Enter          |13 0 |13 0 |10 0 |     |13 0 |13 0 |10 0 |     |
+Num 0/Ins          |0 82 |48 0 |     |NUMSC|48 0 |0 82 |     |NUMSC|
+Num ./Del          |0 83 |46 0 |     |     |46 0 |0 83 |     |     |
+Num 1/End          |0 79 |49 0 |0 117|NUMSC|49 0 |0 79 |0 117|NUMSC|
+Num 2/Down Arrow   |0 80 |50 0 |     |NUMSC|50 0 |0 80 |     |NUMSC|
+Num 3/PgDn         |0 81 |51 0 |0 118|NUMSC|51 0 |0 81 |0 118|NUMSC|
+Num 4/Left Arrow   |0 75 |52 0 |0 115|NUMSC|52 0 |0 75 |0 115|NUMSC|
+Num 5              |     |53 0 |     |NUMSC|53 0 |     |     |NUMSC|
+Num 6/Right Arrow  |0 77 |54 0 |0 116|NUMSC|54 0 |0 77 |0 116|NUMSC|
+Num 7/Home         |0 71 |55 0 |0 119|NUMSC|55 0 |0 71 |0 119|NUMSC|
+Num 8/Up Arrow     |0 72 |56 0 |     |NUMSC|56 0 |0 72 |     |NUMSC|
+Num 9/PgUp         |0 73 |57 0 |0 132|NUMSC|57 0 |0 73 |0 132|NUMSC|
+
+
+Special:
+  Ctrl+Alt+Del or Ctrl+Alt+Shift+Del: reboot
+
+*BRK* = Ctrl+Break
+NUMSC = Numeric ASCII entry
diff --git a/packages/ptc/tests/crtkeys/ptccrtkeys.pas b/packages/ptc/tests/crtkeys/ptccrtkeys.pas
new file mode 100644
index 0000000000..5f962891cf
--- /dev/null
+++ b/packages/ptc/tests/crtkeys/ptccrtkeys.pas
@@ -0,0 +1,33 @@
+program ptccrtkeys;
+uses
+  ptccrt, ptcgraph;
+var
+  Gd, Gm: Integer;
+  Ch, Ex: Char;
+  Done: Boolean;
+begin
+  Gd := VGA;
+  Gm := VGAHi;
+  InitGraph(Gd, Gm, '');
+  Writeln('startup KeyMode (press ''m'' to switch): ', KeyMode);
+  Done := False;
+  repeat
+    Ch := ReadKey;
+    if Ch = #0 then
+      Ex := ReadKey
+    else
+      Ex := #0;
+    Writeln(Ord(Ch), ' ', Ord(Ex));
+    if Ch = 'm' then
+    begin
+      if KeyMode <> High(KeyMode) then
+        KeyMode := Succ(KeyMode)
+      else
+        KeyMode := Low(KeyMode);
+      Writeln('KeyMode: ', KeyMode);
+    end;
+    if Ch = 'q' then
+      Done := True;
+  until Done;
+  CloseGraph;
+end.
diff --git a/packages/ptc/tests/event.pp b/packages/ptc/tests/event.pp
new file mode 100644
index 0000000000..abc477d14e
--- /dev/null
+++ b/packages/ptc/tests/event.pp
@@ -0,0 +1,122 @@
+program event;
+
+{$MODE objfpc}{$H+}
+
+uses
+  SysUtils, ptc;
+
+function ButtonState2Str(const bs: TPTCMouseButtonState): string;
+var
+  I: TPTCMouseButton;
+begin
+  Result := '';
+  for I in TPTCMouseButton do
+    if I in bs then
+      WriteStr(Result, Result, ',', I);
+  if Result = '' then
+    Result := '[]'
+  else
+  begin
+    Result[1] := '[';
+    Result := Result + ']';
+  end;
+end;
+
+function ModifierKeys2Str(const mk: TPTCModifierKeys): string;
+var
+  I: TPTCModifierKey;
+begin
+  Result := '';
+  for I in TPTCModifierKey do
+    if I in mk then
+      WriteStr(Result, Result, ',', I);
+  if Result = '' then
+    Result := '[]'
+  else
+  begin
+    Result[1] := '[';
+    Result := Result + ']';
+  end;
+end;
+
+var
+  console: IPTCConsole;
+  ev: IPTCEvent;
+  Done: Boolean = False;
+  RX, RY: Integer;
+begin
+  try
+    try
+      console := TPTCConsoleFactory.CreateNew;
+
+      console.Option('intercept window close');
+  //    console.Option('resizable window');
+
+      console.Open('event test');
+
+      repeat
+        console.NextEvent(ev, True, PTCAnyEvent);
+        if Supports(ev, IPTCMouseButtonEvent) then
+          with ev as IPTCMouseButtonEvent do
+            Writeln('IPTCMouseButtonEvent(X=', X, '; Y=', Y, '; DeltaX=', DeltaX,
+            '; DeltaY=', DeltaY, '; ButtonState=', ButtonState2Str(ButtonState),
+            '; Press=', Press, '; Release=', Release, '; Button=', Button, ')')
+        else if Supports(ev, IPTCMouseEvent) then
+          with ev as IPTCMouseEvent do
+            Writeln('IPTCMouseEvent(X=', X, '; Y=', Y, '; DeltaX=', DeltaX,
+            '; DeltaY=', DeltaY, '; ButtonState=', ButtonState2Str(ButtonState),
+            ')')
+        else if Supports(ev, IPTCKeyEvent) then
+          with ev as IPTCKeyEvent do
+            Writeln('IPTCKeyEvent(Code=', Code, '; Unicode=', Unicode, '; Press=',
+              Press, '; Release=', Release, '; Alt=', Alt, '; Shift=', Shift,
+              '; Control=', Control, '; ModifierKeys=',
+              ModifierKeys2Str(ModifierKeys), ')')
+        else if Supports(ev, IPTCResizeEvent) then
+          with ev as IPTCResizeEvent do
+            Writeln('IPTCResizeEvent(Width=', Width, '; Height=', Height, ')')
+        else if Supports(ev, IPTCCloseEvent) then
+          with ev as IPTCCloseEvent do
+            Writeln('IPTCCloseEvent()')
+        else
+          Writeln('UNKNOWN EVENT TYPE');
+
+        if Supports(ev, IPTCKeyEvent) then
+          with ev as IPTCKeyEvent do
+            if Press then
+            begin
+              case Code of
+                PTCKEY_G:
+                  console.Option('grab mouse');
+                PTCKEY_U:
+                  console.Option('ungrab mouse');
+                PTCKEY_S:
+                  console.Option('show cursor');
+                PTCKEY_H:
+                  console.Option('hide cursor');
+                PTCKEY_R:
+                  console.Option('relative mouse on');
+                PTCKEY_A:
+                  console.Option('relative mouse off');
+                PTCKEY_M:
+                  begin
+                    RX := Random(console.Width);
+                    RY := Random(console.Height);
+                    Writeln('MoveMouseTo(', RX, ', ', RY, ')');
+                    if not console.MoveMouseTo(RX, RY) then
+                      writeln('MoveMouseTo FAILED (or is not supported by the console)');
+                  end;
+                PTCKEY_Q:
+                  Done := True;
+              end;
+            end;
+      until Done;
+    finally
+      if Assigned(console) then
+        console.Close;
+    end;
+  except
+    on error: TPTCError do
+      error.Report;
+  end;
+end.
diff --git a/packages/rtl-console/fpmake.pp b/packages/rtl-console/fpmake.pp
index 2c171df383..d8ff7c7fab 100644
--- a/packages/rtl-console/fpmake.pp
+++ b/packages/rtl-console/fpmake.pp
@@ -41,6 +41,8 @@ begin
     P.License := 'LGPL with modification, ';
     P.HomepageURL := 'www.freepascal.org';
     P.OSes:=Rtl_ConsoleOSes;
+    if Defaults.CPU=powerpc then
+      P.OSes:=P.OSes-[amiga];
     P.Email := '';
     P.Description := 'Rtl-console, console abstraction';
     P.NeedLibC:= false;
diff --git a/packages/rtl-console/src/inc/videoh.inc b/packages/rtl-console/src/inc/videoh.inc
index 4b0d66b901..5ef02d20d0 100644
--- a/packages/rtl-console/src/inc/videoh.inc
+++ b/packages/rtl-console/src/inc/videoh.inc
@@ -22,7 +22,7 @@ type
   TVideoCell = Word;
   PVideoCell = ^TVideoCell;
 
-  TVideoBuf = array[0..32759] of TVideoCell;
+  TVideoBuf = array[0..{$ifdef CPU16}16382{$else}32759{$endif}] of TVideoCell;
   PVideoBuf = ^TVideoBuf;
 
   TVideoDriver = Record
diff --git a/packages/rtl-console/src/win/winevent.pp b/packages/rtl-console/src/win/winevent.pp
index 8eb7277be7..ef90a075cf 100644
--- a/packages/rtl-console/src/win/winevent.pp
+++ b/packages/rtl-console/src/win/winevent.pp
@@ -203,9 +203,10 @@ interface
               { mouse event can be disabled by mouse.inc code
                 in DoneMouse
                 so use a key event instead PM }
-              WriteConsoleInput(StdInputHandle,ir,1,written);
+              { 20170707 mantis #32096, only wait if really written}
+              if WriteConsoleInput(StdInputHandle,ir,1,written) then
               { wait, til the thread is ready }
-              WaitForSingleObject(EventThreadHandle,INFINITE);
+                WaitForSingleObject(EventThreadHandle,INFINITE);
               CloseHandle(EventThreadHandle);
            end;
       end;
diff --git a/packages/rtl-extra/fpmake.pp b/packages/rtl-extra/fpmake.pp
index 629d9ca999..9b14e032d4 100644
--- a/packages/rtl-extra/fpmake.pp
+++ b/packages/rtl-extra/fpmake.pp
@@ -24,7 +24,7 @@ Const
   SerialOSes    = [android,linux,netbsd,openbsd,win32,win64];
   UComplexOSes  = [amiga,aros,emx,gba,go32v2,morphos,msdos,nativent,nds,netware,netwlibc,os2,watcom,wii,wince,win32,win64]+UnixLikes;
   MatrixOSes	= [amiga,aros,emx,gba,go32v2,morphos,msdos,nativent,nds,netware,netwlibc,os2,wii,win32,win64,wince]+UnixLikes;
-  ObjectsOSes   = [amiga,aros,emx,gba,go32v2,morphos,msdos,netware,netwlibc,os2,win32,win64,wince]+UnixLikes;
+  ObjectsOSes   = [amiga,aros,emx,gba,go32v2,morphos,msdos,nds,netware,netwlibc,os2,win32,win64,wince]+UnixLikes;
   WinsockOSes   = [win32,win64,wince,os2,emx,netware,netwlibc];
   WinSock2OSes  = [win32,win64,wince];
   SocketsOSes   = UnixLikes+AllAmigaLikeOSes+[netware,netwlibc,os2,wince,win32,win64];
@@ -106,6 +106,8 @@ begin
 
     T:=P.Targets.AddUnit('serial.pp',SerialOSes);
     T:=P.Targets.AddUnit('sockets.pp',SocketsOSes);
+    if Defaults.CPU=powerpc then
+      T.OSes:=T.OSes-[amiga];
     with T.Dependencies do
      begin
        addinclude('osdefs.inc',AllUnixOSes);
diff --git a/packages/rtl-objpas/fpmake.pp b/packages/rtl-objpas/fpmake.pp
index 5483cd7de9..1513ec3086 100644
--- a/packages/rtl-objpas/fpmake.pp
+++ b/packages/rtl-objpas/fpmake.pp
@@ -15,7 +15,7 @@ Const
 //  AllUnixOSes  = [Linux,FreeBSD,NetBSD,OpenBSD,Darwin,QNX,BeOS,Solaris,Haiku,iphonesim,aix,Android];
 //    unixlikes-[beos];
 // 
-  StrUtilsOSes  = [amiga,aros,emx,gba,go32v2,msdos,netware,wince,morphos,nativent,os2,netwlibc,win32,win64]+UnixLikes;
+  StrUtilsOSes  = [amiga,aros,emx,gba,go32v2,msdos,nds,netware,wince,morphos,nativent,os2,netwlibc,win32,win64]+UnixLikes;
   VarUtilsOSes  = [amiga,aros,emx,gba,go32v2,msdos,nds,netware,wince,morphos,nativent,os2,netwlibc,watcom,wii,win32,win64]+UnixLikes;
   ConvUtilsOSes = [nativent,netware,netwlibc,win32,win64,wince]+UnixLikes-[BeOS];
   ConvUtilOSes  = [Go32v2,msdos,os2,emx];
diff --git a/packages/rtl-objpas/src/inc/dateutil.inc b/packages/rtl-objpas/src/inc/dateutil.inc
index c90c83deff..fc7f87a13e 100644
--- a/packages/rtl-objpas/src/inc/dateutil.inc
+++ b/packages/rtl-objpas/src/inc/dateutil.inc
@@ -2532,7 +2532,7 @@ end;
 function UniversalTimeToLocal(UT: TDateTime): TDateTime;
 
 begin
-  Result:=UniversalTimeToLocal(UT,GetLocalTimeOffset);
+  Result:=UniversalTimeToLocal(UT,-GetLocalTimeOffset);
 end;
 
 function UniversalTimeToLocal(UT: TDateTime; TZOffset : Integer): TDateTime;
@@ -2549,7 +2549,7 @@ end;
 Function LocalTimeToUniversal(LT: TDateTime): TDateTime;
 
 begin
-  Result:=LocalTimeToUniversal(LT,GetLocalTimeOffset);
+  Result:=LocalTimeToUniversal(LT,-GetLocalTimeOffset);
 end;
 
 Function LocalTimeToUniversal(LT: TDateTime;TZOffset: Integer): TDateTime;
diff --git a/packages/rtl-objpas/src/inc/strutils.pp b/packages/rtl-objpas/src/inc/strutils.pp
index 5def35f24d..19e1cc9abd 100644
--- a/packages/rtl-objpas/src/inc/strutils.pp
+++ b/packages/rtl-objpas/src/inc/strutils.pp
@@ -819,7 +819,7 @@ Var
 
 begin
   FindMatchesBoyerMooreCaseSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll);
-  For I:=0 to Length(AMatches) do
+  For I:=0 to pred(Length(AMatches)) do
     Inc(AMatches[i]);
 end;
 
@@ -830,7 +830,7 @@ Var
 
 begin
   FindMatchesBoyerMooreCaseInSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll);
-  For I:=0 to Length(AMatches) do
+  For I:=0 to pred(Length(AMatches)) do
     Inc(AMatches[i]);
 end;
 
diff --git a/packages/rtl-objpas/src/inc/variants.pp b/packages/rtl-objpas/src/inc/variants.pp
index 56559f203a..ae04647cfd 100644
--- a/packages/rtl-objpas/src/inc/variants.pp
+++ b/packages/rtl-objpas/src/inc/variants.pp
@@ -3897,7 +3897,7 @@ begin
 
     index:=RequestedVarType-CMinVarType;
     if index>=L then
-      SetLength(customvarianttypes,L+1);
+      SetLength(customvarianttypes,index+1);
     if Assigned(customvarianttypes[index]) then
     begin
       if customvarianttypes[index]=InvalidCustomVariantType then
diff --git a/packages/rtl-unicode/fpmake.pp b/packages/rtl-unicode/fpmake.pp
index ad9ab3c936..fe8867040b 100644
--- a/packages/rtl-unicode/fpmake.pp
+++ b/packages/rtl-unicode/fpmake.pp
@@ -13,7 +13,7 @@ Const
   UnixLikes = AllUnixOSes -[QNX];
 
   CollationOSes = [aix,android,darwin,emx,freebsd,linux,netbsd,openbsd,os2,solaris,win32,win64,dragonfly,haiku];
-  CPUnits       = [aix,amiga,aros,android,beos,darwin,iphonesim,emx,gba,freebsd,go32v2,haiku,linux,morphos,netbsd,netware,netwlibc,openbsd,os2,solaris,watcom,wii,win32,win64,wince,dragonfly];
+  CPUnits       = [aix,amiga,aros,android,beos,darwin,iphonesim,emx,gba,nds,freebsd,go32v2,haiku,linux,morphos,netbsd,netware,netwlibc,openbsd,os2,solaris,watcom,wii,win32,win64,wince,dragonfly];
   utf8bidiOSes  = [netware,netwlibc];
   freebidiOSes  = [netware,netwlibc];  
 
diff --git a/packages/sdl/LGPL b/packages/sdl/LGPL
index e084da1a5d..03702a830f 100644
--- a/packages/sdl/LGPL
+++ b/packages/sdl/LGPL
@@ -485,7 +485,7 @@ convey the exclusion of warranty; and each file should have at least the
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 Also add information on how to contact you by electronic and paper mail.
 
diff --git a/packages/sdl/fpmake.pp b/packages/sdl/fpmake.pp
index 1ac5372134..ae48c4e6f4 100644
--- a/packages/sdl/fpmake.pp
+++ b/packages/sdl/fpmake.pp
@@ -24,7 +24,7 @@ begin
     P.Dependencies.Add('morphunits',[morphos]);
     if Defaults.CPU=arm then
        P.OSes := P.OSes - [darwin];
-    P.OSes := P.OSes - [iphonesim,os2,emx,go32v2,watcom,nativent,embedded,android,amiga,aros,msdos,gba];
+    P.OSes := P.OSes - [iphonesim,os2,emx,go32v2,watcom,nativent,embedded,android,amiga,aros,msdos,gba,nds];
 
     T:=P.Targets.AddUnit('logger.pas');
       with T.Dependencies do
diff --git a/packages/sqlite/src/sqlite3.inc b/packages/sqlite/src/sqlite3.inc
index c1adcd1820..a16ff61260 100644
--- a/packages/sqlite/src/sqlite3.inc
+++ b/packages/sqlite/src/sqlite3.inc
@@ -18,9 +18,9 @@ uses
 {$else}
   DynLibs;
 
-{$ifdef darwin}
-{$linklib sqlite3}
-{$endif}
+  {$ifdef darwin}
+    {$linklib sqlite3}
+  {$endif}
 {$endif}
 
 const
@@ -37,8 +37,7 @@ const
 {$ENDIF}
 
 {
-  Header converted from Sqlite version 3.7.9
-  SOURCE_ID = '2011-11-01 00:52:41 c7c6050ef060877ebe77b41d959e9df13f8c9b5e'
+  Header converted from Sqlite version 3.14.2
 }
 
 //SQLITE_EXTERN const char sqlite3_version[];
@@ -59,7 +58,7 @@ type
 
 const
   SQLITE_STATIC      = sqlite3_destructor_type(nil);
-  SQLITE_TRANSIENT   = pointer(-1);//sqlite3_destructor_type(-1);
+  SQLITE_TRANSIENT   = pointer(-1); //sqlite3_destructor_type(-1);
   
 
 type
@@ -76,6 +75,7 @@ type
   sqlite3_uint64 = sqlite_uint64;
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_close{$IFDEF D}: function{$ENDIF}(ref: psqlite3): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_close_v2{$IFDEF D}: function{$ENDIF}(ref: psqlite3): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 type
   sqlite3_callback = function(user: pointer; cols: cint; values, name: ppansichar): cint; cdecl;
@@ -117,6 +117,8 @@ const
   SQLITE_FORMAT     = 24;   (* Auxiliary database format error *)
   SQLITE_RANGE      = 25;   (* 2nd parameter to sqlite3_bind out of range *)
   SQLITE_NOTADB     = 26;   (* File opened that is not a database file *)
+  SQLITE_NOTICE     = 27;   (* Notifications from sqlite3_log() *)
+  SQLITE_WARNING    = 28;   (* Warnings from sqlite3_log() *)
   SQLITE_ROW        = 100;  (* sqlite3_step() has another row ready *)
   SQLITE_DONE       = 101;  (* sqlite3_step() has finished executing *)
 
@@ -142,18 +144,49 @@ const
   SQLITE_IOERR_SHMLOCK           = (SQLITE_IOERR or (20 shl 8));
   SQLITE_IOERR_SHMMAP            = (SQLITE_IOERR or (21 shl 8));
   SQLITE_IOERR_SEEK              = (SQLITE_IOERR or (22 shl 8));
+  SQLITE_IOERR_DELETE_NOENT      = (SQLITE_IOERR or (23 shl 8));
+  SQLITE_IOERR_MMAP              = (SQLITE_IOERR or (24 shl 8));
+  SQLITE_IOERR_GETTEMPPATH       = (SQLITE_IOERR or (25 shl 8));
+  SQLITE_IOERR_CONVPATH          = (SQLITE_IOERR or (26 shl 8));
+  SQLITE_IOERR_VNODE             = (SQLITE_IOERR or (27 shl 8));
+  SQLITE_IOERR_AUTH              = (SQLITE_IOERR or (28 shl 8));
   SQLITE_LOCKED_SHAREDCACHE      = (SQLITE_LOCKED or  (1 shl 8));
   SQLITE_BUSY_RECOVERY           = (SQLITE_BUSY   or  (1 shl 8));
+  SQLITE_BUSY_SNAPSHOT           = (SQLITE_BUSY   or  (2 shl 8));
   SQLITE_CANTOPEN_NOTEMPDIR      = (SQLITE_CANTOPEN or (1 shl 8));
+  SQLITE_CANTOPEN_ISDIR          = (SQLITE_CANTOPEN or (2 shl 8));
+  SQLITE_CANTOPEN_FULLPATH       = (SQLITE_CANTOPEN or (3 shl 8));
+  SQLITE_CANTOPEN_CONVPATH       = (SQLITE_CANTOPEN or (4 shl 8));
   SQLITE_CORRUPT_VTAB            = (SQLITE_CORRUPT or (1 shl 8));
   SQLITE_READONLY_RECOVERY       = (SQLITE_READONLY or (1 shl 8));
   SQLITE_READONLY_CANTLOCK       = (SQLITE_READONLY or (2 shl 8));
+  SQLITE_READONLY_ROLLBACK       = (SQLITE_READONLY or (3 shl 8));
+  SQLITE_READONLY_DBMOVED        = (SQLITE_READONLY or (4 shl 8));
+  SQLITE_ABORT_ROLLBACK          = (SQLITE_ABORT or (2 shl 8));
+  SQLITE_CONSTRAINT_CHECK        = (SQLITE_CONSTRAINT or (1 shl 8));
+  SQLITE_CONSTRAINT_COMMITHOOK   = (SQLITE_CONSTRAINT or (2 shl 8));
+  SQLITE_CONSTRAINT_FOREIGNKEY   = (SQLITE_CONSTRAINT or (3 shl 8));
+  SQLITE_CONSTRAINT_FUNCTION     = (SQLITE_CONSTRAINT or (4 shl 8));
+  SQLITE_CONSTRAINT_NOTNULL      = (SQLITE_CONSTRAINT or (5 shl 8));
+  SQLITE_CONSTRAINT_PRIMARYKEY   = (SQLITE_CONSTRAINT or (6 shl 8));
+  SQLITE_CONSTRAINT_TRIGGER      = (SQLITE_CONSTRAINT or (7 shl 8));
+  SQLITE_CONSTRAINT_UNIQUE       = (SQLITE_CONSTRAINT or (8 shl 8));
+  SQLITE_CONSTRAINT_VTAB         = (SQLITE_CONSTRAINT or (9 shl 8));
+  SQLITE_CONSTRAINT_ROWID        = (SQLITE_CONSTRAINT or (10 shl 8));
+  SQLITE_NOTICE_RECOVER_WAL      = (SQLITE_NOTICE or (1 shl 8));
+  SQLITE_NOTICE_RECOVER_ROLLBACK = (SQLITE_NOTICE or (2 shl 8));
+  SQLITE_WARNING_AUTOINDEX       = (SQLITE_WARNING or (1 shl 8));
+  SQLITE_AUTH_USER               = (SQLITE_AUTH or (1 shl 8));
+  SQLITE_OK_LOAD_PERMANENTLY     = (SQLITE_OK or (1 shl 8));
 
   SQLITE_OPEN_READONLY         = $00000001;
   SQLITE_OPEN_READWRITE        = $00000002;
   SQLITE_OPEN_CREATE           = $00000004;
   SQLITE_OPEN_DELETEONCLOSE    = $00000008;
   SQLITE_OPEN_EXCLUSIVE        = $00000010;
+  SQLITE_OPEN_AUTOPROXY        = $00000020;  (* VFS only *)
+  SQLITE_OPEN_URI              = $00000040;  (* Ok for sqlite3_open_v2() *)
+  SQLITE_OPEN_MEMORY           = $00000080;  (* Ok for sqlite3_open_v2() *)
   SQLITE_OPEN_MAIN_DB          = $00000100;
   SQLITE_OPEN_TEMP_DB          = $00000200;
   SQLITE_OPEN_TRANSIENT_DB     = $00000400;
@@ -180,7 +213,9 @@ const
   SQLITE_IOCAP_SAFE_APPEND     = $00000200;
   SQLITE_IOCAP_SEQUENTIAL      = $00000400;
   SQLITE_IOCAP_UNDELETABLE_WHEN_OPEN  = $00000800;
-  
+  SQLITE_IOCAP_POWERSAFE_OVERWRITE    = $00001000;
+  SQLITE_IOCAP_IMMUTABLE              = $00002000;
+
   SQLITE_LOCK_NONE          = 0;
   SQLITE_LOCK_SHARED        = 1;
   SQLITE_LOCK_RESERVED      = 2;
@@ -218,21 +253,46 @@ type
      xShmLock : function(f : psqlite3_file; offset: cint; n : cint; flags : cint) : cint; stdcall;
      xShmBarrier  : procedure (f : psqlite3_file); stdcall;
      xShmUnmap : function(f : psqlite3_file; deleteFlag : cint) : cint; stdcall;
-          (* Additional methods may be added in future releases *)
+     (* Methods above are valid for version 2 *)
+     xFetch : function(f: psqlite3_file; iOfst: sqlite3_int64; iAmt: cint; pp: PPointer) : cint; stdcall;
+     xUnfetch : function(f: psqlite3_file; iOfst: sqlite3_int64; p: Pointer) : cint; stdcall;
+     (* Methods above are valid for version 3 *)
+     (* Additional methods may be added in future releases *)
   end;
 
 const
-  SQLITE_FCNTL_LOCKSTATE        = 1;
-  SQLITE_GET_LOCKPROXYFILE      = 2;
-  SQLITE_SET_LOCKPROXYFILE      = 3;
-  SQLITE_LAST_ERRNO             = 4;
-  SQLITE_FCNTL_SIZE_HINT        = 5;
-  SQLITE_FCNTL_CHUNK_SIZE       = 6;
-  SQLITE_FCNTL_FILE_POINTER     = 7;
-  SQLITE_FCNTL_SYNC_OMITTED     = 8;
-  SQLITE_FCNTL_WIN32_AV_RETRY   = 9;
-  SQLITE_FCNTL_PERSIST_WAL      = 10;
-  SQLITE_FCNTL_OVERWRITE        = 11;
+  SQLITE_FCNTL_LOCKSTATE           = 1;
+  SQLITE_FCNTL_GET_LOCKPROXYFILE   = 2;
+  SQLITE_FCNTL_SET_LOCKPROXYFILE   = 3;
+  SQLITE_FCNTL_LAST_ERRNO          = 4;
+  SQLITE_FCNTL_SIZE_HINT           = 5;
+  SQLITE_FCNTL_CHUNK_SIZE          = 6;
+  SQLITE_FCNTL_FILE_POINTER        = 7;
+  SQLITE_FCNTL_SYNC_OMITTED        = 8;
+  SQLITE_FCNTL_WIN32_AV_RETRY      = 9;
+  SQLITE_FCNTL_PERSIST_WAL         = 10;
+  SQLITE_FCNTL_OVERWRITE           = 11;
+  SQLITE_FCNTL_VFSNAME             = 12;
+  SQLITE_FCNTL_POWERSAFE_OVERWRITE = 13;
+  SQLITE_FCNTL_PRAGMA              = 14;
+  SQLITE_FCNTL_BUSYHANDLER         = 15;
+  SQLITE_FCNTL_TEMPFILENAME        = 16;
+  SQLITE_FCNTL_MMAP_SIZE           = 18;
+  SQLITE_FCNTL_TRACE               = 19;
+  SQLITE_FCNTL_HAS_MOVED           = 20;
+  SQLITE_FCNTL_SYNC                = 21;
+  SQLITE_FCNTL_COMMIT_PHASETWO     = 22;
+  SQLITE_FCNTL_WIN32_SET_HANDLE    = 23;
+  SQLITE_FCNTL_WAL_BLOCK           = 24;
+  SQLITE_FCNTL_ZIPVFS              = 25;
+  SQLITE_FCNTL_RBU                 = 26;
+  SQLITE_FCNTL_VFS_POINTER         = 27;
+  SQLITE_FCNTL_JOURNAL_POINTER     = 28;
+
+  (* deprecated names *)
+  SQLITE_GET_LOCKPROXYFILE    = SQLITE_FCNTL_GET_LOCKPROXYFILE;
+  SQLITE_SET_LOCKPROXYFILE    = SQLITE_FCNTL_SET_LOCKPROXYFILE;
+  SQLITE_LAST_ERRNO           = SQLITE_FCNTL_LAST_ERRNO;
 
 type
   psqlite3_mutex = ^sqlite3_mutex;
@@ -335,10 +395,21 @@ Const
   SQLITE_CONFIG_GETPCACHE    = 15;
   SQLITE_CONFIG_LOG          = 16;
   SQLITE_CONFIG_URI          = 17;
+  SQLITE_CONFIG_PCACHE2      = 18;  (* sqlite3_pcache_methods2* *)
+  SQLITE_CONFIG_GETPCACHE2   = 19;  (* sqlite3_pcache_methods2* *)
+  SQLITE_CONFIG_COVERING_INDEX_SCAN = 20;  (* int *)
+  SQLITE_CONFIG_SQLLOG              = 21;  (* xSqllog, void* *)
+  SQLITE_CONFIG_MMAP_SIZE           = 22;  (* sqlite3_int64, sqlite3_int64 *)
+  SQLITE_CONFIG_WIN32_HEAPSIZE      = 23;  (* int nByte *)
+  SQLITE_CONFIG_PCACHE_HDRSZ        = 24;  (* int *psz *)
+  SQLITE_CONFIG_PMASZ               = 25;  (* unsigned int szPma *)
+  SQLITE_CONFIG_STMTJRNL_SPILL      = 26;  (* int nByte *)
 
   SQLITE_DBCONFIG_LOOKASIDE      = 1001;
   SQLITE_DBCONFIG_ENABLE_FKEY    = 1002;
   SQLITE_DBCONFIG_ENABLE_TRIGGER = 1003;
+  SQLITE_DBCONFIG_ENABLE_FTS3_TOKENIZER = 1004;
+  SQLITE_DBCONFIG_ENABLE_LOAD_EXTENSION = 1005;
 
   
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_extended_result_codes{$IFDEF D}: function{$ENDIF}(db: psqlite3; onoff: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -369,8 +440,11 @@ type
 //char *sqlite3_snprintf(int,char*,const char*, ...);
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_malloc{$IFDEF D}: function{$ENDIF}(size: cint): pointer;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_malloc64{$IFDEF D}: function{$ENDIF}(size: sqlite3_uint64): pointer;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_realloc{$IFDEF D}: function{$ENDIF}(ptr: pointer; size: cint): pointer;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_realloc64{$IFDEF D}: function{$ENDIF}(ptr: pointer; size: sqlite3_uint64): pointer;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_free{$IFDEF D}: procedure{$ENDIF}(ptr: pointer);cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_msize{$IFDEF D}: function{$ENDIF}(ptr: pointer): sqlite3_uint64;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_memory_used{$IFDEF D}: function{$ENDIF}(): sqlite3_int64; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_memory_highwater{$IFDEF D}: function{$ENDIF}(resetFlag: cint): sqlite3_int64; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -424,11 +498,12 @@ const
   SQLITE_FUNCTION             = 31;   (* Function Name   NULL            *)
   SQLITE_SAVEPOINT            = 32;   (* Operation       Savepoint Name  *)
   SQLITE_COPY                 =  0;   (* No longer used *)
+  SQLITE_RECURSIVE            = 33;   (* NULL            NULL            *)
 
 
 type
-  xTrace = procedure(user: pointer; s: pansichar); cdecl;
-  xProfile = procedure(user: pointer; s: pansichar; i: sqlite3_uint64); cdecl;
+  xTrace = procedure(user: pointer; s: pansichar); cdecl; deprecated;
+  xProfile = procedure(user: pointer; s: pansichar; i: sqlite3_uint64); cdecl; deprecated;
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_trace{$IFDEF D}: function{$ENDIF}(db: psqlite3; cb: xTrace; user: pointer): pointer; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_profile{$IFDEF D}: function{$ENDIF}(db: psqlite3; cb: xProfile; user: pointer): pointer; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -455,18 +530,15 @@ type
   zVfs: pansichar         (* Name of VFS module to use *)
 ): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
-{$IFDEF S}
-function sqlite3_uri_parameter(zFilename : pansichar; zParam :pansichar) : pansichar;cdecl;external Sqlite3Lib;
-{$ENDIF}
-{$IFDEF D}
-var
- sqlite3_uri_parameter : function(zFilename : pansichar; zParam :pansichar) : pansichar;cdecl;
-{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_uri_parameter{$IFDEF D}: function{$ENDIF}(zFilename : pansichar; zParam: pansichar) : pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_uri_boolean{$IFDEF D}: function{$ENDIF}(zFile : pansichar; zParam :pansichar; bDefault: cint) : cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_uri_int64{$IFDEF D}: function{$ENDIF}(zFile : pansichar; zParam :pansichar; iDefault: sqlite3_int64) : sqlite3_int64; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_errcode{$IFDEF D}: function{$ENDIF}(db: psqlite3): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_extended_errcode{$IFDEF D}: function{$ENDIF}(db: psqlite3): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_errmsg{$IFDEF D}: function{$ENDIF}(db: psqlite3): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_errmsg16{$IFDEF D}: function{$ENDIF}(db: psqlite3): pwidechar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_errstr{$IFDEF D}: function{$ENDIF}(errCode: cint): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 type
   ppsqlite3_stmt = ^psqlite3_stmt;
@@ -489,7 +561,8 @@ const
   SQLITE_LIMIT_LIKE_PATTERN_LENGTH       = 8;
   SQLITE_LIMIT_VARIABLE_NUMBER           = 9;
   SQLITE_LIMIT_TRIGGER_DEPTH             = 10;
-   
+  SQLITE_LIMIT_WORKER_THREADS            = 11;
+
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_prepare{$IFDEF D}: function{$ENDIF}(
   db: psqlite3;             (* Database handle *)
@@ -525,6 +598,7 @@ const
 
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_sql{$IFDEF D}: function{$ENDIF}(pStmt: psqlite3_stmt): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_expanded_sql{$IFDEF D}: function{$ENDIF}(pStmt: psqlite3_stmt): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 
 type
@@ -537,14 +611,17 @@ type
 
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_blob{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: pointer; L: cint; D: sqlite3_destructor_type): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_blob64{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: pointer; L: sqlite3_uint64; D: sqlite3_destructor_type): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_double{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: cdouble): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_int{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_int64{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: sqlite3_int64): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_null{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_text{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: pansichar; L: cint; D: sqlite3_destructor_type): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_text16{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: pwidechar; L: cint; D: sqlite3_destructor_type): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_text64{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: pansichar; L: sqlite3_uint64; D: sqlite3_destructor_type; encoding: cuchar): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_value{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: psqlite3_value): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_zeroblob{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_zeroblob64{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint; V: sqlite3_uint64): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_parameter_count{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_parameter_name{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; N: cint): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_bind_parameter_index{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt; zName: pansichar): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -630,9 +707,11 @@ const
   SQLITE_UTF16LE        = 2;
   SQLITE_UTF16BE        = 3;
   SQLITE_UTF16          = 4;    (* Use native byte order *)
-  SQLITE_ANY            = 5;    (* sqlite3_create_function only *)
+  SQLITE_ANY            = 5;    (* Deprecated *)
   SQLITE_UTF16_ALIGNED  = 8;    (* sqlite3_create_collation only *)
 
+  SQLITE_DETERMINISTIC  = $800;
+
 {$IFDEF SQLITE_OBSOLETE}
 type
   memory_alarm_cb = function(user: pointer; i64: sqlite3_int64; i: cint): pointer; cdecl;
@@ -657,6 +736,10 @@ type
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_value_text16be{$IFDEF D}: function{$ENDIF}(val: psqlite3_value): pwidechar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_value_type{$IFDEF D}: function{$ENDIF}(val: psqlite3_value): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_value_numeric_type{$IFDEF D}: function{$ENDIF}(val: psqlite3_value): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_value_subtype{$IFDEF D}: function{$ENDIF}(val: psqlite3_value): cuint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_value_dup{$IFDEF D}: function{$ENDIF}(val: psqlite3_value): psqlite3_value; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_value_free{$IFDEF D}: procedure{$ENDIF}(val: psqlite3_value); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_aggregate_context{$IFDEF D}: function{$ENDIF}(ctx: psqlite3_context; nBytes: cint): pointer; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_user_data{$IFDEF D}: function{$ENDIF}(ctx: psqlite3_context): pointer; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_context_db_handle{$IFDEF D}: function{$ENDIF}(ctx: psqlite3_context): psqlite3; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -668,6 +751,7 @@ type
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_get_auxdata{$IFDEF D}: function{$ENDIF}(ctx: psqlite3_context; N: cint): pointer; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_set_auxdata{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; N: cint; P: pointer; cb: set_auxdata_cb); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_blob{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pointer; N: cint; D: sqlite3_destructor_type); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_blob64{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pointer; N: sqlite3_uint64; D: sqlite3_destructor_type); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_double{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: cdouble); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_error{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pansichar; N: cint); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_error16{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pwidechar; N: cint); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
@@ -678,11 +762,13 @@ type
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_int64{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: sqlite3_int64); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_null{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_text{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pansichar; N: cint; D: sqlite3_destructor_type); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_text64{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pansichar; N: sqlite3_uint64; D: sqlite3_destructor_type; encoding: cuchar); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_text16{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pwidechar; N: cint; D: sqlite3_destructor_type); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_text16le{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pwidechar; N: cint; D: sqlite3_destructor_type); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_text16be{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: pwidechar; N: cint; D: sqlite3_destructor_type); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_value{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: psqlite3_value); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
-{$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_zeroblob{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; V: cint); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_result_zeroblob{$IFDEF D}: procedure{$ENDIF}(ctx: psqlite3_context; N: cint); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_result_zeroblob64{$IFDEF D}: function{$ENDIF}(ctx: psqlite3_context; N: sqlite3_uint64): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 type
   xCompare = function(user: pointer; A: cint; B: pointer; C: cint; D: pointer): cint; cdecl;
@@ -726,25 +812,39 @@ type
   user: pointer;
   cb: collation_needed_cb
 ): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_key{$IFDEF D}: function{$ENDIF}(
   db: psqlite3;                   (* Database to be rekeyed *)
   pKey: pointer; nKey: cint       (* The key *)
 ): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_key_v2{$IFDEF D}: function{$ENDIF}(
+  db: psqlite3;                   (* Database to be rekeyed *)
+  zDbName: pansichar;             (* Name of the database *)
+  pKey: pointer; nKey: cint       (* The key *)
+): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_rekey{$IFDEF D}: function{$ENDIF}(
   db: psqlite3;                   (* Database to be rekeyed *)
   pKey: pointer; nKey: cint       (* The new key *)
 ): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_rekey_v2{$IFDEF D}: function{$ENDIF}(
+  db: psqlite3;                   (* Database to be rekeyed *)
+  zDbName: pansichar;             (* Name of the database *)
+  pKey: pointer; nKey: cint       (* The new key *)
+): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_sleep{$IFDEF D}: function{$ENDIF}(M: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 
 {$ifndef win32}
 var
   sqlite3_temp_directory: pansichar; cvar; external {Sqlite3Lib};
+  sqlite3_data_directory: pansichar; cvar; external {Sqlite3Lib};
 {$endif}
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_get_autocommit{$IFDEF D}: function{$ENDIF}(db: psqlite3): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_db_handle{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt): psqlite3; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
-{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_next_stmt{$IFDEF D}: function{$ENDIF}(db: psqlite3;stmt: psqlite3_stmt):psqlite3_stmt;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF} 
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_db_filename{$IFDEF D}: function{$ENDIF}(db: psqlite3; zDbName: pansichar): pansichar; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_db_readonly{$IFDEF D}: function{$ENDIF}(db: psqlite3; zDbName: pansichar): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_next_stmt{$IFDEF D}: function{$ENDIF}(db: psqlite3;stmt: psqlite3_stmt):psqlite3_stmt;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
  
 type
   commit_callback = function(user: pointer): cint; cdecl;
@@ -757,6 +857,7 @@ type
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_update_hook{$IFDEF D}: function{$ENDIF}(db: psqlite3; cb: update_callback; user: pointer): pointer; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_enable_shared_cache{$IFDEF D}: function{$ENDIF}(B: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_release_memory{$IFDEF D}: function{$ENDIF}(N: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_db_release_memory{$IFDEF D}: function{$ENDIF}(db: psqlite3): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_soft_heap_limit{$IFDEF D}: procedure{$ENDIF}(N: cint); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_soft_heap_limit64{$IFDEF D}: function{$ENDIF}(N: int64):int64;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
  
@@ -780,6 +881,7 @@ type
 ): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_enable_load_extension{$IFDEF D}: function{$ENDIF}(db: psqlite3; onoff: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_auto_extension{$IFDEF D}: function{$ENDIF}(xEntrypoint: pointer): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_cancel_auto_extension{$IFDEF D}: function{$ENDIF}(xEntrypoint: pointer): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}procedure{$ELSE}var{$ENDIF}sqlite3_reset_auto_extension{$IFDEF D}: procedure{$ENDIF}(); cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 
@@ -819,7 +921,7 @@ type
 type
   psqlite3_index_constracint = ^sqlite3_index_constracint;
   sqlite3_index_constracint = record
-     iColumn: cint;              (* Column on left-hand side of constracint *)
+     iColumn: cint;              (* Column constrained.  -1 for ROWID *)
      op: char;                   (* Constracint operator *)
      usable: char;               (* True if this constracint is usable *)
      iTermOffset: cint;          (* Used cinternally - xBestIndex should ignore *)
@@ -839,29 +941,39 @@ type
 
   psqlite3_index_info = ^sqlite3_index_info;
   sqlite3_index_info = record
-  (* Inputs *)
+    (* Inputs *)
     nConstracint: cint;         (* Number of entries in aConstracint *)
     aConstracint: psqlite3_index_constracint;
     nOrderBy: cint;             (* Number of terms in the ORDER BY clause *)
     aOrderBy: psqlite3_index_orderby;
 
-  (* Outputs *)
+    (* Outputs *)
     aConstracintUsage: psqlite3_index_constracint_usage;
 
-    idxNum: cint;               (* Number used to identify the index *)
-    idxStr: pansichar;          (* String; possibly obtained from sqlite3_malloc *)
-    needToFreeIdxStr: cint;     (* Free idxStr using sqlite3_free() if true *)
-    orderByConsumed: cint;      (* True if output is already ordered *)
-    estimatedCost: cdouble;     (* Estimated cost of using this index *)
+    idxNum: cint;                 (* Number used to identify the index *)
+    idxStr: pansichar;            (* String; possibly obtained from sqlite3_malloc *)
+    needToFreeIdxStr: cint;       (* Free idxStr using sqlite3_free() if true *)
+    orderByConsumed: cint;        (* True if output is already ordered *)
+    estimatedCost: cdouble;       (* Estimated cost of using this index *)
+    (* Fields below are only available in SQLite 3.8.2 and later *)
+    estimatedRows: sqlite3_int64; (* Estimated number of rows returned *)
+    (* Fields below are only available in SQLite 3.9.0 and later *)
+    idxFlags: cint ;              (* Mask of SQLITE_INDEX_SCAN_* flags *)
+    (* Fields below are only available in SQLite 3.10.0 and later *)
+    colUsed: sqlite3_uint64;      (* Input: Mask of columns used by statement *)
   end;
 
 const
+  SQLITE_INDEX_SCAN_UNIQUE      = 1;
   SQLITE_INDEX_CONSTRAINT_EQ    = 2;
   SQLITE_INDEX_CONSTRAINT_GT    = 4;
   SQLITE_INDEX_CONSTRAINT_LE    = 8;
   SQLITE_INDEX_CONSTRAINT_LT    = 16;
   SQLITE_INDEX_CONSTRAINT_GE    = 32;
   SQLITE_INDEX_CONSTRAINT_MATCH = 64;
+  SQLITE_INDEX_CONSTRAINT_LIKE  = 65;
+  SQLITE_INDEX_CONSTRAINT_GLOB  = 66;
+  SQLITE_INDEX_CONSTRAINT_REGEXP= 67;
 
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_create_module{$IFDEF D}: function{$ENDIF}(
@@ -942,14 +1054,16 @@ const
   SQLITE_MUTEX_STATIC_PRNG      = 5;  (* sqlite3_random() *)
   SQLITE_MUTEX_STATIC_LRU       = 6;  (* lru page list *)
   SQLITE_MUTEX_STATIC_LRU2      = 7;  (* lru page list *)
+  SQLITE_MUTEX_STATIC_APP1      = 8;  (* For use by application *)
+  SQLITE_MUTEX_STATIC_APP2      = 9;  (* For use by application *)
+  SQLITE_MUTEX_STATIC_APP3      = 10; (* For use by application *)
+  SQLITE_MUTEX_STATIC_VFS1      = 11; (* For use by built-in VFS *)
+  SQLITE_MUTEX_STATIC_VFS2      = 12; (* For use by extension VFS *)
+  SQLITE_MUTEX_STATIC_VFS3      = 13; (* For use by application VFS *)
 
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_file_control{$IFDEF D}: function{$ENDIF}(db: psqlite3; zDbName: pansichar; op: cint; p: pointer): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 {$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_test_control{$IFDEF D}: function{$ENDIF}(op: cint; args: array of const): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
-{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_status{$IFDEF D}: function{$ENDIF}(op: cint; pcurrent:pcint; pHighwater: pcint; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
-{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_db_status{$IFDEF D}: function{$ENDIF}(db : psqlite3;op: cint; pcurrent:pcint; pHighwater: pcint; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
-{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_stmt_status{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt;op: cint; pcurrent:pcint; pHighwater: pcint; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
-
 const
   SQLITE_TESTCTRL_FAULT_CONFIG             = 1;
   SQLITE_TESTCTRL_FAULT_FAILURES           = 2;
@@ -959,6 +1073,55 @@ const
   SQLITE_TESTCTRL_PRNG_RESTORE             = 6;
   SQLITE_TESTCTRL_PRNG_RESET               = 7;
   SQLITE_TESTCTRL_BITVEC_TEST              = 8;
+  SQLITE_TESTCTRL_FAULT_INSTALL            = 9;
+  SQLITE_TESTCTRL_BENIGN_MALLOC_HOOKS      = 10;
+  SQLITE_TESTCTRL_PENDING_BYTE             = 11;
+  SQLITE_TESTCTRL_ASSERT                   = 12;
+  SQLITE_TESTCTRL_ALWAYS                   = 13;
+  SQLITE_TESTCTRL_RESERVE                  = 14;
+  SQLITE_TESTCTRL_OPTIMIZATIONS            = 15;
+  SQLITE_TESTCTRL_ISKEYWORD                = 16;
+  SQLITE_TESTCTRL_SCRATCHMALLOC            = 17;
+  SQLITE_TESTCTRL_LOCALTIME_FAULT          = 18;
+  SQLITE_TESTCTRL_EXPLAIN_STMT             = 19;  (* NOT USED *)
+  SQLITE_TESTCTRL_NEVER_CORRUPT            = 20;
+  SQLITE_TESTCTRL_VDBE_COVERAGE            = 21;
+  SQLITE_TESTCTRL_BYTEORDER                = 22;
+  SQLITE_TESTCTRL_ISINIT                   = 23;
+  SQLITE_TESTCTRL_SORTER_MMAP              = 24;
+  SQLITE_TESTCTRL_IMPOSTER                 = 25;
+  SQLITE_TESTCTRL_LAST                     = 25;
+
+
+  SQLITE_STATUS_MEMORY_USED          = 0;
+  SQLITE_STATUS_PAGECACHE_USED       = 1;
+  SQLITE_STATUS_PAGECACHE_OVERFLOW   = 2;
+  SQLITE_STATUS_SCRATCH_USED         = 3;
+  SQLITE_STATUS_SCRATCH_OVERFLOW     = 4;
+  SQLITE_STATUS_MALLOC_SIZE          = 5;
+  SQLITE_STATUS_PARSER_STACK         = 6;
+  SQLITE_STATUS_PAGECACHE_SIZE       = 7;
+  SQLITE_STATUS_SCRATCH_SIZE         = 8;
+  SQLITE_STATUS_MALLOC_COUNT         = 9;
+
+  SQLITE_DBSTATUS_LOOKASIDE_USED      = 0;
+  SQLITE_DBSTATUS_CACHE_USED          = 1;
+  SQLITE_DBSTATUS_SCHEMA_USED         = 2;
+  SQLITE_DBSTATUS_STMT_USED           = 3;
+  SQLITE_DBSTATUS_LOOKASIDE_HIT       = 4;
+  SQLITE_DBSTATUS_LOOKASIDE_MISS_SIZE = 5;
+  SQLITE_DBSTATUS_LOOKASIDE_MISS_FULL = 6;
+  SQLITE_DBSTATUS_CACHE_HIT           = 7;
+  SQLITE_DBSTATUS_CACHE_MISS          = 8;
+  SQLITE_DBSTATUS_CACHE_WRITE         = 9;
+  SQLITE_DBSTATUS_DEFERRED_FKS        = 10;
+  SQLITE_DBSTATUS_CACHE_USED_SHARED   = 11;
+  SQLITE_DBSTATUS_MAX                 = 11;   (* Largest defined DBSTATUS *)
+
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_status{$IFDEF D}: function{$ENDIF}(op: cint; pCurrent: pcint; pHighwater: pcint; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_status64{$IFDEF D}: function{$ENDIF}(op: cint; pCurrent: psqlite3_int64; pHighwater: psqlite3_int64; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_db_status{$IFDEF D}: function{$ENDIF}(db : psqlite3;op: cint; pCurrent:pcint; pHighwater: pcint; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF}sqlite3_stmt_status{$IFDEF D}: function{$ENDIF}(stmt: psqlite3_stmt;op: cint; pcurrent:pcint; pHighwater: pcint; resetFlag: cint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 
 {Backup api}
@@ -984,7 +1147,17 @@ Type
 {$IFDEF S}function{$ELSE}var{$ENDIF} sqlite3_wal_autocheckpoint{$IFDEF D}: function{$ENDIF}(db:psqlite3;n : cint): cint;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF} 
 {$IFDEF S}function{$ELSE}var{$ENDIF} sqlite3_wal_checkpoint{$IFDEF D}: function{$ENDIF}(db:psqlite3;zDB: pansichar): cint;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF} 
 {$IFDEF S}function{$ELSE}var{$ENDIF} sqlite3_wal_checkpoint_v2{$IFDEF D}: function{$ENDIF}(db:psqlite3;zDB: pansichar;emode:cint;nLog:pcint;nCkpt:pcint): cint;cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF} 
-                             
+
+Const
+  SQLITE_CHECKPOINT_PASSIVE  = 0;  (* Do as much as possible w/o blocking *)
+  SQLITE_CHECKPOINT_FULL     = 1;  (* Wait for writers, then checkpoint *)
+  SQLITE_CHECKPOINT_RESTART  = 2;  (* Like FULL but wait for for readers *)
+  SQLITE_CHECKPOINT_TRUNCATE = 3;  (* Like RESTART but also truncate WAL *)
+
+
+{String handling api}
+{$IFDEF S}function{$ELSE}var{$ENDIF} sqlite3_strglob {$IFDEF D}:function{$ENDIF}(zGlob, zStr: pansichar): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
+{$IFDEF S}function{$ELSE}var{$ENDIF} sqlite3_strlike {$IFDEF D}:function{$ENDIF}(zGlob, zStr: pansichar; cEsc: cuint): cint; cdecl;{$IFDEF S}external Sqlite3Lib;{$ENDIF}
 
 {$IFDEF LOAD_DYNAMICALLY}
 
@@ -1022,6 +1195,7 @@ begin
   pointer(sqlite3_libversion_number) := GetProcedureAddress(LibHandle,'sqlite3_libversion_number');
   pointer(sqlite3_threadsafe) := GetProcedureAddress(LibHandle,'sqlite3_threadsafe');
   pointer(sqlite3_close) := GetProcedureAddress(LibHandle,'sqlite3_close');
+  pointer(sqlite3_close_v2) := GetProcedureAddress(LibHandle,'sqlite3_close_v2');
   pointer(sqlite3_exec) := GetProcedureAddress(LibHandle,'sqlite3_exec');
   pointer(sqlite3_extended_result_codes) := GetProcedureAddress(LibHandle,'sqlite3_extended_result_codes');
   pointer(sqlite3_last_insert_rowid) := GetProcedureAddress(LibHandle,'sqlite3_last_insert_rowid');
@@ -1046,21 +1220,26 @@ begin
   pointer(sqlite3_extended_errcode) := GetProcedureAddress(LibHandle,'sqlite3_extended_errcode');
   pointer(sqlite3_errmsg) := GetProcedureAddress(LibHandle,'sqlite3_errmsg');
   pointer(sqlite3_errmsg16) := GetProcedureAddress(LibHandle,'sqlite3_errmsg16');
+  pointer(sqlite3_errstr) := GetProcedureAddress(LibHandle,'sqlite3_errstr');
   pointer(sqlite3_limit) := GetProcedureAddress(LibHandle,'sqlite3_limit');
   pointer(sqlite3_prepare) := GetProcedureAddress(LibHandle,'sqlite3_prepare');
   pointer(sqlite3_prepare_v2) := GetProcedureAddress(LibHandle,'sqlite3_prepare_v2');
   pointer(sqlite3_prepare16) := GetProcedureAddress(LibHandle,'sqlite3_prepare16');
   pointer(sqlite3_prepare16_v2) := GetProcedureAddress(LibHandle,'sqlite3_prepare16_v2');
   pointer(sqlite3_sql) := GetProcedureAddress(LibHandle,'sqlite3_sql');
+  pointer(sqlite3_expanded_sql) := GetProcedureAddress(LibHandle,'sqlite3_expanded_sql');
   pointer(sqlite3_bind_blob) := GetProcedureAddress(LibHandle,'sqlite3_bind_blob');
+  pointer(sqlite3_bind_blob64) := GetProcedureAddress(LibHandle,'sqlite3_bind_blob64');
   pointer(sqlite3_bind_double) := GetProcedureAddress(LibHandle,'sqlite3_bind_double');
   pointer(sqlite3_bind_int) := GetProcedureAddress(LibHandle,'sqlite3_bind_int');
   pointer(sqlite3_bind_int64) := GetProcedureAddress(LibHandle,'sqlite3_bind_int64');
   pointer(sqlite3_bind_null) := GetProcedureAddress(LibHandle,'sqlite3_bind_null');
   pointer(sqlite3_bind_text) := GetProcedureAddress(LibHandle,'sqlite3_bind_text');
+  pointer(sqlite3_bind_text64) := GetProcedureAddress(LibHandle,'sqlite3_bind_text64');
   pointer(sqlite3_bind_text16) := GetProcedureAddress(LibHandle,'sqlite3_bind_text16');
   pointer(sqlite3_bind_value) := GetProcedureAddress(LibHandle,'sqlite3_bind_value');
   pointer(sqlite3_bind_zeroblob) := GetProcedureAddress(LibHandle,'sqlite3_bind_zeroblob');
+  pointer(sqlite3_bind_zeroblob64) := GetProcedureAddress(LibHandle,'sqlite3_bind_zeroblob64');
   pointer(sqlite3_bind_parameter_count) := GetProcedureAddress(LibHandle,'sqlite3_bind_parameter_count');
   pointer(sqlite3_bind_parameter_name) := GetProcedureAddress(LibHandle,'sqlite3_bind_parameter_name');
   pointer(sqlite3_bind_parameter_index) := GetProcedureAddress(LibHandle,'sqlite3_bind_parameter_index');
@@ -1105,6 +1284,7 @@ begin
   pointer(sqlite3_value_text16be) := GetProcedureAddress(LibHandle,'sqlite3_value_text16be');
   pointer(sqlite3_value_type) := GetProcedureAddress(LibHandle,'sqlite3_value_type');
   pointer(sqlite3_value_numeric_type) := GetProcedureAddress(LibHandle,'sqlite3_value_numeric_type');
+  pointer(sqlite3_value_subtype) := GetProcedureAddress(LibHandle,'sqlite3_value_subtype');
   pointer(sqlite3_aggregate_context) := GetProcedureAddress(LibHandle,'sqlite3_aggregate_context');
   pointer(sqlite3_user_data) := GetProcedureAddress(LibHandle,'sqlite3_user_data');
   pointer(sqlite3_context_db_handle) := GetProcedureAddress(LibHandle,'sqlite3_context_db_handle');
@@ -1115,7 +1295,9 @@ begin
   pointer(sqlite3_collation_needed) := GetProcedureAddress(LibHandle,'sqlite3_collation_needed');
   pointer(sqlite3_collation_needed16) := GetProcedureAddress(LibHandle,'sqlite3_collation_needed16');
   pointer(sqlite3_key) := GetProcedureAddress(LibHandle,'sqlite3_key');
+  pointer(sqlite3_key_v2) := GetProcedureAddress(LibHandle,'sqlite3_key_v2');
   pointer(sqlite3_rekey) := GetProcedureAddress(LibHandle,'sqlite3_rekey');
+  pointer(sqlite3_rekey_v2) := GetProcedureAddress(LibHandle,'sqlite3_rekey_v2');
   pointer(sqlite3_sleep) := GetProcedureAddress(LibHandle,'sqlite3_sleep');
   pointer(sqlite3_get_autocommit) := GetProcedureAddress(LibHandle,'sqlite3_get_autocommit');
   pointer(sqlite3_db_handle) := GetProcedureAddress(LibHandle,'sqlite3_db_handle');
@@ -1149,6 +1331,7 @@ begin
   pointer(sqlite3_file_control) := GetProcedureAddress(LibHandle,'sqlite3_file_control');
   pointer(sqlite3_test_control) := GetProcedureAddress(LibHandle,'sqlite3_test_control');
   pointer(sqlite3_status) := GetProcedureAddress(LibHandle,'sqlite3_status');
+  pointer(sqlite3_status64) := GetProcedureAddress(LibHandle,'sqlite3_status64');
   pointer(sqlite3_db_status) := GetProcedureAddress(LibHandle,'sqlite3_db_status');
   pointer(sqlite3_stmt_status) := GetProcedureAddress(LibHandle,'sqlite3_stmt_status');
   pointer(sqlite3_interrupt) := GetProcedureAddress(LibHandle,'sqlite3_interrupt');
@@ -1158,6 +1341,7 @@ begin
   pointer(sqlite3_progress_handler) := GetProcedureAddress(LibHandle,'sqlite3_progress_handler');
   pointer(sqlite3_set_auxdata) := GetProcedureAddress(LibHandle,'sqlite3_set_auxdata');
   pointer(sqlite3_result_blob) := GetProcedureAddress(LibHandle,'sqlite3_result_blob');
+  pointer(sqlite3_result_blob64) := GetProcedureAddress(LibHandle,'sqlite3_result_blob64');
   pointer(sqlite3_result_double) := GetProcedureAddress(LibHandle,'sqlite3_result_double');
   pointer(sqlite3_result_error) := GetProcedureAddress(LibHandle,'sqlite3_result_error');
   pointer(sqlite3_result_error16) := GetProcedureAddress(LibHandle,'sqlite3_result_error16');
@@ -1168,11 +1352,13 @@ begin
   pointer(sqlite3_result_int64) := GetProcedureAddress(LibHandle,'sqlite3_result_int64');
   pointer(sqlite3_result_null) := GetProcedureAddress(LibHandle,'sqlite3_result_null');
   pointer(sqlite3_result_text) := GetProcedureAddress(LibHandle,'sqlite3_result_text');
+  pointer(sqlite3_result_text64) := GetProcedureAddress(LibHandle,'sqlite3_result_text64');
   pointer(sqlite3_result_text16) := GetProcedureAddress(LibHandle,'sqlite3_result_text16');
   pointer(sqlite3_result_text16le) := GetProcedureAddress(LibHandle,'sqlite3_result_text16le');
   pointer(sqlite3_result_text16be) := GetProcedureAddress(LibHandle,'sqlite3_result_text16be');
   pointer(sqlite3_result_value) := GetProcedureAddress(LibHandle,'sqlite3_result_value');
   pointer(sqlite3_result_zeroblob) := GetProcedureAddress(LibHandle,'sqlite3_result_zeroblob');
+  pointer(sqlite3_result_zeroblob64) := GetProcedureAddress(LibHandle,'sqlite3_result_zeroblob64');
   pointer(sqlite3_soft_heap_limit) := GetProcedureAddress(LibHandle,'sqlite3_soft_heap_limit');
   pointer(sqlite3_soft_heap_limit64) := GetProcedureAddress(LibHandle,'sqlite3_soft_heap_limit64');
   pointer(sqlite3_reset_auto_extension) := GetProcedureAddress(LibHandle,'sqlite3_reset_auto_extension');
@@ -1190,7 +1376,7 @@ begin
   pointer(sqlite3_wal_autocheckpoint) := GetProcedureAddress(LibHandle,'sqlite3_wal_autocheckpoint');
   pointer(sqlite3_wal_checkpoint) := GetProcedureAddress(LibHandle,'sqlite3_wal_checkpoint');
   pointer(sqlite3_wal_checkpoint_v2) := GetProcedureAddress(LibHandle,'sqlite3_wal_checkpoint_v2');
-  
+  pointer(sqlite3_strlike) := GetProcedureAddress(LibHandle,'sqlite3_strlike');
    
   pointer(sqlite3_initialize) := GetProcedureAddress(LibHandle,'sqlite3_initialize');
   pointer(sqlite3_shutdown) := GetProcedureAddress(LibHandle,'sqlite3_shutdown');
diff --git a/packages/univint/src/CFBase.pas b/packages/univint/src/CFBase.pas
index f5f1f7a775..a35bb8112e 100644
--- a/packages/univint/src/CFBase.pas
+++ b/packages/univint/src/CFBase.pas
@@ -399,7 +399,7 @@ type
 	CFPropertyListRef = CFTypeRef;
 
 { Values returned from comparison functions }
-	CFComparisonResult = SInt32;
+	CFComparisonResult = CFIndex;
 const
 	kCFCompareLessThan = -1;
 	kCFCompareEqualTo = 0;
diff --git a/packages/winunits-base/src/commctrl.pp b/packages/winunits-base/src/commctrl.pp
index f2ce6d294e..679093e886 100644
--- a/packages/winunits-base/src/commctrl.pp
+++ b/packages/winunits-base/src/commctrl.pp
@@ -8414,7 +8414,7 @@ TYPE
 CONST
          MCN_GETDAYSTATE                = (MCN_FIRST + 3);
 
-// MCN_SELECT is sent whenever a selection has occured (via mouse or keyboard)
+// MCN_SELECT is sent whenever a selection has occurred (via mouse or keyboard)
 //
 TYPE
 
diff --git a/packages/winunits-base/src/dwmapi.pp b/packages/winunits-base/src/dwmapi.pp
index 8a8f14d648..d0d7c3e55b 100644
--- a/packages/winunits-base/src/dwmapi.pp
+++ b/packages/winunits-base/src/dwmapi.pp
@@ -239,7 +239,7 @@ type
     cFramesAvailable: DWM_FRAME_COUNT;
 
     // number of rendered frames that were never
-    // displayed because composition occured too late
+    // displayed because composition occurred too late
     cFramesDropped: DWM_FRAME_COUNT;
 
     // number of times an old frame was composed
diff --git a/packages/winunits-base/src/eventsink.pp b/packages/winunits-base/src/eventsink.pp
index 48040a9150..91b1f19a3c 100644
--- a/packages/winunits-base/src/eventsink.pp
+++ b/packages/winunits-base/src/eventsink.pp
@@ -28,7 +28,7 @@ unit EventSink;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 interface
diff --git a/packages/winunits-base/src/mmsystem.pp b/packages/winunits-base/src/mmsystem.pp
index d7c103199d..7c7e6ba1d3 100644
--- a/packages/winunits-base/src/mmsystem.pp
+++ b/packages/winunits-base/src/mmsystem.pp
@@ -1540,9 +1540,9 @@ Type
                                 dwControlID: DWORD;
                                 cChannels: DWORD;
                                 Case Integer Of
-                                  0: (hwndOwner: tHandle);
-                                  1: (cMultipleItems, cbDetails: DWORD;
+                                  0: (hwndOwner: tHandle; cbDetails: DWORD;
                                       paDetails: Pointer);
+                                  1: (cMultipleItems:DWORD);
 				 End;
  MIXERCONTROLDETAILS   = tMIXERCONTROLDETAILS;
  PMIXERCONTROLDETAILS  = ^tMIXERCONTROLDETAILS;
diff --git a/packages/winunits-base/src/richedit.pp b/packages/winunits-base/src/richedit.pp
index 98d867c9df..ee8c19c819 100644
--- a/packages/winunits-base/src/richedit.pp
+++ b/packages/winunits-base/src/richedit.pp
@@ -156,6 +156,7 @@ Const
     EM_SETPAGE         = (WM_USER + 229);
     EM_GETHYPHENATEINFO= (WM_USER + 230);
     EM_SETHYPHENATEINFO= (WM_USER + 231);
+    EM_INSERTTABLE     = (WM_USER + 232);
     EM_GETAUTOCORRECTPROC   = (WM_USER + 233);
     EM_SETAUTOCORRECTPROC   = (WM_USER + 234);
     EM_CALLAUTOCORRECTPROC  = (WM_USER + 255);
diff --git a/packages/winunits-base/src/typelib.pas b/packages/winunits-base/src/typelib.pas
index b5e2bf7438..7adefa9819 100644
--- a/packages/winunits-base/src/typelib.pas
+++ b/packages/winunits-base/src/typelib.pas
@@ -31,7 +31,7 @@ unit typelib;
 
   You should have received a copy of the GNU Library General Public License
   along with this library; if not, write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 interface
@@ -394,7 +394,8 @@ begin
         if RegQueryValue(Handle,nil,@sRefSrc[1],@il) = ERROR_SUCCESS then
           begin
           SetLength(sRefSrc,il-1);  // includes null terminator
-          if not FDependencies.Find(sRefSrc,i) then
+          i:=FDependencies.Indexof(sRefSrc);
+          if i < 0 Then
             FDependencies.Add(sRefSrc);
           end
         else
@@ -585,7 +586,7 @@ begin
     //get calling convention
     if FD^.callconv=CC_STDCALL then
       begin
-      if lowercase(BstrNameRef)='iunknown' then
+      if not (bIsDispatch or ((TA^.wTypeFlags and TYPEFLAG_FDUAL)=TYPEFLAG_FDUAL)) then
         sConv:='stdcall'
       else
         sConv:='safecall';
diff --git a/packages/winunits-jedi/src/jwaimagehlp.pas b/packages/winunits-jedi/src/jwaimagehlp.pas
index b55f87991d..9ad941ac41 100644
--- a/packages/winunits-jedi/src/jwaimagehlp.pas
+++ b/packages/winunits-jedi/src/jwaimagehlp.pas
@@ -2162,7 +2162,7 @@ type
 // The exception information stream contains the id of the thread that caused
 // the exception (ThreadId), the exception record for the exception
 // (ExceptionRecord) and an RVA to the thread context where the exception
-// occured.
+// occurred.
 //
 
   PMINIDUMP_EXCEPTION_STREAM = ^MINIDUMP_EXCEPTION_STREAM;
diff --git a/packages/winunits-jedi/src/jwawinbase.pas b/packages/winunits-jedi/src/jwawinbase.pas
index d6ec167396..3a4df5aeac 100644
--- a/packages/winunits-jedi/src/jwawinbase.pas
+++ b/packages/winunits-jedi/src/jwawinbase.pas
@@ -1361,7 +1361,7 @@ const
   {$EXTERNALSYM EV_ERR}
   EV_RING     = $0100; // Ring signal detected
   {$EXTERNALSYM EV_RING}
-  EV_PERR     = $0200; // Printer error occured
+  EV_PERR     = $0200; // Printer error occurred
   {$EXTERNALSYM EV_PERR}
   EV_RX80FULL = $0400; // Receive buffer is 80 percent full
   {$EXTERNALSYM EV_RX80FULL}
diff --git a/packages/winunits-jedi/src/jwawincrypt.pas b/packages/winunits-jedi/src/jwawincrypt.pas
index ac1d4c1b44..22618548f4 100644
--- a/packages/winunits-jedi/src/jwawincrypt.pas
+++ b/packages/winunits-jedi/src/jwawincrypt.pas
@@ -19863,9 +19863,9 @@ function CertVerifyCertificateChainPolicy; external crypt32 name 'CertVerifyCert
 function CryptBinaryToStringA; external crypt32 name 'CryptBinaryToStringA';
 function CryptBinaryToStringW; external crypt32 name 'CryptBinaryToStringW';
 function CryptBinaryToString; external crypt32 name 'CryptBinaryToString' + AWSuffix;
-function CryptStringToBinaryA; external crypt32 name 'CryptToStringBinaryA';
-function CryptStringToBinaryW; external crypt32 name 'CryptToStringBinaryW';
-function CryptStringToBinary; external crypt32 name 'CryptToStringBinary' + AWSuffix;
+function CryptStringToBinaryA; external crypt32 name 'CryptStringToBinaryA';
+function CryptStringToBinaryW; external crypt32 name 'CryptStringToBinaryW';
+function CryptStringToBinary; external crypt32 name 'CryptStringToBinary' + AWSuffix;
 
 {$ENDIF DYNAMIC_LINK}
 {$ENDIF JWA_INTERFACESECTION}
diff --git a/packages/winunits-jedi/src/jwawinioctl.pas b/packages/winunits-jedi/src/jwawinioctl.pas
index 65b83a46c6..4785c2850f 100644
--- a/packages/winunits-jedi/src/jwawinioctl.pas
+++ b/packages/winunits-jedi/src/jwawinioctl.pas
@@ -2005,7 +2005,7 @@ type
 //                                                   //
 // The following structures define disk performance  //
 // statistics: specifically the locations of all the //
-// reads and writes which have occured on the disk.  //
+// reads and writes which have occurred on the disk.  //
 //                                                   //
 // To use these structures, you must issue an IOCTL_ //
 // DISK_HIST_STRUCTURE (with a DISK_HISTOGRAM) to    //
diff --git a/packages/winunits-jedi/src/jwawinwlx.pas b/packages/winunits-jedi/src/jwawinwlx.pas
index c11129140f..2585bf350e 100644
--- a/packages/winunits-jedi/src/jwawinwlx.pas
+++ b/packages/winunits-jedi/src/jwawinwlx.pas
@@ -112,7 +112,7 @@ const
 //          DLL whether this constitutes a workstation locking event.
 //
 //      SCRNSVR_ACTIVITY - used to indicate that keyboard or mouse
-//          activity occured while a secure screensaver was active.
+//          activity occurred while a secure screensaver was active.
 //
 //      SC_INSERT - used to indicate that a smart card has been inserted
 //          to a compatible device
diff --git a/packages/x11/fpmake.pp b/packages/x11/fpmake.pp
index e6d0646068..7c7cb4efa8 100644
--- a/packages/x11/fpmake.pp
+++ b/packages/x11/fpmake.pp
@@ -27,6 +27,10 @@ begin
 
     T:=P.Targets.AddUnit('cursorfont.pp');
     T:=P.Targets.AddUnit('keysym.pp');
+    T:=P.Targets.AddUnit('deckeysym.pp');
+    T:=P.Targets.AddUnit('hpkeysym.pp');
+    T:=P.Targets.AddUnit('sunkeysym.pp');
+    T:=P.Targets.AddUnit('xf86keysym.pp');
     T:=P.Targets.AddUnit('xatom.pp');
     T:=P.Targets.AddUnit('xcms.pp');
       with T.Dependencies do
diff --git a/packages/x11/src/deckeysym.pp b/packages/x11/src/deckeysym.pp
new file mode 100644
index 0000000000..0dedddf2d0
--- /dev/null
+++ b/packages/x11/src/deckeysym.pp
@@ -0,0 +1,72 @@
+(***********************************************************
+
+Copyright 1988, 1998  The Open Group
+
+Permission to use, copy, modify, distribute, and sell this software and its
+documentation for any purpose is hereby granted without fee, provided that
+the above copyright notice appear in all copies and that both that
+copyright notice and this permission notice appear in supporting
+documentation.
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+OPEN GROUP BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of The Open Group shall not be
+used in advertising or otherwise to promote the sale, use or other dealings
+in this Software without prior written authorization from The Open Group.
+
+
+Copyright 1988 by Digital Equipment Corporation, Maynard, Massachusetts.
+
+                        All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its 
+documentation for any purpose and without fee is hereby granted, 
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in 
+supporting documentation, and that the name of Digital not be
+used in advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.  
+
+DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+******************************************************************)
+
+unit deckeysym;
+
+interface
+
+{*
+ * DEC private keysyms
+ * (29th bit set)
+ *}
+
+{ two-key compose sequence initiators, chosen to map to Latin1 characters }
+const
+  DXK_ring_accent       = $1000FEB0;
+  DXK_circumflex_accent = $1000FE5E;
+  DXK_cedilla_accent    = $1000FE2C;
+  DXK_acute_accent      = $1000FE27;
+  DXK_grave_accent      = $1000FE60;
+  DXK_tilde             = $1000FE7E;
+  DXK_diaeresis         = $1000FE22;
+
+{ special keysym for LK2** "Remove" key on editing keypad }
+
+  DXK_Remove	        = $1000FF00;   { Remove }
+
+implementation
+end.
diff --git a/packages/x11/src/hpkeysym.pp b/packages/x11/src/hpkeysym.pp
new file mode 100644
index 0000000000..dd5c4c2ce0
--- /dev/null
+++ b/packages/x11/src/hpkeysym.pp
@@ -0,0 +1,166 @@
+(*
+
+Copyright 1987, 1998  The Open Group
+
+Permission to use, copy, modify, distribute, and sell this software and its
+documentation for any purpose is hereby granted without fee, provided that
+the above copyright notice appear in all copies and that both that
+copyright notice and this permission notice appear in supporting
+documentation.
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE OPEN GROUP BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of The Open Group shall
+not be used in advertising or otherwise to promote the sale, use or
+other dealings in this Software without prior written authorization
+from The Open Group.
+
+Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
+
+                        All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Hewlett Packard
+or Digital not be
+used in advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+HEWLETT-PACKARD MAKES NO WARRANTY OF ANY KIND WITH REGARD
+TO THIS SOFWARE, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  Hewlett-Packard shall not be liable for errors
+contained herein or direct, indirect, special, incidental or
+consequential damages in connection with the furnishing,
+performance, or use of this material.
+
+*)
+
+unit hpkeysym;
+
+interface
+
+const
+  hpXK_ClearLine        = $1000FF6F;
+  hpXK_InsertLine       = $1000FF70;
+  hpXK_DeleteLine       = $1000FF71;
+  hpXK_InsertChar       = $1000FF72;
+  hpXK_DeleteChar       = $1000FF73;
+  hpXK_BackTab          = $1000FF74;
+  hpXK_KP_BackTab       = $1000FF75;
+  hpXK_Modelock1        = $1000FF48;
+  hpXK_Modelock2        = $1000FF49;
+  hpXK_Reset            = $1000FF6C;
+  hpXK_System           = $1000FF6D;
+  hpXK_User             = $1000FF6E;
+  hpXK_mute_acute       = $100000A8;
+  hpXK_mute_grave       = $100000A9;
+  hpXK_mute_asciicircum = $100000AA;
+  hpXK_mute_diaeresis   = $100000AB;
+  hpXK_mute_asciitilde  = $100000AC;
+  hpXK_lira             = $100000AF;
+  hpXK_guilder          = $100000BE;
+  hpXK_Ydiaeresis       = $100000EE;
+  hpXK_IO               = $100000EE;
+  hpXK_longminus        = $100000F6;
+  hpXK_block            = $100000FC;
+
+
+//#ifndef _OSF_Keysyms
+//#define _OSF_Keysyms
+
+  osfXK_Copy         = $1004FF02;
+  osfXK_Cut          = $1004FF03;
+  osfXK_Paste        = $1004FF04;
+  osfXK_BackTab      = $1004FF07;
+  osfXK_BackSpace    = $1004FF08;
+  osfXK_Clear        = $1004FF0B;
+  osfXK_Escape       = $1004FF1B;
+  osfXK_AddMode      = $1004FF31;
+  osfXK_PrimaryPaste = $1004FF32;
+  osfXK_QuickPaste   = $1004FF33;
+  osfXK_PageLeft     = $1004FF40;
+  osfXK_PageUp       = $1004FF41;
+  osfXK_PageDown     = $1004FF42;
+  osfXK_PageRight    = $1004FF43;
+  osfXK_Activate     = $1004FF44;
+  osfXK_MenuBar      = $1004FF45;
+  osfXK_Left         = $1004FF51;
+  osfXK_Up           = $1004FF52;
+  osfXK_Right        = $1004FF53;
+  osfXK_Down         = $1004FF54;
+  osfXK_EndLine      = $1004FF57;
+  osfXK_BeginLine    = $1004FF58;
+  osfXK_EndData      = $1004FF59;
+  osfXK_BeginData    = $1004FF5A;
+  osfXK_PrevMenu     = $1004FF5B;
+  osfXK_NextMenu     = $1004FF5C;
+  osfXK_PrevField    = $1004FF5D;
+  osfXK_NextField    = $1004FF5E;
+  osfXK_Select       = $1004FF60;
+  osfXK_Insert       = $1004FF63;
+  osfXK_Undo         = $1004FF65;
+  osfXK_Menu         = $1004FF67;
+  osfXK_Cancel       = $1004FF69;
+  osfXK_Help         = $1004FF6A;
+  osfXK_SelectAll    = $1004FF71;
+  osfXK_DeselectAll  = $1004FF72;
+  osfXK_Reselect     = $1004FF73;
+  osfXK_Extend       = $1004FF74;
+  osfXK_Restore      = $1004FF78;
+  osfXK_Delete       = $1004FFFF;
+
+//#endif /* _OSF_Keysyms */
+
+
+(**************************************************************
+ * The use of the following macros is deprecated.
+ * They are listed below only for backwards compatibility.
+ *)
+  XK_Reset            = $1000FF6C;
+  XK_System           = $1000FF6D;
+  XK_User             = $1000FF6E;
+  XK_ClearLine        = $1000FF6F;
+  XK_InsertLine       = $1000FF70;
+  XK_DeleteLine       = $1000FF71;
+  XK_InsertChar       = $1000FF72;
+  XK_DeleteChar       = $1000FF73;
+  XK_BackTab          = $1000FF74;
+  XK_KP_BackTab       = $1000FF75;
+  XK_Ext16bit_L       = $1000FF76;
+  XK_Ext16bit_R       = $1000FF77;
+  XK_mute_acute       = $100000a8;
+  XK_mute_grave       = $100000a9;
+  XK_mute_asciicircum = $100000aa;
+  XK_mute_diaeresis   = $100000ab;
+  XK_mute_asciitilde  = $100000ac;
+  XK_lira             = $100000af;
+  XK_guilder          = $100000be;
+//#ifndef XK_Ydiaeresis
+  XK_Ydiaeresis       = $100000ee;
+//#endif
+  XK_IO               = $100000ee;
+  XK_longminus        = $100000f6;
+  XK_block            = $100000fc;
+
+implementation
+end.
diff --git a/packages/x11/src/keysym.pp b/packages/x11/src/keysym.pp
index 0ab8ccd4ca..171b2662ae 100644
--- a/packages/x11/src/keysym.pp
+++ b/packages/x11/src/keysym.pp
@@ -40,6 +40,9 @@ Interface
 {$DEFINE XK_CAUCASUS}
 {$DEFINE XK_VIETNAMESE}
 {$DEFINE XK_CURRENCY}
+{$DEFINE XK_MATHEMATICAL}
+{$DEFINE XK_BRAILLE}
+{$DEFINE XK_SINHALA}
 
 Const
   XK_VoidSymbol         = $FFFFFF;      { void symbol }
@@ -260,8 +263,9 @@ Const
 {$ENDIF} { XK_MISCELLANY }
 
 {*
- * ISO 9995 Function and Modifier Keys
- * Byte 3 = = $FE
+ * Keyboard (XKB) Extension function and modifier keys
+ * (from Appendix C of "The X Keyboard Extension: Protocol Specification")
+ * Byte 3 = $FE
  *}
 
 {$IFDEF XK_XKB_KEYS}
@@ -270,6 +274,9 @@ Const
   XK_ISO_Level3_Shift                           = $FE03;
   XK_ISO_Level3_Latch                           = $FE04;
   XK_ISO_Level3_Lock                            = $FE05;
+  XK_ISO_Level5_Shift                           = $FE11;
+  XK_ISO_Level5_Latch                           = $FE12;
+  XK_ISO_Level5_Lock                            = $FE13;
   XK_ISO_Group_Shift                            = $FF7E;        { Alias for mode_switch }
   XK_ISO_Group_Latch                            = $FE06;
   XK_ISO_Group_Lock                             = $FE07;
@@ -308,6 +315,7 @@ Const
   XK_dead_acute                                 = $FE51;
   XK_dead_circumflex                            = $FE52;
   XK_dead_tilde                                 = $FE53;
+  XK_dead_perispomeni                           = $FE53;  { alias for dead_tilde }
   XK_dead_macron                                        = $FE54;
   XK_dead_breve                                 = $FE55;
   XK_dead_abovedot                              = $FE56;
@@ -323,6 +331,43 @@ Const
   XK_dead_belowdot                              = $FE60;
   XK_dead_hook                                  = $FE61;
   XK_dead_horn                                  = $FE62;
+  XK_dead_stroke                                = $FE63;
+  XK_dead_abovecomma                            = $FE64;
+  XK_dead_psili                                 = $FE64;  { alias for dead_abovecomma }
+  XK_dead_abovereversedcomma                    = $FE65;
+  XK_dead_dasia                                 = $FE65;  { alias for dead_abovereversedcomma }
+  XK_dead_doublegrave                           = $FE66;
+  XK_dead_belowring                             = $FE67;
+  XK_dead_belowmacron                           = $FE68;
+  XK_dead_belowcircumflex                       = $FE69;
+  XK_dead_belowtilde                            = $FE6A;
+  XK_dead_belowbreve                            = $FE6B;
+  XK_dead_belowdiaeresis                        = $FE6C;
+  XK_dead_invertedbreve                         = $FE6D;
+  XK_dead_belowcomma                            = $FE6E;
+  XK_dead_currency                              = $FE6F;
+
+{ extra dead elements for German T3 layout }
+  XK_dead_lowline                               = $FE90;
+  XK_dead_aboveverticalline                     = $FE91;
+  XK_dead_belowverticalline                     = $FE92;
+  XK_dead_longsolidusoverlay                    = $FE93;
+
+{ dead vowels for universal syllable entry }
+  XK_dead_a                                     = $FE80;
+  XKc_dead_A                                    = $FE81;
+  XK_dead_e                                     = $FE82;
+  XKc_dead_E                                    = $FE83;
+  XK_dead_i                                     = $FE84;
+  XKc_dead_I                                    = $FE85;
+  XK_dead_o                                     = $FE86;
+  XKc_dead_O                                    = $FE87;
+  XK_dead_u                                     = $FE88;
+  XKc_dead_U                                    = $FE89;
+  XK_dead_small_schwa                           = $FE8A;
+  XK_dead_capital_schwa                         = $FE8B;
+
+  XK_dead_greek                                 = $FE8C;
 
   XK_First_Virtual_Screen                               = $FED0;
   XK_Prev_Virtual_Screen                                = $FED1;
@@ -374,6 +419,15 @@ Const
   XK_Pointer_DfltBtnNext                                = $FEFB;
   XK_Pointer_DfltBtnPrev                                = $FEFC;
 
+{ Single-Stroke Multiple-Character N-Graph Keysyms For The X Input Method }
+
+  XKll_ch                                       = $FEA0;
+  XKcl_Ch                                       = $FEA1;
+  XKcc_CH                                       = $FEA2;
+  XKll_c_h                                      = $FEA3;
+  XKcl_C_h                                      = $FEA4;
+  XKcc_C_H                                      = $FEA5;
+
 {$ENDIF}
 
 {*
@@ -415,390 +469,390 @@ Const
 {$ENDIF}
 
 {*
- *  Latin 1
- *  Byte 3 = 0
+ * Latin 1
+ * (ISO/IEC 8859-1 = Unicode U+0020..U+00FF)
+ * Byte 3 = 0
  *}
 {$IFDEF XK_LATIN1}
-  XK_space               = $020;
-  XK_exclam              = $021;
-  XK_quotedbl            = $022;
-  XK_numbersign          = $023;
-  XK_dollar              = $024;
-  XK_percent             = $025;
-  XK_ampersand           = $026;
-  XK_apostrophe          = $027;
-  XK_quoteright          = $027;        { deprecated }
-  XK_parenleft           = $028;
-  XK_parenright          = $029;
-  XK_asterisk            = $02a;
-  XK_plus                = $02b;
-  XK_comma               = $02c;
-  XK_minus               = $02d;
-  XK_period              = $02e;
-  XK_slash               = $02f;
-  XK_0                   = $030;
-  XK_1                   = $031;
-  XK_2                   = $032;
-  XK_3                   = $033;
-  XK_4                   = $034;
-  XK_5                   = $035;
-  XK_6                   = $036;
-  XK_7                   = $037;
-  XK_8                   = $038;
-  XK_9                   = $039;
-  XK_colon               = $03a;
-  XK_semicolon           = $03b;
-  XK_less                = $03c;
-  XK_equal               = $03d;
-  XK_greater             = $03e;
-  XK_question            = $03f;
-  XK_at                  = $040;
-  XKc_A                   = $041;
-  XKc_B                   = $042;
-  XKc_C                   = $043;
-  XKc_D                   = $044;
-  XKc_E                   = $045;
-  XKc_F                   = $046;
-  XKc_G                   = $047;
-  XKc_H                   = $048;
-  XKc_I                   = $049;
-  XKc_J                   = $04a;
-  XKc_K                   = $04b;
-  XKc_L                   = $04c;
-  XKc_M                   = $04d;
-  XKc_N                   = $04e;
-  XKc_O                   = $04f;
-  XKc_P                   = $050;
-  XKc_Q                   = $051;
-  XKc_R                   = $052;
-  XKc_S                   = $053;
-  XKc_T                   = $054;
-  XKc_U                   = $055;
-  XKc_V                   = $056;
-  XKc_W                   = $057;
-  XKc_X                   = $058;
-  XKc_Y                   = $059;
-  XKc_Z                   = $05a;
-  XK_bracketleft         = $05b;
-  XK_backslash           = $05c;
-  XK_bracketright        = $05d;
-  XK_asciicircum         = $05e;
-  XK_underscore          = $05f;
-  XK_grave               = $060;
-  XK_quoteleft           = $060;        { deprecated }
-  XK_a                   = $061;
-  XK_b                   = $062;
-  XK_c                   = $063;
-  XK_d                   = $064;
-  XK_e                   = $065;
-  XK_f                   = $066;
-  XK_g                   = $067;
-  XK_h                   = $068;
-  XK_i                   = $069;
-  XK_j                   = $06a;
-  XK_k                   = $06b;
-  XK_l                   = $06c;
-  XK_m                   = $06d;
-  XK_n                   = $06e;
-  XK_o                   = $06f;
-  XK_p                   = $070;
-  XK_q                   = $071;
-  XK_r                   = $072;
-  XK_s                   = $073;
-  XK_t                   = $074;
-  XK_u                   = $075;
-  XK_v                   = $076;
-  XK_w                   = $077;
-  XK_x                   = $078;
-  XK_y                   = $079;
-  XK_z                   = $07a;
-  XK_braceleft           = $07b;
-  XK_bar                 = $07c;
-  XK_braceright          = $07d;
-  XK_asciitilde          = $07e;
-
-  XK_nobreakspace        = $0a0;
-  XK_exclamdown          = $0a1;
-  XK_cent                = $0a2;
-  XK_sterling            = $0a3;
-  XK_currency            = $0a4;
-  XK_yen                 = $0a5;
-  XK_brokenbar           = $0a6;
-  XK_section             = $0a7;
-  XK_diaeresis           = $0a8;
-  XK_copyright           = $0a9;
-  XK_ordfeminine         = $0aa;
-  XK_guillemotleft       = $0ab;        { left angle quotation mark }
-  XK_notsign             = $0ac;
-  XK_hyphen              = $0ad;
-  XK_registered          = $0ae;
-  XK_macron              = $0af;
-  XK_degree              = $0b0;
-  XK_plusminus           = $0b1;
-  XK_twosuperior         = $0b2;
-  XK_threesuperior       = $0b3;
-  XK_acute               = $0b4;
-  XK_mu                  = $0b5;
-  XK_paragraph           = $0b6;
-  XK_periodcentered      = $0b7;
-  XK_cedilla             = $0b8;
-  XK_onesuperior         = $0b9;
-  XK_masculine           = $0ba;
-  XK_guillemotright      = $0bb;        { right angle quotation mark }
-  XK_onequarter          = $0bc;
-  XK_onehalf             = $0bd;
-  XK_threequarters       = $0be;
-  XK_questiondown        = $0bf;
-  XKc_Agrave              = $0c0;
-  XKc_Aacute              = $0c1;
-  XKc_Acircumflex         = $0c2;
-  XKc_Atilde              = $0c3;
-  XKc_Adiaeresis          = $0c4;
-  XKc_Aring               = $0c5;
-  XKc_AE                  = $0c6;
-  XKc_Ccedilla            = $0c7;
-  XKc_Egrave              = $0c8;
-  XKc_Eacute              = $0c9;
-  XKc_Ecircumflex         = $0ca;
-  XKc_Ediaeresis          = $0cb;
-  XKc_Igrave              = $0cc;
-  XKc_Iacute              = $0cd;
-  XKc_Icircumflex         = $0ce;
-  XKc_Idiaeresis          = $0cf;
-  XKc_ETH                 = $0d0;
-  XKc_Ntilde              = $0d1;
-  XKc_Ograve              = $0d2;
-  XKc_Oacute              = $0d3;
-  XKc_Ocircumflex         = $0d4;
-  XKc_Otilde              = $0d5;
-  XKc_Odiaeresis          = $0d6;
-  XK_multiply            = $0d7;
-  XKc_Ooblique            = $0d8;
-  XKc_Oslash              = XKc_Ooblique;
-  XKc_Ugrave              = $0d9;
-  XKc_Uacute              = $0da;
-  XKc_Ucircumflex         = $0db;
-  XKc_Udiaeresis          = $0dc;
-  XKc_Yacute              = $0dd;
-  XKc_THORN               = $0de;
-  XK_ssharp              = $0df;
-  XK_agrave              = $0e0;
-  XK_aacute              = $0e1;
-  XK_acircumflex         = $0e2;
-  XK_atilde              = $0e3;
-  XK_adiaeresis          = $0e4;
-  XK_aring               = $0e5;
-  XK_ae                  = $0e6;
-  XK_ccedilla            = $0e7;
-  XK_egrave              = $0e8;
-  XK_eacute              = $0e9;
-  XK_ecircumflex         = $0ea;
-  XK_ediaeresis          = $0eb;
-  XK_igrave              = $0ec;
-  XK_iacute              = $0ed;
-  XK_icircumflex         = $0ee;
-  XK_idiaeresis          = $0ef;
-  XK_eth                 = $0f0;
-  XK_ntilde              = $0f1;
-  XK_ograve              = $0f2;
-  XK_oacute              = $0f3;
-  XK_ocircumflex         = $0f4;
-  XK_otilde              = $0f5;
-  XK_odiaeresis          = $0f6;
-  XK_division            = $0f7;
-  XK_oslash              = $0f8;
-  XK_ooblique            = XK_oslash;
-  XK_ugrave              = $0f9;
-  XK_uacute              = $0fa;
-  XK_ucircumflex         = $0fb;
-  XK_udiaeresis          = $0fc;
-  XK_yacute              = $0fd;
-  XK_thorn               = $0fe;
-  XK_ydiaeresis          = $0ff;
+  XK_space               = $0020;  { U+0020 SPACE }
+  XK_exclam              = $0021;  { U+0021 EXCLAMATION MARK }
+  XK_quotedbl            = $0022;  { U+0022 QUOTATION MARK }
+  XK_numbersign          = $0023;  { U+0023 NUMBER SIGN }
+  XK_dollar              = $0024;  { U+0024 DOLLAR SIGN }
+  XK_percent             = $0025;  { U+0025 PERCENT SIGN }
+  XK_ampersand           = $0026;  { U+0026 AMPERSAND }
+  XK_apostrophe          = $0027;  { U+0027 APOSTROPHE }
+  XK_quoteright          = $0027;  { deprecated }
+  XK_parenleft           = $0028;  { U+0028 LEFT PARENTHESIS }
+  XK_parenright          = $0029;  { U+0029 RIGHT PARENTHESIS }
+  XK_asterisk            = $002a;  { U+002A ASTERISK }
+  XK_plus                = $002b;  { U+002B PLUS SIGN }
+  XK_comma               = $002c;  { U+002C COMMA }
+  XK_minus               = $002d;  { U+002D HYPHEN-MINUS }
+  XK_period              = $002e;  { U+002E FULL STOP }
+  XK_slash               = $002f;  { U+002F SOLIDUS }
+  XK_0                   = $0030;  { U+0030 DIGIT ZERO }
+  XK_1                   = $0031;  { U+0031 DIGIT ONE }
+  XK_2                   = $0032;  { U+0032 DIGIT TWO }
+  XK_3                   = $0033;  { U+0033 DIGIT THREE }
+  XK_4                   = $0034;  { U+0034 DIGIT FOUR }
+  XK_5                   = $0035;  { U+0035 DIGIT FIVE }
+  XK_6                   = $0036;  { U+0036 DIGIT SIX }
+  XK_7                   = $0037;  { U+0037 DIGIT SEVEN }
+  XK_8                   = $0038;  { U+0038 DIGIT EIGHT }
+  XK_9                   = $0039;  { U+0039 DIGIT NINE }
+  XK_colon               = $003a;  { U+003A COLON }
+  XK_semicolon           = $003b;  { U+003B SEMICOLON }
+  XK_less                = $003c;  { U+003C LESS-THAN SIGN }
+  XK_equal               = $003d;  { U+003D EQUALS SIGN }
+  XK_greater             = $003e;  { U+003E GREATER-THAN SIGN }
+  XK_question            = $003f;  { U+003F QUESTION MARK }
+  XK_at                  = $0040;  { U+0040 COMMERCIAL AT }
+  XKc_A                  = $0041;  { U+0041 LATIN CAPITAL LETTER A }
+  XKc_B                  = $0042;  { U+0042 LATIN CAPITAL LETTER B }
+  XKc_C                  = $0043;  { U+0043 LATIN CAPITAL LETTER C }
+  XKc_D                  = $0044;  { U+0044 LATIN CAPITAL LETTER D }
+  XKc_E                  = $0045;  { U+0045 LATIN CAPITAL LETTER E }
+  XKc_F                  = $0046;  { U+0046 LATIN CAPITAL LETTER F }
+  XKc_G                  = $0047;  { U+0047 LATIN CAPITAL LETTER G }
+  XKc_H                  = $0048;  { U+0048 LATIN CAPITAL LETTER H }
+  XKc_I                  = $0049;  { U+0049 LATIN CAPITAL LETTER I }
+  XKc_J                  = $004a;  { U+004A LATIN CAPITAL LETTER J }
+  XKc_K                  = $004b;  { U+004B LATIN CAPITAL LETTER K }
+  XKc_L                  = $004c;  { U+004C LATIN CAPITAL LETTER L }
+  XKc_M                  = $004d;  { U+004D LATIN CAPITAL LETTER M }
+  XKc_N                  = $004e;  { U+004E LATIN CAPITAL LETTER N }
+  XKc_O                  = $004f;  { U+004F LATIN CAPITAL LETTER O }
+  XKc_P                  = $0050;  { U+0050 LATIN CAPITAL LETTER P }
+  XKc_Q                  = $0051;  { U+0051 LATIN CAPITAL LETTER Q }
+  XKc_R                  = $0052;  { U+0052 LATIN CAPITAL LETTER R }
+  XKc_S                  = $0053;  { U+0053 LATIN CAPITAL LETTER S }
+  XKc_T                  = $0054;  { U+0054 LATIN CAPITAL LETTER T }
+  XKc_U                  = $0055;  { U+0055 LATIN CAPITAL LETTER U }
+  XKc_V                  = $0056;  { U+0056 LATIN CAPITAL LETTER V }
+  XKc_W                  = $0057;  { U+0057 LATIN CAPITAL LETTER W }
+  XKc_X                  = $0058;  { U+0058 LATIN CAPITAL LETTER X }
+  XKc_Y                  = $0059;  { U+0059 LATIN CAPITAL LETTER Y }
+  XKc_Z                  = $005a;  { U+005A LATIN CAPITAL LETTER Z }
+  XK_bracketleft         = $005b;  { U+005B LEFT SQUARE BRACKET }
+  XK_backslash           = $005c;  { U+005C REVERSE SOLIDUS }
+  XK_bracketright        = $005d;  { U+005D RIGHT SQUARE BRACKET }
+  XK_asciicircum         = $005e;  { U+005E CIRCUMFLEX ACCENT }
+  XK_underscore          = $005f;  { U+005F LOW LINE }
+  XK_grave               = $0060;  { U+0060 GRAVE ACCENT }
+  XK_quoteleft           = $0060;  { deprecated }
+  XK_a                   = $0061;  { U+0061 LATIN SMALL LETTER A }
+  XK_b                   = $0062;  { U+0062 LATIN SMALL LETTER B }
+  XK_c                   = $0063;  { U+0063 LATIN SMALL LETTER C }
+  XK_d                   = $0064;  { U+0064 LATIN SMALL LETTER D }
+  XK_e                   = $0065;  { U+0065 LATIN SMALL LETTER E }
+  XK_f                   = $0066;  { U+0066 LATIN SMALL LETTER F }
+  XK_g                   = $0067;  { U+0067 LATIN SMALL LETTER G }
+  XK_h                   = $0068;  { U+0068 LATIN SMALL LETTER H }
+  XK_i                   = $0069;  { U+0069 LATIN SMALL LETTER I }
+  XK_j                   = $006a;  { U+006A LATIN SMALL LETTER J }
+  XK_k                   = $006b;  { U+006B LATIN SMALL LETTER K }
+  XK_l                   = $006c;  { U+006C LATIN SMALL LETTER L }
+  XK_m                   = $006d;  { U+006D LATIN SMALL LETTER M }
+  XK_n                   = $006e;  { U+006E LATIN SMALL LETTER N }
+  XK_o                   = $006f;  { U+006F LATIN SMALL LETTER O }
+  XK_p                   = $0070;  { U+0070 LATIN SMALL LETTER P }
+  XK_q                   = $0071;  { U+0071 LATIN SMALL LETTER Q }
+  XK_r                   = $0072;  { U+0072 LATIN SMALL LETTER R }
+  XK_s                   = $0073;  { U+0073 LATIN SMALL LETTER S }
+  XK_t                   = $0074;  { U+0074 LATIN SMALL LETTER T }
+  XK_u                   = $0075;  { U+0075 LATIN SMALL LETTER U }
+  XK_v                   = $0076;  { U+0076 LATIN SMALL LETTER V }
+  XK_w                   = $0077;  { U+0077 LATIN SMALL LETTER W }
+  XK_x                   = $0078;  { U+0078 LATIN SMALL LETTER X }
+  XK_y                   = $0079;  { U+0079 LATIN SMALL LETTER Y }
+  XK_z                   = $007a;  { U+007A LATIN SMALL LETTER Z }
+  XK_braceleft           = $007b;  { U+007B LEFT CURLY BRACKET }
+  XK_bar                 = $007c;  { U+007C VERTICAL LINE }
+  XK_braceright          = $007d;  { U+007D RIGHT CURLY BRACKET }
+  XK_asciitilde          = $007e;  { U+007E TILDE }
+
+  XK_nobreakspace        = $00a0;  { U+00A0 NO-BREAK SPACE }
+  XK_exclamdown          = $00a1;  { U+00A1 INVERTED EXCLAMATION MARK }
+  XK_cent                = $00a2;  { U+00A2 CENT SIGN }
+  XK_sterling            = $00a3;  { U+00A3 POUND SIGN }
+  XK_currency            = $00a4;  { U+00A4 CURRENCY SIGN }
+  XK_yen                 = $00a5;  { U+00A5 YEN SIGN }
+  XK_brokenbar           = $00a6;  { U+00A6 BROKEN BAR }
+  XK_section             = $00a7;  { U+00A7 SECTION SIGN }
+  XK_diaeresis           = $00a8;  { U+00A8 DIAERESIS }
+  XK_copyright           = $00a9;  { U+00A9 COPYRIGHT SIGN }
+  XK_ordfeminine         = $00aa;  { U+00AA FEMININE ORDINAL INDICATOR }
+  XK_guillemotleft       = $00ab;  { U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK }
+  XK_notsign             = $00ac;  { U+00AC NOT SIGN }
+  XK_hyphen              = $00ad;  { U+00AD SOFT HYPHEN }
+  XK_registered          = $00ae;  { U+00AE REGISTERED SIGN }
+  XK_macron              = $00af;  { U+00AF MACRON }
+  XK_degree              = $00b0;  { U+00B0 DEGREE SIGN }
+  XK_plusminus           = $00b1;  { U+00B1 PLUS-MINUS SIGN }
+  XK_twosuperior         = $00b2;  { U+00B2 SUPERSCRIPT TWO }
+  XK_threesuperior       = $00b3;  { U+00B3 SUPERSCRIPT THREE }
+  XK_acute               = $00b4;  { U+00B4 ACUTE ACCENT }
+  XK_mu                  = $00b5;  { U+00B5 MICRO SIGN }
+  XK_paragraph           = $00b6;  { U+00B6 PILCROW SIGN }
+  XK_periodcentered      = $00b7;  { U+00B7 MIDDLE DOT }
+  XK_cedilla             = $00b8;  { U+00B8 CEDILLA }
+  XK_onesuperior         = $00b9;  { U+00B9 SUPERSCRIPT ONE }
+  XK_masculine           = $00ba;  { U+00BA MASCULINE ORDINAL INDICATOR }
+  XK_guillemotright      = $00bb;  { U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK }
+  XK_onequarter          = $00bc;  { U+00BC VULGAR FRACTION ONE QUARTER }
+  XK_onehalf             = $00bd;  { U+00BD VULGAR FRACTION ONE HALF }
+  XK_threequarters       = $00be;  { U+00BE VULGAR FRACTION THREE QUARTERS }
+  XK_questiondown        = $00bf;  { U+00BF INVERTED QUESTION MARK }
+  XKc_Agrave             = $00c0;  { U+00C0 LATIN CAPITAL LETTER A WITH GRAVE }
+  XKc_Aacute             = $00c1;  { U+00C1 LATIN CAPITAL LETTER A WITH ACUTE }
+  XKc_Acircumflex        = $00c2;  { U+00C2 LATIN CAPITAL LETTER A WITH CIRCUMFLEX }
+  XKc_Atilde             = $00c3;  { U+00C3 LATIN CAPITAL LETTER A WITH TILDE }
+  XKc_Adiaeresis         = $00c4;  { U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS }
+  XKc_Aring              = $00c5;  { U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE }
+  XKc_AE                 = $00c6;  { U+00C6 LATIN CAPITAL LETTER AE }
+  XKc_Ccedilla           = $00c7;  { U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA }
+  XKc_Egrave             = $00c8;  { U+00C8 LATIN CAPITAL LETTER E WITH GRAVE }
+  XKc_Eacute             = $00c9;  { U+00C9 LATIN CAPITAL LETTER E WITH ACUTE }
+  XKc_Ecircumflex        = $00ca;  { U+00CA LATIN CAPITAL LETTER E WITH CIRCUMFLEX }
+  XKc_Ediaeresis         = $00cb;  { U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS }
+  XKc_Igrave             = $00cc;  { U+00CC LATIN CAPITAL LETTER I WITH GRAVE }
+  XKc_Iacute             = $00cd;  { U+00CD LATIN CAPITAL LETTER I WITH ACUTE }
+  XKc_Icircumflex        = $00ce;  { U+00CE LATIN CAPITAL LETTER I WITH CIRCUMFLEX }
+  XKc_Idiaeresis         = $00cf;  { U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS }
+  XKc_ETH                = $00d0;  { U+00D0 LATIN CAPITAL LETTER ETH }
+  XKc_Ntilde             = $00d1;  { U+00D1 LATIN CAPITAL LETTER N WITH TILDE }
+  XKc_Ograve             = $00d2;  { U+00D2 LATIN CAPITAL LETTER O WITH GRAVE }
+  XKc_Oacute             = $00d3;  { U+00D3 LATIN CAPITAL LETTER O WITH ACUTE }
+  XKc_Ocircumflex        = $00d4;  { U+00D4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX }
+  XKc_Otilde             = $00d5;  { U+00D5 LATIN CAPITAL LETTER O WITH TILDE }
+  XKc_Odiaeresis         = $00d6;  { U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS }
+  XK_multiply            = $00d7;  { U+00D7 MULTIPLICATION SIGN }
+  XKc_Oslash             = $00d8;  { U+00D8 LATIN CAPITAL LETTER O WITH STROKE }
+  XKc_Ooblique           = $00d8;  { U+00D8 LATIN CAPITAL LETTER O WITH STROKE }
+  XKc_Ugrave             = $00d9;  { U+00D9 LATIN CAPITAL LETTER U WITH GRAVE }
+  XKc_Uacute             = $00da;  { U+00DA LATIN CAPITAL LETTER U WITH ACUTE }
+  XKc_Ucircumflex        = $00db;  { U+00DB LATIN CAPITAL LETTER U WITH CIRCUMFLEX }
+  XKc_Udiaeresis         = $00dc;  { U+00DC LATIN CAPITAL LETTER U WITH DIAERESIS }
+  XKc_Yacute             = $00dd;  { U+00DD LATIN CAPITAL LETTER Y WITH ACUTE }
+  XKc_THORN              = $00de;  { U+00DE LATIN CAPITAL LETTER THORN }
+  XK_ssharp              = $00df;  { U+00DF LATIN SMALL LETTER SHARP S }
+  XK_agrave              = $00e0;  { U+00E0 LATIN SMALL LETTER A WITH GRAVE }
+  XK_aacute              = $00e1;  { U+00E1 LATIN SMALL LETTER A WITH ACUTE }
+  XK_acircumflex         = $00e2;  { U+00E2 LATIN SMALL LETTER A WITH CIRCUMFLEX }
+  XK_atilde              = $00e3;  { U+00E3 LATIN SMALL LETTER A WITH TILDE }
+  XK_adiaeresis          = $00e4;  { U+00E4 LATIN SMALL LETTER A WITH DIAERESIS }
+  XK_aring               = $00e5;  { U+00E5 LATIN SMALL LETTER A WITH RING ABOVE }
+  XK_ae                  = $00e6;  { U+00E6 LATIN SMALL LETTER AE }
+  XK_ccedilla            = $00e7;  { U+00E7 LATIN SMALL LETTER C WITH CEDILLA }
+  XK_egrave              = $00e8;  { U+00E8 LATIN SMALL LETTER E WITH GRAVE }
+  XK_eacute              = $00e9;  { U+00E9 LATIN SMALL LETTER E WITH ACUTE }
+  XK_ecircumflex         = $00ea;  { U+00EA LATIN SMALL LETTER E WITH CIRCUMFLEX }
+  XK_ediaeresis          = $00eb;  { U+00EB LATIN SMALL LETTER E WITH DIAERESIS }
+  XK_igrave              = $00ec;  { U+00EC LATIN SMALL LETTER I WITH GRAVE }
+  XK_iacute              = $00ed;  { U+00ED LATIN SMALL LETTER I WITH ACUTE }
+  XK_icircumflex         = $00ee;  { U+00EE LATIN SMALL LETTER I WITH CIRCUMFLEX }
+  XK_idiaeresis          = $00ef;  { U+00EF LATIN SMALL LETTER I WITH DIAERESIS }
+  XK_eth                 = $00f0;  { U+00F0 LATIN SMALL LETTER ETH }
+  XK_ntilde              = $00f1;  { U+00F1 LATIN SMALL LETTER N WITH TILDE }
+  XK_ograve              = $00f2;  { U+00F2 LATIN SMALL LETTER O WITH GRAVE }
+  XK_oacute              = $00f3;  { U+00F3 LATIN SMALL LETTER O WITH ACUTE }
+  XK_ocircumflex         = $00f4;  { U+00F4 LATIN SMALL LETTER O WITH CIRCUMFLEX }
+  XK_otilde              = $00f5;  { U+00F5 LATIN SMALL LETTER O WITH TILDE }
+  XK_odiaeresis          = $00f6;  { U+00F6 LATIN SMALL LETTER O WITH DIAERESIS }
+  XK_division            = $00f7;  { U+00F7 DIVISION SIGN }
+  XK_oslash              = $00f8;  { U+00F8 LATIN SMALL LETTER O WITH STROKE }
+  XK_ooblique            = $00f8;  { U+00F8 LATIN SMALL LETTER O WITH STROKE }
+  XK_ugrave              = $00f9;  { U+00F9 LATIN SMALL LETTER U WITH GRAVE }
+  XK_uacute              = $00fa;  { U+00FA LATIN SMALL LETTER U WITH ACUTE }
+  XK_ucircumflex         = $00fb;  { U+00FB LATIN SMALL LETTER U WITH CIRCUMFLEX }
+  XK_udiaeresis          = $00fc;  { U+00FC LATIN SMALL LETTER U WITH DIAERESIS }
+  XK_yacute              = $00fd;  { U+00FD LATIN SMALL LETTER Y WITH ACUTE }
+  XK_thorn               = $00fe;  { U+00FE LATIN SMALL LETTER THORN }
+  XK_ydiaeresis          = $00ff;  { U+00FF LATIN SMALL LETTER Y WITH DIAERESIS }
 {$ENDIF} { XK_LATIN1 }
 
 {*
- *   Latin 2
- *   Byte 3 = 1
+ * Latin 2
+ * Byte 3 = 1
  *}
 
 {$IFDEF XK_LATIN2}
-  XKc_Aogonek             = $1a1;
-  XK_breve               = $1a2;
-  XKc_Lstroke             = $1a3;
-  XKc_Lcaron              = $1a5;
-  XKc_Sacute              = $1a6;
-  XKc_Scaron              = $1a9;
-  XKc_Scedilla            = $1aa;
-  XKc_Tcaron              = $1ab;
-  XKc_Zacute              = $1ac;
-  XKc_Zcaron              = $1ae;
-  XKc_Zabovedot           = $1af;
-  XK_aogonek             = $1b1;
-  XK_ogonek              = $1b2;
-  XK_lstroke             = $1b3;
-  XK_lcaron              = $1b5;
-  XK_sacute              = $1b6;
-  XK_caron               = $1b7;
-  XK_scaron              = $1b9;
-  XK_scedilla            = $1ba;
-  XK_tcaron              = $1bb;
-  XK_zacute              = $1bc;
-  XK_doubleacute         = $1bd;
-  XK_zcaron              = $1be;
-  XK_zabovedot           = $1bf;
-  XKc_Racute              = $1c0;
-  XKc_Abreve              = $1c3;
-  XKc_Lacute              = $1c5;
-  XKc_Cacute              = $1c6;
-  XKc_Ccaron              = $1c8;
-  XKc_Eogonek             = $1ca;
-  XKc_Ecaron              = $1cc;
-  XKc_Dcaron              = $1cf;
-  XKc_Dstroke             = $1d0;
-  XKc_Nacute              = $1d1;
-  XKc_Ncaron              = $1d2;
-  XKc_Odoubleacute        = $1d5;
-  XKc_Rcaron              = $1d8;
-  XKc_Uring               = $1d9;
-  XKc_Udoubleacute        = $1db;
-  XKc_Tcedilla            = $1de;
-  XK_racute              = $1e0;
-  XK_abreve              = $1e3;
-  XK_lacute              = $1e5;
-  XK_cacute              = $1e6;
-  XK_ccaron              = $1e8;
-  XK_eogonek             = $1ea;
-  XK_ecaron              = $1ec;
-  XK_dcaron              = $1ef;
-  XK_dstroke             = $1f0;
-  XK_nacute              = $1f1;
-  XK_ncaron              = $1f2;
-  XK_odoubleacute        = $1f5;
-  XK_udoubleacute        = $1fb;
-  XK_rcaron              = $1f8;
-  XK_uring               = $1f9;
-  XK_tcedilla            = $1fe;
-  XK_abovedot            = $1ff;
+  XKc_Aogonek            = $01a1;  { U+0104 LATIN CAPITAL LETTER A WITH OGONEK }
+  XK_breve               = $01a2;  { U+02D8 BREVE }
+  XKc_Lstroke            = $01a3;  { U+0141 LATIN CAPITAL LETTER L WITH STROKE }
+  XKc_Lcaron             = $01a5;  { U+013D LATIN CAPITAL LETTER L WITH CARON }
+  XKc_Sacute             = $01a6;  { U+015A LATIN CAPITAL LETTER S WITH ACUTE }
+  XKc_Scaron             = $01a9;  { U+0160 LATIN CAPITAL LETTER S WITH CARON }
+  XKc_Scedilla           = $01aa;  { U+015E LATIN CAPITAL LETTER S WITH CEDILLA }
+  XKc_Tcaron             = $01ab;  { U+0164 LATIN CAPITAL LETTER T WITH CARON }
+  XKc_Zacute             = $01ac;  { U+0179 LATIN CAPITAL LETTER Z WITH ACUTE }
+  XKc_Zcaron             = $01ae;  { U+017D LATIN CAPITAL LETTER Z WITH CARON }
+  XKc_Zabovedot          = $01af;  { U+017B LATIN CAPITAL LETTER Z WITH DOT ABOVE }
+  XK_aogonek             = $01b1;  { U+0105 LATIN SMALL LETTER A WITH OGONEK }
+  XK_ogonek              = $01b2;  { U+02DB OGONEK }
+  XK_lstroke             = $01b3;  { U+0142 LATIN SMALL LETTER L WITH STROKE }
+  XK_lcaron              = $01b5;  { U+013E LATIN SMALL LETTER L WITH CARON }
+  XK_sacute              = $01b6;  { U+015B LATIN SMALL LETTER S WITH ACUTE }
+  XK_caron               = $01b7;  { U+02C7 CARON }
+  XK_scaron              = $01b9;  { U+0161 LATIN SMALL LETTER S WITH CARON }
+  XK_scedilla            = $01ba;  { U+015F LATIN SMALL LETTER S WITH CEDILLA }
+  XK_tcaron              = $01bb;  { U+0165 LATIN SMALL LETTER T WITH CARON }
+  XK_zacute              = $01bc;  { U+017A LATIN SMALL LETTER Z WITH ACUTE }
+  XK_doubleacute         = $01bd;  { U+02DD DOUBLE ACUTE ACCENT }
+  XK_zcaron              = $01be;  { U+017E LATIN SMALL LETTER Z WITH CARON }
+  XK_zabovedot           = $01bf;  { U+017C LATIN SMALL LETTER Z WITH DOT ABOVE }
+  XKc_Racute             = $01c0;  { U+0154 LATIN CAPITAL LETTER R WITH ACUTE }
+  XKc_Abreve             = $01c3;  { U+0102 LATIN CAPITAL LETTER A WITH BREVE }
+  XKc_Lacute             = $01c5;  { U+0139 LATIN CAPITAL LETTER L WITH ACUTE }
+  XKc_Cacute             = $01c6;  { U+0106 LATIN CAPITAL LETTER C WITH ACUTE }
+  XKc_Ccaron             = $01c8;  { U+010C LATIN CAPITAL LETTER C WITH CARON }
+  XKc_Eogonek            = $01ca;  { U+0118 LATIN CAPITAL LETTER E WITH OGONEK }
+  XKc_Ecaron             = $01cc;  { U+011A LATIN CAPITAL LETTER E WITH CARON }
+  XKc_Dcaron             = $01cf;  { U+010E LATIN CAPITAL LETTER D WITH CARON }
+  XKc_Dstroke            = $01d0;  { U+0110 LATIN CAPITAL LETTER D WITH STROKE }
+  XKc_Nacute             = $01d1;  { U+0143 LATIN CAPITAL LETTER N WITH ACUTE }
+  XKc_Ncaron             = $01d2;  { U+0147 LATIN CAPITAL LETTER N WITH CARON }
+  XKc_Odoubleacute       = $01d5;  { U+0150 LATIN CAPITAL LETTER O WITH DOUBLE ACUTE }
+  XKc_Rcaron             = $01d8;  { U+0158 LATIN CAPITAL LETTER R WITH CARON }
+  XKc_Uring              = $01d9;  { U+016E LATIN CAPITAL LETTER U WITH RING ABOVE }
+  XKc_Udoubleacute       = $01db;  { U+0170 LATIN CAPITAL LETTER U WITH DOUBLE ACUTE }
+  XKc_Tcedilla           = $01de;  { U+0162 LATIN CAPITAL LETTER T WITH CEDILLA }
+  XK_racute              = $01e0;  { U+0155 LATIN SMALL LETTER R WITH ACUTE }
+  XK_abreve              = $01e3;  { U+0103 LATIN SMALL LETTER A WITH BREVE }
+  XK_lacute              = $01e5;  { U+013A LATIN SMALL LETTER L WITH ACUTE }
+  XK_cacute              = $01e6;  { U+0107 LATIN SMALL LETTER C WITH ACUTE }
+  XK_ccaron              = $01e8;  { U+010D LATIN SMALL LETTER C WITH CARON }
+  XK_eogonek             = $01ea;  { U+0119 LATIN SMALL LETTER E WITH OGONEK }
+  XK_ecaron              = $01ec;  { U+011B LATIN SMALL LETTER E WITH CARON }
+  XK_dcaron              = $01ef;  { U+010F LATIN SMALL LETTER D WITH CARON }
+  XK_dstroke             = $01f0;  { U+0111 LATIN SMALL LETTER D WITH STROKE }
+  XK_nacute              = $01f1;  { U+0144 LATIN SMALL LETTER N WITH ACUTE }
+  XK_ncaron              = $01f2;  { U+0148 LATIN SMALL LETTER N WITH CARON }
+  XK_odoubleacute        = $01f5;  { U+0151 LATIN SMALL LETTER O WITH DOUBLE ACUTE }
+  XK_rcaron              = $01f8;  { U+0159 LATIN SMALL LETTER R WITH CARON }
+  XK_uring               = $01f9;  { U+016F LATIN SMALL LETTER U WITH RING ABOVE }
+  XK_udoubleacute        = $01fb;  { U+0171 LATIN SMALL LETTER U WITH DOUBLE ACUTE }
+  XK_tcedilla            = $01fe;  { U+0163 LATIN SMALL LETTER T WITH CEDILLA }
+  XK_abovedot            = $01ff;  { U+02D9 DOT ABOVE }
 {$ENDIF} { XK_LATIN2 }
 
 {*
- *   Latin 3
- *   Byte 3 = 2
+ * Latin 3
+ * Byte 3 = 2
  *}
 
 {$IFDEF XK_LATIN3}
-  XKc_Hstroke             = $2a1;
-  XKc_Hcircumflex         = $2a6;
-  XKc_Iabovedot           = $2a9;
-  XKc_Gbreve              = $2ab;
-  XKc_Jcircumflex         = $2ac;
-  XK_hstroke             = $2b1;
-  XK_hcircumflex         = $2b6;
-  XK_idotless            = $2b9;
-  XK_gbreve              = $2bb;
-  XK_jcircumflex         = $2bc;
-  XKc_Cabovedot           = $2c5;
-  XKc_Ccircumflex         = $2c6;
-  XKc_Gabovedot           = $2d5;
-  XKc_Gcircumflex         = $2d8;
-  XKc_Ubreve              = $2dd;
-  XKc_Scircumflex         = $2de;
-  XK_cabovedot           = $2e5;
-  XK_ccircumflex         = $2e6;
-  XK_gabovedot           = $2f5;
-  XK_gcircumflex         = $2f8;
-  XK_ubreve              = $2fd;
-  XK_scircumflex         = $2fe;
+  XKc_Hstroke            = $02a1;  { U+0126 LATIN CAPITAL LETTER H WITH STROKE }
+  XKc_Hcircumflex        = $02a6;  { U+0124 LATIN CAPITAL LETTER H WITH CIRCUMFLEX }
+  XKc_Iabovedot          = $02a9;  { U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE }
+  XKc_Gbreve             = $02ab;  { U+011E LATIN CAPITAL LETTER G WITH BREVE }
+  XKc_Jcircumflex        = $02ac;  { U+0134 LATIN CAPITAL LETTER J WITH CIRCUMFLEX }
+  XK_hstroke             = $02b1;  { U+0127 LATIN SMALL LETTER H WITH STROKE }
+  XK_hcircumflex         = $02b6;  { U+0125 LATIN SMALL LETTER H WITH CIRCUMFLEX }
+  XK_idotless            = $02b9;  { U+0131 LATIN SMALL LETTER DOTLESS I }
+  XK_gbreve              = $02bb;  { U+011F LATIN SMALL LETTER G WITH BREVE }
+  XK_jcircumflex         = $02bc;  { U+0135 LATIN SMALL LETTER J WITH CIRCUMFLEX }
+  XKc_Cabovedot          = $02c5;  { U+010A LATIN CAPITAL LETTER C WITH DOT ABOVE }
+  XKc_Ccircumflex        = $02c6;  { U+0108 LATIN CAPITAL LETTER C WITH CIRCUMFLEX }
+  XKc_Gabovedot          = $02d5;  { U+0120 LATIN CAPITAL LETTER G WITH DOT ABOVE }
+  XKc_Gcircumflex        = $02d8;  { U+011C LATIN CAPITAL LETTER G WITH CIRCUMFLEX }
+  XKc_Ubreve             = $02dd;  { U+016C LATIN CAPITAL LETTER U WITH BREVE }
+  XKc_Scircumflex        = $02de;  { U+015C LATIN CAPITAL LETTER S WITH CIRCUMFLEX }
+  XK_cabovedot           = $02e5;  { U+010B LATIN SMALL LETTER C WITH DOT ABOVE }
+  XK_ccircumflex         = $02e6;  { U+0109 LATIN SMALL LETTER C WITH CIRCUMFLEX }
+  XK_gabovedot           = $02f5;  { U+0121 LATIN SMALL LETTER G WITH DOT ABOVE }
+  XK_gcircumflex         = $02f8;  { U+011D LATIN SMALL LETTER G WITH CIRCUMFLEX }
+  XK_ubreve              = $02fd;  { U+016D LATIN SMALL LETTER U WITH BREVE }
+  XK_scircumflex         = $02fe;  { U+015D LATIN SMALL LETTER S WITH CIRCUMFLEX }
 {$ENDIF} { XK_LATIN3 }
 
 
 {*
- *   Latin 4
- *   Byte 3 = 3
+ * Latin 4
+ * Byte 3 = 3
  *}
 
 {$IFDEF XK_LATIN4}
-  XK_kra                 = $3a2;
-  XK_kappa               = $3a2;{ deprecated }
-  XKc_Rcedilla            = $3a3;
-  XKc_Itilde              = $3a5;
-  XKc_Lcedilla            = $3a6;
-  XKc_Emacron             = $3aa;
-  XKc_Gcedilla            = $3ab;
-  XKc_Tslash              = $3ac;
-  XK_rcedilla            = $3b3;
-  XK_itilde              = $3b5;
-  XK_lcedilla            = $3b6;
-  XK_emacron             = $3ba;
-  XK_gcedilla            = $3bb;
-  XK_tslash              = $3bc;
-  XKc_ENG                 = $3bd;
-  XK_eng                 = $3bf;
-  XKc_Amacron             = $3c0;
-  XKc_Iogonek             = $3c7;
-  XKc_Eabovedot           = $3cc;
-  XKc_Imacron             = $3cf;
-  XKc_Ncedilla            = $3d1;
-  XKc_Omacron             = $3d2;
-  XKc_Kcedilla            = $3d3;
-  XKc_Uogonek             = $3d9;
-  XKc_Utilde              = $3dd;
-  XKc_Umacron             = $3de;
-  XK_amacron             = $3e0;
-  XK_iogonek             = $3e7;
-  XK_eabovedot           = $3ec;
-  XK_imacron             = $3ef;
-  XK_ncedilla            = $3f1;
-  XK_omacron             = $3f2;
-  XK_kcedilla            = $3f3;
-  XK_uogonek             = $3f9;
-  XK_utilde              = $3fd;
-  XK_umacron             = $3fe;
+  XK_kra                 = $03a2;  { U+0138 LATIN SMALL LETTER KRA }
+  XK_kappa               = $03a2;  { deprecated }
+  XKc_Rcedilla           = $03a3;  { U+0156 LATIN CAPITAL LETTER R WITH CEDILLA }
+  XKc_Itilde             = $03a5;  { U+0128 LATIN CAPITAL LETTER I WITH TILDE }
+  XKc_Lcedilla           = $03a6;  { U+013B LATIN CAPITAL LETTER L WITH CEDILLA }
+  XKc_Emacron            = $03aa;  { U+0112 LATIN CAPITAL LETTER E WITH MACRON }
+  XKc_Gcedilla           = $03ab;  { U+0122 LATIN CAPITAL LETTER G WITH CEDILLA }
+  XKc_Tslash             = $03ac;  { U+0166 LATIN CAPITAL LETTER T WITH STROKE }
+  XK_rcedilla            = $03b3;  { U+0157 LATIN SMALL LETTER R WITH CEDILLA }
+  XK_itilde              = $03b5;  { U+0129 LATIN SMALL LETTER I WITH TILDE }
+  XK_lcedilla            = $03b6;  { U+013C LATIN SMALL LETTER L WITH CEDILLA }
+  XK_emacron             = $03ba;  { U+0113 LATIN SMALL LETTER E WITH MACRON }
+  XK_gcedilla            = $03bb;  { U+0123 LATIN SMALL LETTER G WITH CEDILLA }
+  XK_tslash              = $03bc;  { U+0167 LATIN SMALL LETTER T WITH STROKE }
+  XKc_ENG                = $03bd;  { U+014A LATIN CAPITAL LETTER ENG }
+  XK_eng                 = $03bf;  { U+014B LATIN SMALL LETTER ENG }
+  XKc_Amacron            = $03c0;  { U+0100 LATIN CAPITAL LETTER A WITH MACRON }
+  XKc_Iogonek            = $03c7;  { U+012E LATIN CAPITAL LETTER I WITH OGONEK }
+  XKc_Eabovedot          = $03cc;  { U+0116 LATIN CAPITAL LETTER E WITH DOT ABOVE }
+  XKc_Imacron            = $03cf;  { U+012A LATIN CAPITAL LETTER I WITH MACRON }
+  XKc_Ncedilla           = $03d1;  { U+0145 LATIN CAPITAL LETTER N WITH CEDILLA }
+  XKc_Omacron            = $03d2;  { U+014C LATIN CAPITAL LETTER O WITH MACRON }
+  XKc_Kcedilla           = $03d3;  { U+0136 LATIN CAPITAL LETTER K WITH CEDILLA }
+  XKc_Uogonek            = $03d9;  { U+0172 LATIN CAPITAL LETTER U WITH OGONEK }
+  XKc_Utilde             = $03dd;  { U+0168 LATIN CAPITAL LETTER U WITH TILDE }
+  XKc_Umacron            = $03de;  { U+016A LATIN CAPITAL LETTER U WITH MACRON }
+  XK_amacron             = $03e0;  { U+0101 LATIN SMALL LETTER A WITH MACRON }
+  XK_iogonek             = $03e7;  { U+012F LATIN SMALL LETTER I WITH OGONEK }
+  XK_eabovedot           = $03ec;  { U+0117 LATIN SMALL LETTER E WITH DOT ABOVE }
+  XK_imacron             = $03ef;  { U+012B LATIN SMALL LETTER I WITH MACRON }
+  XK_ncedilla            = $03f1;  { U+0146 LATIN SMALL LETTER N WITH CEDILLA }
+  XK_omacron             = $03f2;  { U+014D LATIN SMALL LETTER O WITH MACRON }
+  XK_kcedilla            = $03f3;  { U+0137 LATIN SMALL LETTER K WITH CEDILLA }
+  XK_uogonek             = $03f9;  { U+0173 LATIN SMALL LETTER U WITH OGONEK }
+  XK_utilde              = $03fd;  { U+0169 LATIN SMALL LETTER U WITH TILDE }
+  XK_umacron             = $03fe;  { U+016B LATIN SMALL LETTER U WITH MACRON }
 {$ENDIF} { XK_LATIN4 }
 
 {*
- * Latin-8
- * Byte 3 = 18
+ * Latin 8
  *}
 {$IFDEF XK_LATIN8}
-  XKc_Babovedot           = $12a1;
-  XK_babovedot           = $12a2;
-  XKc_Dabovedot           = $12a6;
-  XKc_Wgrave              = $12a8;
-  XKc_Wacute              = $12aa;
-  XK_dabovedot           = $12ab;
-  XKc_Ygrave              = $12ac;
-  XKc_Fabovedot           = $12b0;
-  XK_fabovedot           = $12b1;
-  XKc_Mabovedot           = $12b4;
-  XK_mabovedot           = $12b5;
-  XKc_Pabovedot           = $12b7;
-  XK_wgrave              = $12b8;
-  XK_pabovedot           = $12b9;
-  XK_wacute              = $12ba;
-  XKc_Sabovedot           = $12bb;
-  XK_ygrave              = $12bc;
-  XKc_Wdiaeresis          = $12bd;
-  XK_wdiaeresis          = $12be;
-  XK_sabovedot           = $12bf;
-  XKc_Wcircumflex         = $12d0;
-  XKc_Tabovedot           = $12d7;
-  XKc_Ycircumflex         = $12de;
-  XK_wcircumflex         = $12f0;
-  XK_tabovedot           = $12f7;
-  XK_ycircumflex         = $12fe;
+  XKc_Wcircumflex        = $1000174;  { U+0174 LATIN CAPITAL LETTER W WITH CIRCUMFLEX }
+  XK_wcircumflex         = $1000175;  { U+0175 LATIN SMALL LETTER W WITH CIRCUMFLEX }
+  XKc_Ycircumflex        = $1000176;  { U+0176 LATIN CAPITAL LETTER Y WITH CIRCUMFLEX }
+  XK_ycircumflex         = $1000177;  { U+0177 LATIN SMALL LETTER Y WITH CIRCUMFLEX }
+  XKc_Babovedot          = $1001e02;  { U+1E02 LATIN CAPITAL LETTER B WITH DOT ABOVE }
+  XK_babovedot           = $1001e03;  { U+1E03 LATIN SMALL LETTER B WITH DOT ABOVE }
+  XKc_Dabovedot          = $1001e0a;  { U+1E0A LATIN CAPITAL LETTER D WITH DOT ABOVE }
+  XK_dabovedot           = $1001e0b;  { U+1E0B LATIN SMALL LETTER D WITH DOT ABOVE }
+  XKc_Fabovedot          = $1001e1e;  { U+1E1E LATIN CAPITAL LETTER F WITH DOT ABOVE }
+  XK_fabovedot           = $1001e1f;  { U+1E1F LATIN SMALL LETTER F WITH DOT ABOVE }
+  XKc_Mabovedot          = $1001e40;  { U+1E40 LATIN CAPITAL LETTER M WITH DOT ABOVE }
+  XK_mabovedot           = $1001e41;  { U+1E41 LATIN SMALL LETTER M WITH DOT ABOVE }
+  XKc_Pabovedot          = $1001e56;  { U+1E56 LATIN CAPITAL LETTER P WITH DOT ABOVE }
+  XK_pabovedot           = $1001e57;  { U+1E57 LATIN SMALL LETTER P WITH DOT ABOVE }
+  XKc_Sabovedot          = $1001e60;  { U+1E60 LATIN CAPITAL LETTER S WITH DOT ABOVE }
+  XK_sabovedot           = $1001e61;  { U+1E61 LATIN SMALL LETTER S WITH DOT ABOVE }
+  XKc_Tabovedot          = $1001e6a;  { U+1E6A LATIN CAPITAL LETTER T WITH DOT ABOVE }
+  XK_tabovedot           = $1001e6b;  { U+1E6B LATIN SMALL LETTER T WITH DOT ABOVE }
+  XKc_Wgrave             = $1001e80;  { U+1E80 LATIN CAPITAL LETTER W WITH GRAVE }
+  XK_wgrave              = $1001e81;  { U+1E81 LATIN SMALL LETTER W WITH GRAVE }
+  XKc_Wacute             = $1001e82;  { U+1E82 LATIN CAPITAL LETTER W WITH ACUTE }
+  XK_wacute              = $1001e83;  { U+1E83 LATIN SMALL LETTER W WITH ACUTE }
+  XKc_Wdiaeresis         = $1001e84;  { U+1E84 LATIN CAPITAL LETTER W WITH DIAERESIS }
+  XK_wdiaeresis          = $1001e85;  { U+1E85 LATIN SMALL LETTER W WITH DIAERESIS }
+  XKc_Ygrave             = $1001ef2;  { U+1EF2 LATIN CAPITAL LETTER Y WITH GRAVE }
+  XK_ygrave              = $1001ef3;  { U+1EF3 LATIN SMALL LETTER Y WITH GRAVE }
 {$ENDIF} { XK_LATIN8 }
 
 {*
- * Latin-9 (a.k.a. Latin-0)
- * Byte 3 = 19
+ * Latin 9
+ * Byte 3 = $13
  *}
 
 {$IFDEF XK_LATIN9}
-  XKc_OE                  = $13bc;
-  XK_oe                  = $13bd;
-  XKc_Ydiaeresis          = $13be;
+  XKc_OE                 = $13bc;  { U+0152 LATIN CAPITAL LIGATURE OE }
+  XK_oe                  = $13bd;  { U+0153 LATIN SMALL LIGATURE OE }
+  XKc_Ydiaeresis         = $13be;  { U+0178 LATIN CAPITAL LETTER Y WITH DIAERESIS }
 {$ENDIF} { XK_LATIN9 }
 
 {*
@@ -807,76 +861,76 @@ Const
  *}
 
 {$IFDEF XK_KATAKANA}
-  XK_overline                                    = $47e;
-  XK_kana_fullstop                               = $4a1;
-  XK_kana_openingbracket                         = $4a2;
-  XK_kana_closingbracket                         = $4a3;
-  XK_kana_comma                                  = $4a4;
-  XK_kana_conjunctive                            = $4a5;
-  XK_kana_middledot                              = $4a5; { deprecated }
-  XKc_kana_WO                                     = $4a6;
-  XK_kana_a                                      = $4a7;
-  XK_kana_i                                      = $4a8;
-  XK_kana_u                                      = $4a9;
-  XK_kana_e                                      = $4aa;
-  XK_kana_o                                      = $4ab;
-  XK_kana_ya                                     = $4ac;
-  XK_kana_yu                                     = $4ad;
-  XK_kana_yo                                     = $4ae;
-  XK_kana_tsu                                    = $4af;
-  XK_kana_tu                                     = $4af; { deprecated }
-  XK_prolongedsound                              = $4b0;
-  XKc_kana_A                                      = $4b1;
-  XKc_kana_I                                      = $4b2;
-  XKc_kana_U                                      = $4b3;
-  XKc_kana_E                                      = $4b4;
-  XKc_kana_O                                      = $4b5;
-  XKc_kana_KA                                     = $4b6;
-  XKc_kana_KI                                     = $4b7;
-  XKc_kana_KU                                     = $4b8;
-  XKc_kana_KE                                     = $4b9;
-  XKc_kana_KO                                     = $4ba;
-  XKc_kana_SA                                     = $4bb;
-  XKc_kana_SHI                                    = $4bc;
-  XKc_kana_SU                                     = $4bd;
-  XKc_kana_SE                                     = $4be;
-  XKc_kana_SO                                     = $4bf;
-  XKc_kana_TA                                     = $4c0;
-  XKc_kana_CHI                                    = $4c1;
-  XKc_kana_TI                                     = $4c1;  { deprecated }
-  XKc_kana_TSU                                    = $4c2;
-  XKc_kana_TU                                     = $4c2;  { deprecated }
-  XKc_kana_TE                                     = $4c3;
-  XKc_kana_TO                                     = $4c4;
-  XKc_kana_NA                                     = $4c5;
-  XKc_kana_NI                                     = $4c6;
-  XKc_kana_NU                                     = $4c7;
-  XKc_kana_NE                                     = $4c8;
-  XKc_kana_NO                                     = $4c9;
-  XKc_kana_HA                                     = $4ca;
-  XKc_kana_HI                                     = $4cb;
-  XKc_kana_FU                                     = $4cc;
-  XKc_kana_HU                                     = $4cc; { deprecated }
-  XKc_kana_HE                                     = $4cd;
-  XKc_kana_HO                                     = $4ce;
-  XKc_kana_MA                                     = $4cf;
-  XKc_kana_MI                                     = $4d0;
-  XKc_kana_MU                                     = $4d1;
-  XKc_kana_ME                                     = $4d2;
-  XKc_kana_MO                                     = $4d3;
-  XKc_kana_YA                                     = $4d4;
-  XKc_kana_YU                                     = $4d5;
-  XKc_kana_YO                                     = $4d6;
-  XKc_kana_RA                                     = $4d7;
-  XKc_kana_RI                                     = $4d8;
-  XKc_kana_RU                                     = $4d9;
-  XKc_kana_RE                                     = $4da;
-  XKc_kana_RO                                     = $4db;
-  XKc_kana_WA                                     = $4dc;
-  XKc_kana_N                                      = $4dd;
-  XK_voicedsound                                 = $4de;
-  XK_semivoicedsound                             = $4df;
-  XK_kana_switch          = $FF7E;  { Alias for mode_switch }
+  XK_overline            = $047e;  { U+203E OVERLINE }
+  XK_kana_fullstop       = $04a1;  { U+3002 IDEOGRAPHIC FULL STOP }
+  XK_kana_openingbracket = $04a2;  { U+300C LEFT CORNER BRACKET }
+  XK_kana_closingbracket = $04a3;  { U+300D RIGHT CORNER BRACKET }
+  XK_kana_comma          = $04a4;  { U+3001 IDEOGRAPHIC COMMA }
+  XK_kana_conjunctive    = $04a5;  { U+30FB KATAKANA MIDDLE DOT }
+  XK_kana_middledot      = $04a5;  { deprecated }
+  XKc_kana_WO            = $04a6;  { U+30F2 KATAKANA LETTER WO }
+  XK_kana_a              = $04a7;  { U+30A1 KATAKANA LETTER SMALL A }
+  XK_kana_i              = $04a8;  { U+30A3 KATAKANA LETTER SMALL I }
+  XK_kana_u              = $04a9;  { U+30A5 KATAKANA LETTER SMALL U }
+  XK_kana_e              = $04aa;  { U+30A7 KATAKANA LETTER SMALL E }
+  XK_kana_o              = $04ab;  { U+30A9 KATAKANA LETTER SMALL O }
+  XK_kana_ya             = $04ac;  { U+30E3 KATAKANA LETTER SMALL YA }
+  XK_kana_yu             = $04ad;  { U+30E5 KATAKANA LETTER SMALL YU }
+  XK_kana_yo             = $04ae;  { U+30E7 KATAKANA LETTER SMALL YO }
+  XK_kana_tsu            = $04af;  { U+30C3 KATAKANA LETTER SMALL TU }
+  XK_kana_tu             = $04af;  { deprecated }
+  XK_prolongedsound      = $04b0;  { U+30FC KATAKANA-HIRAGANA PROLONGED SOUND MARK }
+  XKc_kana_A             = $04b1;  { U+30A2 KATAKANA LETTER A }
+  XKc_kana_I             = $04b2;  { U+30A4 KATAKANA LETTER I }
+  XKc_kana_U             = $04b3;  { U+30A6 KATAKANA LETTER U }
+  XKc_kana_E             = $04b4;  { U+30A8 KATAKANA LETTER E }
+  XKc_kana_O             = $04b5;  { U+30AA KATAKANA LETTER O }
+  XKc_kana_KA            = $04b6;  { U+30AB KATAKANA LETTER KA }
+  XKc_kana_KI            = $04b7;  { U+30AD KATAKANA LETTER KI }
+  XKc_kana_KU            = $04b8;  { U+30AF KATAKANA LETTER KU }
+  XKc_kana_KE            = $04b9;  { U+30B1 KATAKANA LETTER KE }
+  XKc_kana_KO            = $04ba;  { U+30B3 KATAKANA LETTER KO }
+  XKc_kana_SA            = $04bb;  { U+30B5 KATAKANA LETTER SA }
+  XKc_kana_SHI           = $04bc;  { U+30B7 KATAKANA LETTER SI }
+  XKc_kana_SU            = $04bd;  { U+30B9 KATAKANA LETTER SU }
+  XKc_kana_SE            = $04be;  { U+30BB KATAKANA LETTER SE }
+  XKc_kana_SO            = $04bf;  { U+30BD KATAKANA LETTER SO }
+  XKc_kana_TA            = $04c0;  { U+30BF KATAKANA LETTER TA }
+  XKc_kana_CHI           = $04c1;  { U+30C1 KATAKANA LETTER TI }
+  XKc_kana_TI            = $04c1;  { deprecated }
+  XKc_kana_TSU           = $04c2;  { U+30C4 KATAKANA LETTER TU }
+  XKc_kana_TU            = $04c2;  { deprecated }
+  XKc_kana_TE            = $04c3;  { U+30C6 KATAKANA LETTER TE }
+  XKc_kana_TO            = $04c4;  { U+30C8 KATAKANA LETTER TO }
+  XKc_kana_NA            = $04c5;  { U+30CA KATAKANA LETTER NA }
+  XKc_kana_NI            = $04c6;  { U+30CB KATAKANA LETTER NI }
+  XKc_kana_NU            = $04c7;  { U+30CC KATAKANA LETTER NU }
+  XKc_kana_NE            = $04c8;  { U+30CD KATAKANA LETTER NE }
+  XKc_kana_NO            = $04c9;  { U+30CE KATAKANA LETTER NO }
+  XKc_kana_HA            = $04ca;  { U+30CF KATAKANA LETTER HA }
+  XKc_kana_HI            = $04cb;  { U+30D2 KATAKANA LETTER HI }
+  XKc_kana_FU            = $04cc;  { U+30D5 KATAKANA LETTER HU }
+  XKc_kana_HU            = $04cc;  { deprecated }
+  XKc_kana_HE            = $04cd;  { U+30D8 KATAKANA LETTER HE }
+  XKc_kana_HO            = $04ce;  { U+30DB KATAKANA LETTER HO }
+  XKc_kana_MA            = $04cf;  { U+30DE KATAKANA LETTER MA }
+  XKc_kana_MI            = $04d0;  { U+30DF KATAKANA LETTER MI }
+  XKc_kana_MU            = $04d1;  { U+30E0 KATAKANA LETTER MU }
+  XKc_kana_ME            = $04d2;  { U+30E1 KATAKANA LETTER ME }
+  XKc_kana_MO            = $04d3;  { U+30E2 KATAKANA LETTER MO }
+  XKc_kana_YA            = $04d4;  { U+30E4 KATAKANA LETTER YA }
+  XKc_kana_YU            = $04d5;  { U+30E6 KATAKANA LETTER YU }
+  XKc_kana_YO            = $04d6;  { U+30E8 KATAKANA LETTER YO }
+  XKc_kana_RA            = $04d7;  { U+30E9 KATAKANA LETTER RA }
+  XKc_kana_RI            = $04d8;  { U+30EA KATAKANA LETTER RI }
+  XKc_kana_RU            = $04d9;  { U+30EB KATAKANA LETTER RU }
+  XKc_kana_RE            = $04da;  { U+30EC KATAKANA LETTER RE }
+  XKc_kana_RO            = $04db;  { U+30ED KATAKANA LETTER RO }
+  XKc_kana_WA            = $04dc;  { U+30EF KATAKANA LETTER WA }
+  XKc_kana_N             = $04dd;  { U+30F3 KATAKANA LETTER N }
+  XK_voicedsound         = $04de;  { U+309B KATAKANA-HIRAGANA VOICED SOUND MARK }
+  XK_semivoicedsound     = $04df;  { U+309C KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK }
+  XK_kana_switch         = $ff7e;  { Alias for mode_switch }
 {$ENDIF} { XK_KATAKANA }
 
 {*
@@ -885,97 +939,97 @@ Const
  *}
 
 {$IFDEF XK_ARABIC}
-  XK_Farsi_0                                     = $590;
-  XK_Farsi_1                                     = $591;
-  XK_Farsi_2                                     = $592;
-  XK_Farsi_3                                     = $593;
-  XK_Farsi_4                                     = $594;
-  XK_Farsi_5                                     = $595;
-  XK_Farsi_6                                     = $596;
-  XK_Farsi_7                                     = $597;
-  XK_Farsi_8                                     = $598;
-  XK_Farsi_9                                     = $599;
-  XK_Arabic_percent                              = $5a5;
-  XK_Arabic_superscript_alef                     = $5a6;
-  XK_Arabic_tteh                                 = $5a7;
-  XK_Arabic_peh                                  = $5a8;
-  XK_Arabic_tcheh                                = $5a9;
-  XK_Arabic_ddal                                 = $5aa;
-  XK_Arabic_rreh                                 = $5ab;
-  XK_Arabic_comma                                = $5ac;
-  XK_Arabic_fullstop                             = $5ae;
-  XK_Arabic_0                                    = $5b0;
-  XK_Arabic_1                                    = $5b1;
-  XK_Arabic_2                                    = $5b2;
-  XK_Arabic_3                                    = $5b3;
-  XK_Arabic_4                                    = $5b4;
-  XK_Arabic_5                                    = $5b5;
-  XK_Arabic_6                                    = $5b6;
-  XK_Arabic_7                                    = $5b7;
-  XK_Arabic_8                                    = $5b8;
-  XK_Arabic_9                                    = $5b9;
-  XK_Arabic_semicolon                            = $5bb;
-  XK_Arabic_question_mark                        = $5bf;
-  XK_Arabic_hamza                                = $5c1;
-  XK_Arabic_maddaonalef                          = $5c2;
-  XK_Arabic_hamzaonalef                          = $5c3;
-  XK_Arabic_hamzaonwaw                           = $5c4;
-  XK_Arabic_hamzaunderalef                       = $5c5;
-  XK_Arabic_hamzaonyeh                           = $5c6;
-  XK_Arabic_alef                                 = $5c7;
-  XK_Arabic_beh                                  = $5c8;
-  XK_Arabic_tehmarbuta                           = $5c9;
-  XK_Arabic_teh                                  = $5ca;
-  XK_Arabic_theh                                 = $5cb;
-  XK_Arabic_jeem                                 = $5cc;
-  XK_Arabic_hah                                  = $5cd;
-  XK_Arabic_khah                                 = $5ce;
-  XK_Arabic_dal                                  = $5cf;
-  XK_Arabic_thal                                 = $5d0;
-  XK_Arabic_ra                                   = $5d1;
-  XK_Arabic_zain                                 = $5d2;
-  XK_Arabic_seen                                 = $5d3;
-  XK_Arabic_sheen                                = $5d4;
-  XK_Arabic_sad                                  = $5d5;
-  XK_Arabic_dad                                  = $5d6;
-  XK_Arabic_tah                                  = $5d7;
-  XK_Arabic_zah                                  = $5d8;
-  XK_Arabic_ain                                  = $5d9;
-  XK_Arabic_ghain                                = $5da;
-  XK_Arabic_tatweel                              = $5e0;
-  XK_Arabic_feh                                  = $5e1;
-  XK_Arabic_qaf                                  = $5e2;
-  XK_Arabic_kaf                                  = $5e3;
-  XK_Arabic_lam                                  = $5e4;
-  XK_Arabic_meem                                 = $5e5;
-  XK_Arabic_noon                                 = $5e6;
-  XK_Arabic_ha                                   = $5e7;
-  XK_Arabic_heh                                  = $5e7;  { deprecated }
-  XK_Arabic_waw                                  = $5e8;
-  XK_Arabic_alefmaksura                          = $5e9;
-  XK_Arabic_yeh                                  = $5ea;
-  XK_Arabic_fathatan                             = $5eb;
-  XK_Arabic_dammatan                             = $5ec;
-  XK_Arabic_kasratan                             = $5ed;
-  XK_Arabic_fatha                                = $5ee;
-  XK_Arabic_damma                                = $5ef;
-  XK_Arabic_kasra                                = $5f0;
-  XK_Arabic_shadda                               = $5f1;
-  XK_Arabic_sukun                                = $5f2;
-  XK_Arabic_madda_above                          = $5f3;
-  XK_Arabic_hamza_above                          = $5f4;
-  XK_Arabic_hamza_below                          = $5f5;
-  XK_Arabic_jeh                                  = $5f6;
-  XK_Arabic_veh                                  = $5f7;
-  XK_Arabic_keheh                                = $5f8;
-  XK_Arabic_gaf                                  = $5f9;
-  XK_Arabic_noon_ghunna                          = $5fa;
-  XK_Arabic_heh_doachashmee                      = $5fb;
-  XK_Farsi_yeh                                   = $5fc;
-  XK_Arabic_farsi_yeh                    = XK_Farsi_yeh;
-  XK_Arabic_yeh_baree                            = $5fd;
-  XK_Arabic_heh_goal                             = $5fe;
-  XK_Arabic_switch        = $FF7E;  { Alias for mode_switch }
+  XK_Farsi_0                 = $10006f0;  { U+06F0 EXTENDED ARABIC-INDIC DIGIT ZERO }
+  XK_Farsi_1                 = $10006f1;  { U+06F1 EXTENDED ARABIC-INDIC DIGIT ONE }
+  XK_Farsi_2                 = $10006f2;  { U+06F2 EXTENDED ARABIC-INDIC DIGIT TWO }
+  XK_Farsi_3                 = $10006f3;  { U+06F3 EXTENDED ARABIC-INDIC DIGIT THREE }
+  XK_Farsi_4                 = $10006f4;  { U+06F4 EXTENDED ARABIC-INDIC DIGIT FOUR }
+  XK_Farsi_5                 = $10006f5;  { U+06F5 EXTENDED ARABIC-INDIC DIGIT FIVE }
+  XK_Farsi_6                 = $10006f6;  { U+06F6 EXTENDED ARABIC-INDIC DIGIT SIX }
+  XK_Farsi_7                 = $10006f7;  { U+06F7 EXTENDED ARABIC-INDIC DIGIT SEVEN }
+  XK_Farsi_8                 = $10006f8;  { U+06F8 EXTENDED ARABIC-INDIC DIGIT EIGHT }
+  XK_Farsi_9                 = $10006f9;  { U+06F9 EXTENDED ARABIC-INDIC DIGIT NINE }
+  XK_Arabic_percent          = $100066a;  { U+066A ARABIC PERCENT SIGN }
+  XK_Arabic_superscript_alef = $1000670;  { U+0670 ARABIC LETTER SUPERSCRIPT ALEF }
+  XK_Arabic_tteh             = $1000679;  { U+0679 ARABIC LETTER TTEH }
+  XK_Arabic_peh              = $100067e;  { U+067E ARABIC LETTER PEH }
+  XK_Arabic_tcheh            = $1000686;  { U+0686 ARABIC LETTER TCHEH }
+  XK_Arabic_ddal             = $1000688;  { U+0688 ARABIC LETTER DDAL }
+  XK_Arabic_rreh             = $1000691;  { U+0691 ARABIC LETTER RREH }
+  XK_Arabic_comma            = $05ac;     { U+060C ARABIC COMMA }
+  XK_Arabic_fullstop         = $10006d4;  { U+06D4 ARABIC FULL STOP }
+  XK_Arabic_0                = $1000660;  { U+0660 ARABIC-INDIC DIGIT ZERO }
+  XK_Arabic_1                = $1000661;  { U+0661 ARABIC-INDIC DIGIT ONE }
+  XK_Arabic_2                = $1000662;  { U+0662 ARABIC-INDIC DIGIT TWO }
+  XK_Arabic_3                = $1000663;  { U+0663 ARABIC-INDIC DIGIT THREE }
+  XK_Arabic_4                = $1000664;  { U+0664 ARABIC-INDIC DIGIT FOUR }
+  XK_Arabic_5                = $1000665;  { U+0665 ARABIC-INDIC DIGIT FIVE }
+  XK_Arabic_6                = $1000666;  { U+0666 ARABIC-INDIC DIGIT SIX }
+  XK_Arabic_7                = $1000667;  { U+0667 ARABIC-INDIC DIGIT SEVEN }
+  XK_Arabic_8                = $1000668;  { U+0668 ARABIC-INDIC DIGIT EIGHT }
+  XK_Arabic_9                = $1000669;  { U+0669 ARABIC-INDIC DIGIT NINE }
+  XK_Arabic_semicolon        = $05bb;     { U+061B ARABIC SEMICOLON }
+  XK_Arabic_question_mark    = $05bf;     { U+061F ARABIC QUESTION MARK }
+  XK_Arabic_hamza            = $05c1;     { U+0621 ARABIC LETTER HAMZA }
+  XK_Arabic_maddaonalef      = $05c2;     { U+0622 ARABIC LETTER ALEF WITH MADDA ABOVE }
+  XK_Arabic_hamzaonalef      = $05c3;     { U+0623 ARABIC LETTER ALEF WITH HAMZA ABOVE }
+  XK_Arabic_hamzaonwaw       = $05c4;     { U+0624 ARABIC LETTER WAW WITH HAMZA ABOVE }
+  XK_Arabic_hamzaunderalef   = $05c5;     { U+0625 ARABIC LETTER ALEF WITH HAMZA BELOW }
+  XK_Arabic_hamzaonyeh       = $05c6;     { U+0626 ARABIC LETTER YEH WITH HAMZA ABOVE }
+  XK_Arabic_alef             = $05c7;     { U+0627 ARABIC LETTER ALEF }
+  XK_Arabic_beh              = $05c8;     { U+0628 ARABIC LETTER BEH }
+  XK_Arabic_tehmarbuta       = $05c9;     { U+0629 ARABIC LETTER TEH MARBUTA }
+  XK_Arabic_teh              = $05ca;     { U+062A ARABIC LETTER TEH }
+  XK_Arabic_theh             = $05cb;     { U+062B ARABIC LETTER THEH }
+  XK_Arabic_jeem             = $05cc;     { U+062C ARABIC LETTER JEEM }
+  XK_Arabic_hah              = $05cd;     { U+062D ARABIC LETTER HAH }
+  XK_Arabic_khah             = $05ce;     { U+062E ARABIC LETTER KHAH }
+  XK_Arabic_dal              = $05cf;     { U+062F ARABIC LETTER DAL }
+  XK_Arabic_thal             = $05d0;     { U+0630 ARABIC LETTER THAL }
+  XK_Arabic_ra               = $05d1;     { U+0631 ARABIC LETTER REH }
+  XK_Arabic_zain             = $05d2;     { U+0632 ARABIC LETTER ZAIN }
+  XK_Arabic_seen             = $05d3;     { U+0633 ARABIC LETTER SEEN }
+  XK_Arabic_sheen            = $05d4;     { U+0634 ARABIC LETTER SHEEN }
+  XK_Arabic_sad              = $05d5;     { U+0635 ARABIC LETTER SAD }
+  XK_Arabic_dad              = $05d6;     { U+0636 ARABIC LETTER DAD }
+  XK_Arabic_tah              = $05d7;     { U+0637 ARABIC LETTER TAH }
+  XK_Arabic_zah              = $05d8;     { U+0638 ARABIC LETTER ZAH }
+  XK_Arabic_ain              = $05d9;     { U+0639 ARABIC LETTER AIN }
+  XK_Arabic_ghain            = $05da;     { U+063A ARABIC LETTER GHAIN }
+  XK_Arabic_tatweel          = $05e0;     { U+0640 ARABIC TATWEEL }
+  XK_Arabic_feh              = $05e1;     { U+0641 ARABIC LETTER FEH }
+  XK_Arabic_qaf              = $05e2;     { U+0642 ARABIC LETTER QAF }
+  XK_Arabic_kaf              = $05e3;     { U+0643 ARABIC LETTER KAF }
+  XK_Arabic_lam              = $05e4;     { U+0644 ARABIC LETTER LAM }
+  XK_Arabic_meem             = $05e5;     { U+0645 ARABIC LETTER MEEM }
+  XK_Arabic_noon             = $05e6;     { U+0646 ARABIC LETTER NOON }
+  XK_Arabic_ha               = $05e7;     { U+0647 ARABIC LETTER HEH }
+  XK_Arabic_heh              = $05e7;     { deprecated }
+  XK_Arabic_waw              = $05e8;     { U+0648 ARABIC LETTER WAW }
+  XK_Arabic_alefmaksura      = $05e9;     { U+0649 ARABIC LETTER ALEF MAKSURA }
+  XK_Arabic_yeh              = $05ea;     { U+064A ARABIC LETTER YEH }
+  XK_Arabic_fathatan         = $05eb;     { U+064B ARABIC FATHATAN }
+  XK_Arabic_dammatan         = $05ec;     { U+064C ARABIC DAMMATAN }
+  XK_Arabic_kasratan         = $05ed;     { U+064D ARABIC KASRATAN }
+  XK_Arabic_fatha            = $05ee;     { U+064E ARABIC FATHA }
+  XK_Arabic_damma            = $05ef;     { U+064F ARABIC DAMMA }
+  XK_Arabic_kasra            = $05f0;     { U+0650 ARABIC KASRA }
+  XK_Arabic_shadda           = $05f1;     { U+0651 ARABIC SHADDA }
+  XK_Arabic_sukun            = $05f2;     { U+0652 ARABIC SUKUN }
+  XK_Arabic_madda_above      = $1000653;  { U+0653 ARABIC MADDAH ABOVE }
+  XK_Arabic_hamza_above      = $1000654;  { U+0654 ARABIC HAMZA ABOVE }
+  XK_Arabic_hamza_below      = $1000655;  { U+0655 ARABIC HAMZA BELOW }
+  XK_Arabic_jeh              = $1000698;  { U+0698 ARABIC LETTER JEH }
+  XK_Arabic_veh              = $10006a4;  { U+06A4 ARABIC LETTER VEH }
+  XK_Arabic_keheh            = $10006a9;  { U+06A9 ARABIC LETTER KEHEH }
+  XK_Arabic_gaf              = $10006af;  { U+06AF ARABIC LETTER GAF }
+  XK_Arabic_noon_ghunna      = $10006ba;  { U+06BA ARABIC LETTER NOON GHUNNA }
+  XK_Arabic_heh_doachashmee  = $10006be;  { U+06BE ARABIC LETTER HEH DOACHASHMEE }
+  XK_Farsi_yeh               = $10006cc;  { U+06CC ARABIC LETTER FARSI YEH }
+  XK_Arabic_farsi_yeh        = $10006cc;  { U+06CC ARABIC LETTER FARSI YEH }
+  XK_Arabic_yeh_baree        = $10006d2;  { U+06D2 ARABIC LETTER YEH BARREE }
+  XK_Arabic_heh_goal         = $10006c1;  { U+06C1 ARABIC LETTER HEH GOAL }
+  XK_Arabic_switch           = $ff7e;     { Alias for mode_switch }
 {$ENDIF} { XK_ARABIC }
 
 {*
@@ -983,1027 +1037,1395 @@ Const
  * Byte 3 = 6
  *}
 {$IFDEF XK_CYRILLIC}
-  XKc_Cyrillic_GHE_bar                             = $680;
-  XK_Cyrillic_ghe_bar                              = $690;
-  XKc_Cyrillic_ZHE_descender                       = $681;
-  XK_Cyrillic_zhe_descender                        = $691;
-  XKc_Cyrillic_KA_descender                        = $682;
-  XK_Cyrillic_ka_descender                         = $692;
-  XKc_Cyrillic_KA_vertstroke                       = $683;
-  XK_Cyrillic_ka_vertstroke                        = $693;
-  XKc_Cyrillic_EN_descender                        = $684;
-  XK_Cyrillic_en_descender                         = $694;
-  XKc_Cyrillic_U_straight                              = $685;
-  XK_Cyrillic_u_straight                               = $695;
-  XKc_Cyrillic_U_straight_bar                      = $686;
-  XK_Cyrillic_u_straight_bar                       = $696;
-  XKc_Cyrillic_HA_descender                        = $687;
-  XK_Cyrillic_ha_descender                         = $697;
-  XKc_Cyrillic_CHE_descender                       = $688;
-  XK_Cyrillic_che_descender                        = $698;
-  XKc_Cyrillic_CHE_vertstroke                      = $689;
-  XK_Cyrillic_che_vertstroke                       = $699;
-  XKc_Cyrillic_SHHA                                = $68a;
-  XK_Cyrillic_shha                                 = $69a;
-
-  XKc_Cyrillic_SCHWA                               = $68c;
-  XK_Cyrillic_schwa                                = $69c;
-  XKc_Cyrillic_I_macron                            = $68d;
-  XK_Cyrillic_i_macron                             = $69d;
-  XKc_Cyrillic_O_bar                               = $68e;
-  XK_Cyrillic_o_bar                                = $69e;
-  XKc_Cyrillic_U_macron                            = $68f;
-  XK_Cyrillic_u_macron                             = $69f;
-
-  XK_Serbian_dje                                 = $6a1;
-  XK_Macedonia_gje                               = $6a2;
-  XK_Cyrillic_io                                 = $6a3;
-  XK_Ukrainian_ie                                = $6a4;
-  XK_Ukranian_je                                 = $6a4;  { deprecated }
-  XK_Macedonia_dse                               = $6a5;
-  XK_Ukrainian_i                                 = $6a6;
-  XK_Ukranian_i                                  = $6a6;  { deprecated }
-  XK_Ukrainian_yi                                = $6a7;
-  XK_Ukranian_yi                                 = $6a7;  { deprecated }
-  XK_Cyrillic_je                                 = $6a8;
-  XK_Serbian_je                                  = $6a8;  { deprecated }
-  XK_Cyrillic_lje                                = $6a9;
-  XK_Serbian_lje                                 = $6a9;  { deprecated }
-  XK_Cyrillic_nje                                = $6aa;
-  XK_Serbian_nje                                 = $6aa;  { deprecated }
-  XK_Serbian_tshe                                = $6ab;
-  XK_Macedonia_kje                               = $6ac;
-  XK_Ukrainian_ghe_with_upturn                   = $6ad;
-  XK_Byelorussian_shortu                         = $6ae;
-  XK_Cyrillic_dzhe                               = $6af;
-  XK_Serbian_dze                                 = $6af;  { deprecated }
-  XK_numerosign                                  = $6b0;
-  XKc_Serbian_DJE                                 = $6b1;
-  XKc_Macedonia_GJE                               = $6b2;
-  XKc_Cyrillic_IO                                 = $6b3;
-  XKc_Ukrainian_IE                                = $6b4;
-  XKc_Ukranian_JE                                 = $6b4;  { deprecated }
-  XKc_Macedonia_DSE                               = $6b5;
-  XKc_Ukrainian_I                                 = $6b6;
-  XKc_Ukranian_I                                  = $6b6;  { deprecated }
-  XKc_Ukrainian_YI                                = $6b7;
-  XKc_Ukranian_YI                                 = $6b7;  { deprecated }
-  XKc_Cyrillic_JE                                 = $6b8;
-  XKc_Serbian_JE                                  = $6b8;  { deprecated }
-  XKc_Cyrillic_LJE                                = $6b9;
-  XKc_Serbian_LJE                                 = $6b9;  { deprecated }
-  XKc_Cyrillic_NJE                                = $6ba;
-  XKc_Serbian_NJE                                 = $6ba;  { deprecated }
-  XKc_Serbian_TSHE                                = $6bb;
-  XKc_Macedonia_KJE                               = $6bc;
-  XKc_Ukrainian_GHE_WITH_UPTURN                   = $6bd;
-  XKc_Byelorussian_SHORTU                         = $6be;
-  XKc_Cyrillic_DZHE                               = $6bf;
-  XKc_Serbian_DZE                                 = $6bf;  { deprecated }
-  XK_Cyrillic_yu                                 = $6c0;
-  XK_Cyrillic_a                                  = $6c1;
-  XK_Cyrillic_be                                 = $6c2;
-  XK_Cyrillic_tse                                = $6c3;
-  XK_Cyrillic_de                                 = $6c4;
-  XK_Cyrillic_ie                                 = $6c5;
-  XK_Cyrillic_ef                                 = $6c6;
-  XK_Cyrillic_ghe                                = $6c7;
-  XK_Cyrillic_ha                                 = $6c8;
-  XK_Cyrillic_i                                  = $6c9;
-  XK_Cyrillic_shorti                             = $6ca;
-  XK_Cyrillic_ka                                 = $6cb;
-  XK_Cyrillic_el                                 = $6cc;
-  XK_Cyrillic_em                                 = $6cd;
-  XK_Cyrillic_en                                 = $6ce;
-  XK_Cyrillic_o                                  = $6cf;
-  XK_Cyrillic_pe                                 = $6d0;
-  XK_Cyrillic_ya                                 = $6d1;
-  XK_Cyrillic_er                                 = $6d2;
-  XK_Cyrillic_es                                 = $6d3;
-  XK_Cyrillic_te                                 = $6d4;
-  XK_Cyrillic_u                                  = $6d5;
-  XK_Cyrillic_zhe                                = $6d6;
-  XK_Cyrillic_ve                                 = $6d7;
-  XK_Cyrillic_softsign                           = $6d8;
-  XK_Cyrillic_yeru                               = $6d9;
-  XK_Cyrillic_ze                                 = $6da;
-  XK_Cyrillic_sha                                = $6db;
-  XK_Cyrillic_e                                  = $6dc;
-  XK_Cyrillic_shcha                              = $6dd;
-  XK_Cyrillic_che                                = $6de;
-  XK_Cyrillic_hardsign                           = $6df;
-  XKc_Cyrillic_YU                                 = $6e0;
-  XKc_Cyrillic_A                                  = $6e1;
-  XKc_Cyrillic_BE                                 = $6e2;
-  XKc_Cyrillic_TSE                                = $6e3;
-  XKc_Cyrillic_DE                                 = $6e4;
-  XKc_Cyrillic_IE                                 = $6e5;
-  XKc_Cyrillic_EF                                 = $6e6;
-  XKc_Cyrillic_GHE                                = $6e7;
-  XKc_Cyrillic_HA                                 = $6e8;
-  XKc_Cyrillic_I                                  = $6e9;
-  XKc_Cyrillic_SHORTI                             = $6ea;
-  XKc_Cyrillic_KA                                 = $6eb;
-  XKc_Cyrillic_EL                                 = $6ec;
-  XKc_Cyrillic_EM                                 = $6ed;
-  XKc_Cyrillic_EN                                 = $6ee;
-  XKc_Cyrillic_O                                  = $6ef;
-  XKc_Cyrillic_PE                                 = $6f0;
-  XKc_Cyrillic_YA                                 = $6f1;
-  XKc_Cyrillic_ER                                 = $6f2;
-  XKc_Cyrillic_ES                                 = $6f3;
-  XKc_Cyrillic_TE                                 = $6f4;
-  XKc_Cyrillic_U                                  = $6f5;
-  XKc_Cyrillic_ZHE                                = $6f6;
-  XKc_Cyrillic_VE                                 = $6f7;
-  XKc_Cyrillic_SOFTSIGN                           = $6f8;
-  XKc_Cyrillic_YERU                               = $6f9;
-  XKc_Cyrillic_ZE                                 = $6fa;
-  XKc_Cyrillic_SHA                                = $6fb;
-  XKc_Cyrillic_E                                  = $6fc;
-  XKc_Cyrillic_SHCHA                              = $6fd;
-  XKc_Cyrillic_CHE                                = $6fe;
-  XKc_Cyrillic_HARDSIGN                           = $6ff;
+  XKc_Cyrillic_GHE_bar          = $1000492;  { U+0492 CYRILLIC CAPITAL LETTER GHE WITH STROKE }
+  XK_Cyrillic_ghe_bar           = $1000493;  { U+0493 CYRILLIC SMALL LETTER GHE WITH STROKE }
+  XKc_Cyrillic_ZHE_descender    = $1000496;  { U+0496 CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER }
+  XK_Cyrillic_zhe_descender     = $1000497;  { U+0497 CYRILLIC SMALL LETTER ZHE WITH DESCENDER }
+  XKc_Cyrillic_KA_descender     = $100049a;  { U+049A CYRILLIC CAPITAL LETTER KA WITH DESCENDER }
+  XK_Cyrillic_ka_descender      = $100049b;  { U+049B CYRILLIC SMALL LETTER KA WITH DESCENDER }
+  XKc_Cyrillic_KA_vertstroke    = $100049c;  { U+049C CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE }
+  XK_Cyrillic_ka_vertstroke     = $100049d;  { U+049D CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE }
+  XKc_Cyrillic_EN_descender     = $10004a2;  { U+04A2 CYRILLIC CAPITAL LETTER EN WITH DESCENDER }
+  XK_Cyrillic_en_descender      = $10004a3;  { U+04A3 CYRILLIC SMALL LETTER EN WITH DESCENDER }
+  XKc_Cyrillic_U_straight       = $10004ae;  { U+04AE CYRILLIC CAPITAL LETTER STRAIGHT U }
+  XK_Cyrillic_u_straight        = $10004af;  { U+04AF CYRILLIC SMALL LETTER STRAIGHT U }
+  XKc_Cyrillic_U_straight_bar   = $10004b0;  { U+04B0 CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE }
+  XK_Cyrillic_u_straight_bar    = $10004b1;  { U+04B1 CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE }
+  XKc_Cyrillic_HA_descender     = $10004b2;  { U+04B2 CYRILLIC CAPITAL LETTER HA WITH DESCENDER }
+  XK_Cyrillic_ha_descender      = $10004b3;  { U+04B3 CYRILLIC SMALL LETTER HA WITH DESCENDER }
+  XKc_Cyrillic_CHE_descender    = $10004b6;  { U+04B6 CYRILLIC CAPITAL LETTER CHE WITH DESCENDER }
+  XK_Cyrillic_che_descender     = $10004b7;  { U+04B7 CYRILLIC SMALL LETTER CHE WITH DESCENDER }
+  XKc_Cyrillic_CHE_vertstroke   = $10004b8;  { U+04B8 CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE }
+  XK_Cyrillic_che_vertstroke    = $10004b9;  { U+04B9 CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE }
+  XKc_Cyrillic_SHHA             = $10004ba;  { U+04BA CYRILLIC CAPITAL LETTER SHHA }
+  XK_Cyrillic_shha              = $10004bb;  { U+04BB CYRILLIC SMALL LETTER SHHA }
+
+  XKc_Cyrillic_SCHWA            = $10004d8;  { U+04D8 CYRILLIC CAPITAL LETTER SCHWA }
+  XK_Cyrillic_schwa             = $10004d9;  { U+04D9 CYRILLIC SMALL LETTER SCHWA }
+  XKc_Cyrillic_I_macron         = $10004e2;  { U+04E2 CYRILLIC CAPITAL LETTER I WITH MACRON }
+  XK_Cyrillic_i_macron          = $10004e3;  { U+04E3 CYRILLIC SMALL LETTER I WITH MACRON }
+  XKc_Cyrillic_O_bar            = $10004e8;  { U+04E8 CYRILLIC CAPITAL LETTER BARRED O }
+  XK_Cyrillic_o_bar             = $10004e9;  { U+04E9 CYRILLIC SMALL LETTER BARRED O }
+  XKc_Cyrillic_U_macron         = $10004ee;  { U+04EE CYRILLIC CAPITAL LETTER U WITH MACRON }
+  XK_Cyrillic_u_macron          = $10004ef;  { U+04EF CYRILLIC SMALL LETTER U WITH MACRON }
+
+  XK_Serbian_dje                = $06a1;     { U+0452 CYRILLIC SMALL LETTER DJE }
+  XK_Macedonia_gje              = $06a2;     { U+0453 CYRILLIC SMALL LETTER GJE }
+  XK_Cyrillic_io                = $06a3;     { U+0451 CYRILLIC SMALL LETTER IO }
+  XK_Ukrainian_ie               = $06a4;     { U+0454 CYRILLIC SMALL LETTER UKRAINIAN IE }
+  XK_Ukranian_je                = $06a4;     { deprecated }
+  XK_Macedonia_dse              = $06a5;     { U+0455 CYRILLIC SMALL LETTER DZE }
+  XK_Ukrainian_i                = $06a6;     { U+0456 CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I }
+  XK_Ukranian_i                 = $06a6;     { deprecated }
+  XK_Ukrainian_yi               = $06a7;     { U+0457 CYRILLIC SMALL LETTER YI }
+  XK_Ukranian_yi                = $06a7;     { deprecated }
+  XK_Cyrillic_je                = $06a8;     { U+0458 CYRILLIC SMALL LETTER JE }
+  XK_Serbian_je                 = $06a8;     { deprecated }
+  XK_Cyrillic_lje               = $06a9;     { U+0459 CYRILLIC SMALL LETTER LJE }
+  XK_Serbian_lje                = $06a9;     { deprecated }
+  XK_Cyrillic_nje               = $06aa;     { U+045A CYRILLIC SMALL LETTER NJE }
+  XK_Serbian_nje                = $06aa;     { deprecated }
+  XK_Serbian_tshe               = $06ab;     { U+045B CYRILLIC SMALL LETTER TSHE }
+  XK_Macedonia_kje              = $06ac;     { U+045C CYRILLIC SMALL LETTER KJE }
+  XK_Ukrainian_ghe_with_upturn  = $06ad;     { U+0491 CYRILLIC SMALL LETTER GHE WITH UPTURN }
+  XK_Byelorussian_shortu        = $06ae;     { U+045E CYRILLIC SMALL LETTER SHORT U }
+  XK_Cyrillic_dzhe              = $06af;     { U+045F CYRILLIC SMALL LETTER DZHE }
+  XK_Serbian_dze                = $06af;     { deprecated }
+  XK_numerosign                 = $06b0;     { U+2116 NUMERO SIGN }
+  XKc_Serbian_DJE               = $06b1;     { U+0402 CYRILLIC CAPITAL LETTER DJE }
+  XKc_Macedonia_GJE             = $06b2;     { U+0403 CYRILLIC CAPITAL LETTER GJE }
+  XKc_Cyrillic_IO               = $06b3;     { U+0401 CYRILLIC CAPITAL LETTER IO }
+  XKc_Ukrainian_IE              = $06b4;     { U+0404 CYRILLIC CAPITAL LETTER UKRAINIAN IE }
+  XKc_Ukranian_JE               = $06b4;     { deprecated }
+  XKc_Macedonia_DSE             = $06b5;     { U+0405 CYRILLIC CAPITAL LETTER DZE }
+  XKc_Ukrainian_I               = $06b6;     { U+0406 CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I }
+  XKc_Ukranian_I                = $06b6;     { deprecated }
+  XKc_Ukrainian_YI              = $06b7;     { U+0407 CYRILLIC CAPITAL LETTER YI }
+  XKc_Ukranian_YI               = $06b7;     { deprecated }
+  XKc_Cyrillic_JE               = $06b8;     { U+0408 CYRILLIC CAPITAL LETTER JE }
+  XKc_Serbian_JE                = $06b8;     { deprecated }
+  XKc_Cyrillic_LJE              = $06b9;     { U+0409 CYRILLIC CAPITAL LETTER LJE }
+  XKc_Serbian_LJE               = $06b9;     { deprecated }
+  XKc_Cyrillic_NJE              = $06ba;     { U+040A CYRILLIC CAPITAL LETTER NJE }
+  XKc_Serbian_NJE               = $06ba;     { deprecated }
+  XKc_Serbian_TSHE              = $06bb;     { U+040B CYRILLIC CAPITAL LETTER TSHE }
+  XKc_Macedonia_KJE             = $06bc;     { U+040C CYRILLIC CAPITAL LETTER KJE }
+  XKc_Ukrainian_GHE_WITH_UPTURN = $06bd;     { U+0490 CYRILLIC CAPITAL LETTER GHE WITH UPTURN }
+  XKc_Byelorussian_SHORTU       = $06be;     { U+040E CYRILLIC CAPITAL LETTER SHORT U }
+  XKc_Cyrillic_DZHE             = $06bf;     { U+040F CYRILLIC CAPITAL LETTER DZHE }
+  XKc_Serbian_DZE               = $06bf;     { deprecated }
+  XK_Cyrillic_yu                = $06c0;     { U+044E CYRILLIC SMALL LETTER YU }
+  XK_Cyrillic_a                 = $06c1;     { U+0430 CYRILLIC SMALL LETTER A }
+  XK_Cyrillic_be                = $06c2;     { U+0431 CYRILLIC SMALL LETTER BE }
+  XK_Cyrillic_tse               = $06c3;     { U+0446 CYRILLIC SMALL LETTER TSE }
+  XK_Cyrillic_de                = $06c4;     { U+0434 CYRILLIC SMALL LETTER DE }
+  XK_Cyrillic_ie                = $06c5;     { U+0435 CYRILLIC SMALL LETTER IE }
+  XK_Cyrillic_ef                = $06c6;     { U+0444 CYRILLIC SMALL LETTER EF }
+  XK_Cyrillic_ghe               = $06c7;     { U+0433 CYRILLIC SMALL LETTER GHE }
+  XK_Cyrillic_ha                = $06c8;     { U+0445 CYRILLIC SMALL LETTER HA }
+  XK_Cyrillic_i                 = $06c9;     { U+0438 CYRILLIC SMALL LETTER I }
+  XK_Cyrillic_shorti            = $06ca;     { U+0439 CYRILLIC SMALL LETTER SHORT I }
+  XK_Cyrillic_ka                = $06cb;     { U+043A CYRILLIC SMALL LETTER KA }
+  XK_Cyrillic_el                = $06cc;     { U+043B CYRILLIC SMALL LETTER EL }
+  XK_Cyrillic_em                = $06cd;     { U+043C CYRILLIC SMALL LETTER EM }
+  XK_Cyrillic_en                = $06ce;     { U+043D CYRILLIC SMALL LETTER EN }
+  XK_Cyrillic_o                 = $06cf;     { U+043E CYRILLIC SMALL LETTER O }
+  XK_Cyrillic_pe                = $06d0;     { U+043F CYRILLIC SMALL LETTER PE }
+  XK_Cyrillic_ya                = $06d1;     { U+044F CYRILLIC SMALL LETTER YA }
+  XK_Cyrillic_er                = $06d2;     { U+0440 CYRILLIC SMALL LETTER ER }
+  XK_Cyrillic_es                = $06d3;     { U+0441 CYRILLIC SMALL LETTER ES }
+  XK_Cyrillic_te                = $06d4;     { U+0442 CYRILLIC SMALL LETTER TE }
+  XK_Cyrillic_u                 = $06d5;     { U+0443 CYRILLIC SMALL LETTER U }
+  XK_Cyrillic_zhe               = $06d6;     { U+0436 CYRILLIC SMALL LETTER ZHE }
+  XK_Cyrillic_ve                = $06d7;     { U+0432 CYRILLIC SMALL LETTER VE }
+  XK_Cyrillic_softsign          = $06d8;     { U+044C CYRILLIC SMALL LETTER SOFT SIGN }
+  XK_Cyrillic_yeru              = $06d9;     { U+044B CYRILLIC SMALL LETTER YERU }
+  XK_Cyrillic_ze                = $06da;     { U+0437 CYRILLIC SMALL LETTER ZE }
+  XK_Cyrillic_sha               = $06db;     { U+0448 CYRILLIC SMALL LETTER SHA }
+  XK_Cyrillic_e                 = $06dc;     { U+044D CYRILLIC SMALL LETTER E }
+  XK_Cyrillic_shcha             = $06dd;     { U+0449 CYRILLIC SMALL LETTER SHCHA }
+  XK_Cyrillic_che               = $06de;     { U+0447 CYRILLIC SMALL LETTER CHE }
+  XK_Cyrillic_hardsign          = $06df;     { U+044A CYRILLIC SMALL LETTER HARD SIGN }
+  XKc_Cyrillic_YU               = $06e0;     { U+042E CYRILLIC CAPITAL LETTER YU }
+  XKc_Cyrillic_A                = $06e1;     { U+0410 CYRILLIC CAPITAL LETTER A }
+  XKc_Cyrillic_BE               = $06e2;     { U+0411 CYRILLIC CAPITAL LETTER BE }
+  XKc_Cyrillic_TSE              = $06e3;     { U+0426 CYRILLIC CAPITAL LETTER TSE }
+  XKc_Cyrillic_DE               = $06e4;     { U+0414 CYRILLIC CAPITAL LETTER DE }
+  XKc_Cyrillic_IE               = $06e5;     { U+0415 CYRILLIC CAPITAL LETTER IE }
+  XKc_Cyrillic_EF               = $06e6;     { U+0424 CYRILLIC CAPITAL LETTER EF }
+  XKc_Cyrillic_GHE              = $06e7;     { U+0413 CYRILLIC CAPITAL LETTER GHE }
+  XKc_Cyrillic_HA               = $06e8;     { U+0425 CYRILLIC CAPITAL LETTER HA }
+  XKc_Cyrillic_I                = $06e9;     { U+0418 CYRILLIC CAPITAL LETTER I }
+  XKc_Cyrillic_SHORTI           = $06ea;     { U+0419 CYRILLIC CAPITAL LETTER SHORT I }
+  XKc_Cyrillic_KA               = $06eb;     { U+041A CYRILLIC CAPITAL LETTER KA }
+  XKc_Cyrillic_EL               = $06ec;     { U+041B CYRILLIC CAPITAL LETTER EL }
+  XKc_Cyrillic_EM               = $06ed;     { U+041C CYRILLIC CAPITAL LETTER EM }
+  XKc_Cyrillic_EN               = $06ee;     { U+041D CYRILLIC CAPITAL LETTER EN }
+  XKc_Cyrillic_O                = $06ef;     { U+041E CYRILLIC CAPITAL LETTER O }
+  XKc_Cyrillic_PE               = $06f0;     { U+041F CYRILLIC CAPITAL LETTER PE }
+  XKc_Cyrillic_YA               = $06f1;     { U+042F CYRILLIC CAPITAL LETTER YA }
+  XKc_Cyrillic_ER               = $06f2;     { U+0420 CYRILLIC CAPITAL LETTER ER }
+  XKc_Cyrillic_ES               = $06f3;     { U+0421 CYRILLIC CAPITAL LETTER ES }
+  XKc_Cyrillic_TE               = $06f4;     { U+0422 CYRILLIC CAPITAL LETTER TE }
+  XKc_Cyrillic_U                = $06f5;     { U+0423 CYRILLIC CAPITAL LETTER U }
+  XKc_Cyrillic_ZHE              = $06f6;     { U+0416 CYRILLIC CAPITAL LETTER ZHE }
+  XKc_Cyrillic_VE               = $06f7;     { U+0412 CYRILLIC CAPITAL LETTER VE }
+  XKc_Cyrillic_SOFTSIGN         = $06f8;     { U+042C CYRILLIC CAPITAL LETTER SOFT SIGN }
+  XKc_Cyrillic_YERU             = $06f9;     { U+042B CYRILLIC CAPITAL LETTER YERU }
+  XKc_Cyrillic_ZE               = $06fa;     { U+0417 CYRILLIC CAPITAL LETTER ZE }
+  XKc_Cyrillic_SHA              = $06fb;     { U+0428 CYRILLIC CAPITAL LETTER SHA }
+  XKc_Cyrillic_E                = $06fc;     { U+042D CYRILLIC CAPITAL LETTER E }
+  XKc_Cyrillic_SHCHA            = $06fd;     { U+0429 CYRILLIC CAPITAL LETTER SHCHA }
+  XKc_Cyrillic_CHE              = $06fe;     { U+0427 CYRILLIC CAPITAL LETTER CHE }
+  XKc_Cyrillic_HARDSIGN         = $06ff;     { U+042A CYRILLIC CAPITAL LETTER HARD SIGN }
 {$ENDIF} { XK_CYRILLIC }
 
 {*
  * Greek
+ * (based on an early draft of, and not quite identical to, ISO/IEC 8859-7)
  * Byte 3 = 7
  *}
 
 {$IFDEF XK_GREEK}
-  XKc_Greek_ALPHAaccent                           = $7a1;
-  XKc_Greek_EPSILONaccent                         = $7a2;
-  XKc_Greek_ETAaccent                             = $7a3;
-  XKc_Greek_IOTAaccent                            = $7a4;
-  XKc_Greek_IOTAdieresis                          = $7a5;
-  XKc_Greek_IOTAdiaeresis = XKc_Greek_IOTAdieresis; { old typo }
-  XKc_Greek_OMICRONaccent                         = $7a7;
-  XKc_Greek_UPSILONaccent                         = $7a8;
-  XKc_Greek_UPSILONdieresis                       = $7a9;
-  XKc_Greek_OMEGAaccent                           = $7ab;
-  XK_Greek_accentdieresis                        = $7ae;
-  XK_Greek_horizbar                              = $7af;
-  XK_Greek_alphaaccent                           = $7b1;
-  XK_Greek_epsilonaccent                         = $7b2;
-  XK_Greek_etaaccent                             = $7b3;
-  XK_Greek_iotaaccent                            = $7b4;
-  XK_Greek_iotadieresis                          = $7b5;
-  XK_Greek_iotaaccentdieresis                    = $7b6;
-  XK_Greek_omicronaccent                         = $7b7;
-  XK_Greek_upsilonaccent                         = $7b8;
-  XK_Greek_upsilondieresis                       = $7b9;
-  XK_Greek_upsilonaccentdieresis                 = $7ba;
-  XK_Greek_omegaaccent                           = $7bb;
-  XKc_Greek_ALPHA                                 = $7c1;
-  XKc_Greek_BETA                                  = $7c2;
-  XKc_Greek_GAMMA                                 = $7c3;
-  XKc_Greek_DELTA                                 = $7c4;
-  XKc_Greek_EPSILON                               = $7c5;
-  XKc_Greek_ZETA                                  = $7c6;
-  XKc_Greek_ETA                                   = $7c7;
-  XKc_Greek_THETA                                 = $7c8;
-  XKc_Greek_IOTA                                  = $7c9;
-  XKc_Greek_KAPPA                                 = $7ca;
-  XKc_Greek_LAMDA                                 = $7cb;
-  XKc_Greek_LAMBDA                                = $7cb;
-  XKc_Greek_MU                                    = $7cc;
-  XKc_Greek_NU                                    = $7cd;
-  XKc_Greek_XI                                    = $7ce;
-  XKc_Greek_OMICRON                               = $7cf;
-  XKc_Greek_PI                                    = $7d0;
-  XKc_Greek_RHO                                   = $7d1;
-  XKc_Greek_SIGMA                                 = $7d2;
-  XKc_Greek_TAU                                   = $7d4;
-  XKc_Greek_UPSILON                               = $7d5;
-  XKc_Greek_PHI                                   = $7d6;
-  XKc_Greek_CHI                                   = $7d7;
-  XKc_Greek_PSI                                   = $7d8;
-  XKc_Greek_OMEGA                                 = $7d9;
-  XK_Greek_alpha                                 = $7e1;
-  XK_Greek_beta                                  = $7e2;
-  XK_Greek_gamma                                 = $7e3;
-  XK_Greek_delta                                 = $7e4;
-  XK_Greek_epsilon                               = $7e5;
-  XK_Greek_zeta                                  = $7e6;
-  XK_Greek_eta                                   = $7e7;
-  XK_Greek_theta                                 = $7e8;
-  XK_Greek_iota                                  = $7e9;
-  XK_Greek_kappa                                 = $7ea;
-  XK_Greek_lamda                                 = $7eb;
-  XK_Greek_lambda                                = $7eb;
-  XK_Greek_mu                                    = $7ec;
-  XK_Greek_nu                                    = $7ed;
-  XK_Greek_xi                                    = $7ee;
-  XK_Greek_omicron                               = $7ef;
-  XK_Greek_pi                                    = $7f0;
-  XK_Greek_rho                                   = $7f1;
-  XK_Greek_sigma                                 = $7f2;
-  XK_Greek_finalsmallsigma                       = $7f3;
-  XK_Greek_tau                                   = $7f4;
-  XK_Greek_upsilon                               = $7f5;
-  XK_Greek_phi                                   = $7f6;
-  XK_Greek_chi                                   = $7f7;
-  XK_Greek_psi                                   = $7f8;
-  XK_Greek_omega                                 = $7f9;
-  XK_Greek_switch         = $FF7E;  { Alias for mode_switch }
+  XKc_Greek_ALPHAaccent          = $07a1;  { U+0386 GREEK CAPITAL LETTER ALPHA WITH TONOS }
+  XKc_Greek_EPSILONaccent        = $07a2;  { U+0388 GREEK CAPITAL LETTER EPSILON WITH TONOS }
+  XKc_Greek_ETAaccent            = $07a3;  { U+0389 GREEK CAPITAL LETTER ETA WITH TONOS }
+  XKc_Greek_IOTAaccent           = $07a4;  { U+038A GREEK CAPITAL LETTER IOTA WITH TONOS }
+  XKc_Greek_IOTAdieresis         = $07a5;  { U+03AA GREEK CAPITAL LETTER IOTA WITH DIALYTIKA }
+  XKc_Greek_IOTAdiaeresis        = $07a5;  { old typo }
+  XKc_Greek_OMICRONaccent        = $07a7;  { U+038C GREEK CAPITAL LETTER OMICRON WITH TONOS }
+  XKc_Greek_UPSILONaccent        = $07a8;  { U+038E GREEK CAPITAL LETTER UPSILON WITH TONOS }
+  XKc_Greek_UPSILONdieresis      = $07a9;  { U+03AB GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA }
+  XKc_Greek_OMEGAaccent          = $07ab;  { U+038F GREEK CAPITAL LETTER OMEGA WITH TONOS }
+  XK_Greek_accentdieresis        = $07ae;  { U+0385 GREEK DIALYTIKA TONOS }
+  XK_Greek_horizbar              = $07af;  { U+2015 HORIZONTAL BAR }
+  XK_Greek_alphaaccent           = $07b1;  { U+03AC GREEK SMALL LETTER ALPHA WITH TONOS }
+  XK_Greek_epsilonaccent         = $07b2;  { U+03AD GREEK SMALL LETTER EPSILON WITH TONOS }
+  XK_Greek_etaaccent             = $07b3;  { U+03AE GREEK SMALL LETTER ETA WITH TONOS }
+  XK_Greek_iotaaccent            = $07b4;  { U+03AF GREEK SMALL LETTER IOTA WITH TONOS }
+  XK_Greek_iotadieresis          = $07b5;  { U+03CA GREEK SMALL LETTER IOTA WITH DIALYTIKA }
+  XK_Greek_iotaaccentdieresis    = $07b6;  { U+0390 GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS }
+  XK_Greek_omicronaccent         = $07b7;  { U+03CC GREEK SMALL LETTER OMICRON WITH TONOS }
+  XK_Greek_upsilonaccent         = $07b8;  { U+03CD GREEK SMALL LETTER UPSILON WITH TONOS }
+  XK_Greek_upsilondieresis       = $07b9;  { U+03CB GREEK SMALL LETTER UPSILON WITH DIALYTIKA }
+  XK_Greek_upsilonaccentdieresis = $07ba;  { U+03B0 GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS }
+  XK_Greek_omegaaccent           = $07bb;  { U+03CE GREEK SMALL LETTER OMEGA WITH TONOS }
+  XKc_Greek_ALPHA                = $07c1;  { U+0391 GREEK CAPITAL LETTER ALPHA }
+  XKc_Greek_BETA                 = $07c2;  { U+0392 GREEK CAPITAL LETTER BETA }
+  XKc_Greek_GAMMA                = $07c3;  { U+0393 GREEK CAPITAL LETTER GAMMA }
+  XKc_Greek_DELTA                = $07c4;  { U+0394 GREEK CAPITAL LETTER DELTA }
+  XKc_Greek_EPSILON              = $07c5;  { U+0395 GREEK CAPITAL LETTER EPSILON }
+  XKc_Greek_ZETA                 = $07c6;  { U+0396 GREEK CAPITAL LETTER ZETA }
+  XKc_Greek_ETA                  = $07c7;  { U+0397 GREEK CAPITAL LETTER ETA }
+  XKc_Greek_THETA                = $07c8;  { U+0398 GREEK CAPITAL LETTER THETA }
+  XKc_Greek_IOTA                 = $07c9;  { U+0399 GREEK CAPITAL LETTER IOTA }
+  XKc_Greek_KAPPA                = $07ca;  { U+039A GREEK CAPITAL LETTER KAPPA }
+  XKc_Greek_LAMDA                = $07cb;  { U+039B GREEK CAPITAL LETTER LAMDA }
+  XKc_Greek_LAMBDA               = $07cb;  { U+039B GREEK CAPITAL LETTER LAMDA }
+  XKc_Greek_MU                   = $07cc;  { U+039C GREEK CAPITAL LETTER MU }
+  XKc_Greek_NU                   = $07cd;  { U+039D GREEK CAPITAL LETTER NU }
+  XKc_Greek_XI                   = $07ce;  { U+039E GREEK CAPITAL LETTER XI }
+  XKc_Greek_OMICRON              = $07cf;  { U+039F GREEK CAPITAL LETTER OMICRON }
+  XKc_Greek_PI                   = $07d0;  { U+03A0 GREEK CAPITAL LETTER PI }
+  XKc_Greek_RHO                  = $07d1;  { U+03A1 GREEK CAPITAL LETTER RHO }
+  XKc_Greek_SIGMA                = $07d2;  { U+03A3 GREEK CAPITAL LETTER SIGMA }
+  XKc_Greek_TAU                  = $07d4;  { U+03A4 GREEK CAPITAL LETTER TAU }
+  XKc_Greek_UPSILON              = $07d5;  { U+03A5 GREEK CAPITAL LETTER UPSILON }
+  XKc_Greek_PHI                  = $07d6;  { U+03A6 GREEK CAPITAL LETTER PHI }
+  XKc_Greek_CHI                  = $07d7;  { U+03A7 GREEK CAPITAL LETTER CHI }
+  XKc_Greek_PSI                  = $07d8;  { U+03A8 GREEK CAPITAL LETTER PSI }
+  XKc_Greek_OMEGA                = $07d9;  { U+03A9 GREEK CAPITAL LETTER OMEGA }
+  XK_Greek_alpha                 = $07e1;  { U+03B1 GREEK SMALL LETTER ALPHA }
+  XK_Greek_beta                  = $07e2;  { U+03B2 GREEK SMALL LETTER BETA }
+  XK_Greek_gamma                 = $07e3;  { U+03B3 GREEK SMALL LETTER GAMMA }
+  XK_Greek_delta                 = $07e4;  { U+03B4 GREEK SMALL LETTER DELTA }
+  XK_Greek_epsilon               = $07e5;  { U+03B5 GREEK SMALL LETTER EPSILON }
+  XK_Greek_zeta                  = $07e6;  { U+03B6 GREEK SMALL LETTER ZETA }
+  XK_Greek_eta                   = $07e7;  { U+03B7 GREEK SMALL LETTER ETA }
+  XK_Greek_theta                 = $07e8;  { U+03B8 GREEK SMALL LETTER THETA }
+  XK_Greek_iota                  = $07e9;  { U+03B9 GREEK SMALL LETTER IOTA }
+  XK_Greek_kappa                 = $07ea;  { U+03BA GREEK SMALL LETTER KAPPA }
+  XK_Greek_lamda                 = $07eb;  { U+03BB GREEK SMALL LETTER LAMDA }
+  XK_Greek_lambda                = $07eb;  { U+03BB GREEK SMALL LETTER LAMDA }
+  XK_Greek_mu                    = $07ec;  { U+03BC GREEK SMALL LETTER MU }
+  XK_Greek_nu                    = $07ed;  { U+03BD GREEK SMALL LETTER NU }
+  XK_Greek_xi                    = $07ee;  { U+03BE GREEK SMALL LETTER XI }
+  XK_Greek_omicron               = $07ef;  { U+03BF GREEK SMALL LETTER OMICRON }
+  XK_Greek_pi                    = $07f0;  { U+03C0 GREEK SMALL LETTER PI }
+  XK_Greek_rho                   = $07f1;  { U+03C1 GREEK SMALL LETTER RHO }
+  XK_Greek_sigma                 = $07f2;  { U+03C3 GREEK SMALL LETTER SIGMA }
+  XK_Greek_finalsmallsigma       = $07f3;  { U+03C2 GREEK SMALL LETTER FINAL SIGMA }
+  XK_Greek_tau                   = $07f4;  { U+03C4 GREEK SMALL LETTER TAU }
+  XK_Greek_upsilon               = $07f5;  { U+03C5 GREEK SMALL LETTER UPSILON }
+  XK_Greek_phi                   = $07f6;  { U+03C6 GREEK SMALL LETTER PHI }
+  XK_Greek_chi                   = $07f7;  { U+03C7 GREEK SMALL LETTER CHI }
+  XK_Greek_psi                   = $07f8;  { U+03C8 GREEK SMALL LETTER PSI }
+  XK_Greek_omega                 = $07f9;  { U+03C9 GREEK SMALL LETTER OMEGA }
+  XK_Greek_switch                = $ff7e;  { Alias for mode_switch }
 {$ENDIF} { XK_GREEK }
 
 {*
  * Technical
+ * (from the DEC VT330/VT420 Technical Character Set, http://vt100.net/charsets/technical.html)
  * Byte 3 = 8
  *}
 
 {$IFDEF XK_TECHNICAL}
-  XK_leftradical                                 = $8a1;
-  XK_topleftradical                              = $8a2;
-  XK_horizconnector                              = $8a3;
-  XK_topintegral                                 = $8a4;
-  XK_botintegral                                 = $8a5;
-  XK_vertconnector                               = $8a6;
-  XK_topleftsqbracket                            = $8a7;
-  XK_botleftsqbracket                            = $8a8;
-  XK_toprightsqbracket                           = $8a9;
-  XK_botrightsqbracket                           = $8aa;
-  XK_topleftparens                               = $8ab;
-  XK_botleftparens                               = $8ac;
-  XK_toprightparens                              = $8ad;
-  XK_botrightparens                              = $8ae;
-  XK_leftmiddlecurlybrace                        = $8af;
-  XK_rightmiddlecurlybrace                       = $8b0;
-  XK_topleftsummation                            = $8b1;
-  XK_botleftsummation                            = $8b2;
-  XK_topvertsummationconnector                   = $8b3;
-  XK_botvertsummationconnector                   = $8b4;
-  XK_toprightsummation                           = $8b5;
-  XK_botrightsummation                           = $8b6;
-  XK_rightmiddlesummation                        = $8b7;
-  XK_lessthanequal                               = $8bc;
-  XK_notequal                                    = $8bd;
-  XK_greaterthanequal                            = $8be;
-  XK_integral                                    = $8bf;
-  XK_therefore                                   = $8c0;
-  XK_variation                                   = $8c1;
-  XK_infinity                                    = $8c2;
-  XK_nabla                                       = $8c5;
-  XK_approximate                                 = $8c8;
-  XK_similarequal                                = $8c9;
-  XK_ifonlyif                                    = $8cd;
-  XK_implies                                     = $8ce;
-  XK_identical                                   = $8cf;
-  XK_radical                                     = $8d6;
-  XK_includedin                                  = $8da;
-  XK_includes                                    = $8db;
-  XK_intersection                                = $8dc;
-  XK_union                                       = $8dd;
-  XK_logicaland                                  = $8de;
-  XK_logicalor                                   = $8df;
-  XK_partialderivative                           = $8ef;
-  XK_function                                    = $8f6;
-  XK_leftarrow                                   = $8fb;
-  XK_uparrow                                     = $8fc;
-  XK_rightarrow                                  = $8fd;
-  XK_downarrow                                   = $8fe;
+  XK_leftradical               = $08a1;  { U+23B7 RADICAL SYMBOL BOTTOM }
+  XK_topleftradical            = $08a2;  {(U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT)}
+  XK_horizconnector            = $08a3;  {(U+2500 BOX DRAWINGS LIGHT HORIZONTAL)}
+  XK_topintegral               = $08a4;  { U+2320 TOP HALF INTEGRAL }
+  XK_botintegral               = $08a5;  { U+2321 BOTTOM HALF INTEGRAL }
+  XK_vertconnector             = $08a6;  {(U+2502 BOX DRAWINGS LIGHT VERTICAL)}
+  XK_topleftsqbracket          = $08a7;  { U+23A1 LEFT SQUARE BRACKET UPPER CORNER }
+  XK_botleftsqbracket          = $08a8;  { U+23A3 LEFT SQUARE BRACKET LOWER CORNER }
+  XK_toprightsqbracket         = $08a9;  { U+23A4 RIGHT SQUARE BRACKET UPPER CORNER }
+  XK_botrightsqbracket         = $08aa;  { U+23A6 RIGHT SQUARE BRACKET LOWER CORNER }
+  XK_topleftparens             = $08ab;  { U+239B LEFT PARENTHESIS UPPER HOOK }
+  XK_botleftparens             = $08ac;  { U+239D LEFT PARENTHESIS LOWER HOOK }
+  XK_toprightparens            = $08ad;  { U+239E RIGHT PARENTHESIS UPPER HOOK }
+  XK_botrightparens            = $08ae;  { U+23A0 RIGHT PARENTHESIS LOWER HOOK }
+  XK_leftmiddlecurlybrace      = $08af;  { U+23A8 LEFT CURLY BRACKET MIDDLE PIECE }
+  XK_rightmiddlecurlybrace     = $08b0;  { U+23AC RIGHT CURLY BRACKET MIDDLE PIECE }
+  XK_topleftsummation          = $08b1;
+  XK_botleftsummation          = $08b2;
+  XK_topvertsummationconnector = $08b3;
+  XK_botvertsummationconnector = $08b4;
+  XK_toprightsummation         = $08b5;
+  XK_botrightsummation         = $08b6;
+  XK_rightmiddlesummation      = $08b7;
+  XK_lessthanequal             = $08bc;  { U+2264 LESS-THAN OR EQUAL TO }
+  XK_notequal                  = $08bd;  { U+2260 NOT EQUAL TO }
+  XK_greaterthanequal          = $08be;  { U+2265 GREATER-THAN OR EQUAL TO }
+  XK_integral                  = $08bf;  { U+222B INTEGRAL }
+  XK_therefore                 = $08c0;  { U+2234 THEREFORE }
+  XK_variation                 = $08c1;  { U+221D PROPORTIONAL TO }
+  XK_infinity                  = $08c2;  { U+221E INFINITY }
+  XK_nabla                     = $08c5;  { U+2207 NABLA }
+  XK_approximate               = $08c8;  { U+223C TILDE OPERATOR }
+  XK_similarequal              = $08c9;  { U+2243 ASYMPTOTICALLY EQUAL TO }
+  XK_ifonlyif                  = $08cd;  { U+21D4 LEFT RIGHT DOUBLE ARROW }
+  XK_implies                   = $08ce;  { U+21D2 RIGHTWARDS DOUBLE ARROW }
+  XK_identical                 = $08cf;  { U+2261 IDENTICAL TO }
+  XK_radical                   = $08d6;  { U+221A SQUARE ROOT }
+  XK_includedin                = $08da;  { U+2282 SUBSET OF }
+  XK_includes                  = $08db;  { U+2283 SUPERSET OF }
+  XK_intersection              = $08dc;  { U+2229 INTERSECTION }
+  XK_union                     = $08dd;  { U+222A UNION }
+  XK_logicaland                = $08de;  { U+2227 LOGICAL AND }
+  XK_logicalor                 = $08df;  { U+2228 LOGICAL OR }
+  XK_partialderivative         = $08ef;  { U+2202 PARTIAL DIFFERENTIAL }
+  XK_function                  = $08f6;  { U+0192 LATIN SMALL LETTER F WITH HOOK }
+  XK_leftarrow                 = $08fb;  { U+2190 LEFTWARDS ARROW }
+  XK_uparrow                   = $08fc;  { U+2191 UPWARDS ARROW }
+  XK_rightarrow                = $08fd;  { U+2192 RIGHTWARDS ARROW }
+  XK_downarrow                 = $08fe;  { U+2193 DOWNWARDS ARROW }
 {$ENDIF} { XK_TECHNICAL }
 
 {*
- *  Special
- *  Byte 3 = 9
+ * Special
+ * (from the DEC VT100 Special Graphics Character Set)
+ * Byte 3 = 9
  *}
 
 {$IFDEF XK_SPECIAL}
-  XK_blank                                       = $9df;
-  XK_soliddiamond                                = $9e0;
-  XK_checkerboard                                = $9e1;
-  XK_ht                                          = $9e2;
-  XK_ff                                          = $9e3;
-  XK_cr                                          = $9e4;
-  XK_lf                                          = $9e5;
-  XK_nl                                          = $9e8;
-  XK_vt                                          = $9e9;
-  XK_lowrightcorner                              = $9ea;
-  XK_uprightcorner                               = $9eb;
-  XK_upleftcorner                                = $9ec;
-  XK_lowleftcorner                               = $9ed;
-  XK_crossinglines                               = $9ee;
-  XK_horizlinescan1                              = $9ef;
-  XK_horizlinescan3                              = $9f0;
-  XK_horizlinescan5                              = $9f1;
-  XK_horizlinescan7                              = $9f2;
-  XK_horizlinescan9                              = $9f3;
-  XK_leftt                                       = $9f4;
-  XK_rightt                                      = $9f5;
-  XK_bott                                        = $9f6;
-  XK_topt                                        = $9f7;
-  XK_vertbar                                     = $9f8;
+  XK_blank          = $09df;
+  XK_soliddiamond   = $09e0;  { U+25C6 BLACK DIAMOND }
+  XK_checkerboard   = $09e1;  { U+2592 MEDIUM SHADE }
+  XK_ht             = $09e2;  { U+2409 SYMBOL FOR HORIZONTAL TABULATION }
+  XK_ff             = $09e3;  { U+240C SYMBOL FOR FORM FEED }
+  XK_cr             = $09e4;  { U+240D SYMBOL FOR CARRIAGE RETURN }
+  XK_lf             = $09e5;  { U+240A SYMBOL FOR LINE FEED }
+  XK_nl             = $09e8;  { U+2424 SYMBOL FOR NEWLINE }
+  XK_vt             = $09e9;  { U+240B SYMBOL FOR VERTICAL TABULATION }
+  XK_lowrightcorner = $09ea;  { U+2518 BOX DRAWINGS LIGHT UP AND LEFT }
+  XK_uprightcorner  = $09eb;  { U+2510 BOX DRAWINGS LIGHT DOWN AND LEFT }
+  XK_upleftcorner   = $09ec;  { U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT }
+  XK_lowleftcorner  = $09ed;  { U+2514 BOX DRAWINGS LIGHT UP AND RIGHT }
+  XK_crossinglines  = $09ee;  { U+253C BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL }
+  XK_horizlinescan1 = $09ef;  { U+23BA HORIZONTAL SCAN LINE-1 }
+  XK_horizlinescan3 = $09f0;  { U+23BB HORIZONTAL SCAN LINE-3 }
+  XK_horizlinescan5 = $09f1;  { U+2500 BOX DRAWINGS LIGHT HORIZONTAL }
+  XK_horizlinescan7 = $09f2;  { U+23BC HORIZONTAL SCAN LINE-7 }
+  XK_horizlinescan9 = $09f3;  { U+23BD HORIZONTAL SCAN LINE-9 }
+  XK_leftt          = $09f4;  { U+251C BOX DRAWINGS LIGHT VERTICAL AND RIGHT }
+  XK_rightt         = $09f5;  { U+2524 BOX DRAWINGS LIGHT VERTICAL AND LEFT }
+  XK_bott           = $09f6;  { U+2534 BOX DRAWINGS LIGHT UP AND HORIZONTAL }
+  XK_topt           = $09f7;  { U+252C BOX DRAWINGS LIGHT DOWN AND HORIZONTAL }
+  XK_vertbar        = $09f8;  { U+2502 BOX DRAWINGS LIGHT VERTICAL }
 {$ENDIF} { XK_SPECIAL }
 
 {*
- *  Publishing
- *  Byte 3 = a
+ * Publishing
+ * (these are probably from a long forgotten DEC Publishing
+ * font that once shipped with DECwrite)
+ * Byte 3 = $0a
  *}
 
 {$IFDEF XK_PUBLISHING}
-  XK_emspace                                     = $aa1;
-  XK_enspace                                     = $aa2;
-  XK_em3space                                    = $aa3;
-  XK_em4space                                    = $aa4;
-  XK_digitspace                                  = $aa5;
-  XK_punctspace                                  = $aa6;
-  XK_thinspace                                   = $aa7;
-  XK_hairspace                                   = $aa8;
-  XK_emdash                                      = $aa9;
-  XK_endash                                      = $aaa;
-  XK_signifblank                                 = $aac;
-  XK_ellipsis                                    = $aae;
-  XK_doubbaselinedot                             = $aaf;
-  XK_onethird                                    = $ab0;
-  XK_twothirds                                   = $ab1;
-  XK_onefifth                                    = $ab2;
-  XK_twofifths                                   = $ab3;
-  XK_threefifths                                 = $ab4;
-  XK_fourfifths                                  = $ab5;
-  XK_onesixth                                    = $ab6;
-  XK_fivesixths                                  = $ab7;
-  XK_careof                                      = $ab8;
-  XK_figdash                                     = $abb;
-  XK_leftanglebracket                            = $abc;
-  XK_decimalpoint                                = $abd;
-  XK_rightanglebracket                           = $abe;
-  XK_marker                                      = $abf;
-  XK_oneeighth                                   = $ac3;
-  XK_threeeighths                                = $ac4;
-  XK_fiveeighths                                 = $ac5;
-  XK_seveneighths                                = $ac6;
-  XK_trademark                                   = $ac9;
-  XK_signaturemark                               = $aca;
-  XK_trademarkincircle                           = $acb;
-  XK_leftopentriangle                            = $acc;
-  XK_rightopentriangle                           = $acd;
-  XK_emopencircle                                = $ace;
-  XK_emopenrectangle                             = $acf;
-  XK_leftsinglequotemark                         = $ad0;
-  XK_rightsinglequotemark                        = $ad1;
-  XK_leftdoublequotemark                         = $ad2;
-  XK_rightdoublequotemark                        = $ad3;
-  XK_prescription                                = $ad4;
-  XK_minutes                                     = $ad6;
-  XK_seconds                                     = $ad7;
-  XK_latincross                                  = $ad9;
-  XK_hexagram                                    = $ada;
-  XK_filledrectbullet                            = $adb;
-  XK_filledlefttribullet                         = $adc;
-  XK_filledrighttribullet                        = $add;
-  XK_emfilledcircle                              = $ade;
-  XK_emfilledrect                                = $adf;
-  XK_enopencircbullet                            = $ae0;
-  XK_enopensquarebullet                          = $ae1;
-  XK_openrectbullet                              = $ae2;
-  XK_opentribulletup                             = $ae3;
-  XK_opentribulletdown                           = $ae4;
-  XK_openstar                                    = $ae5;
-  XK_enfilledcircbullet                          = $ae6;
-  XK_enfilledsqbullet                            = $ae7;
-  XK_filledtribulletup                           = $ae8;
-  XK_filledtribulletdown                         = $ae9;
-  XK_leftpointer                                 = $aea;
-  XK_rightpointer                                = $aeb;
-  XK_club                                        = $aec;
-  XK_diamond                                     = $aed;
-  XK_heart                                       = $aee;
-  XK_maltesecross                                = $af0;
-  XK_dagger                                      = $af1;
-  XK_doubledagger                                = $af2;
-  XK_checkmark                                   = $af3;
-  XK_ballotcross                                 = $af4;
-  XK_musicalsharp                                = $af5;
-  XK_musicalflat                                 = $af6;
-  XK_malesymbol                                  = $af7;
-  XK_femalesymbol                                = $af8;
-  XK_telephone                                   = $af9;
-  XK_telephonerecorder                           = $afa;
-  XK_phonographcopyright                         = $afb;
-  XK_caret                                       = $afc;
-  XK_singlelowquotemark                          = $afd;
-  XK_doublelowquotemark                          = $afe;
-  XK_cursor                                      = $aff;
+  XK_emspace              = $0aa1;  { U+2003 EM SPACE }
+  XK_enspace              = $0aa2;  { U+2002 EN SPACE }
+  XK_em3space             = $0aa3;  { U+2004 THREE-PER-EM SPACE }
+  XK_em4space             = $0aa4;  { U+2005 FOUR-PER-EM SPACE }
+  XK_digitspace           = $0aa5;  { U+2007 FIGURE SPACE }
+  XK_punctspace           = $0aa6;  { U+2008 PUNCTUATION SPACE }
+  XK_thinspace            = $0aa7;  { U+2009 THIN SPACE }
+  XK_hairspace            = $0aa8;  { U+200A HAIR SPACE }
+  XK_emdash               = $0aa9;  { U+2014 EM DASH }
+  XK_endash               = $0aaa;  { U+2013 EN DASH }
+  XK_signifblank          = $0aac;  {(U+2423 OPEN BOX)}
+  XK_ellipsis             = $0aae;  { U+2026 HORIZONTAL ELLIPSIS }
+  XK_doubbaselinedot      = $0aaf;  { U+2025 TWO DOT LEADER }
+  XK_onethird             = $0ab0;  { U+2153 VULGAR FRACTION ONE THIRD }
+  XK_twothirds            = $0ab1;  { U+2154 VULGAR FRACTION TWO THIRDS }
+  XK_onefifth             = $0ab2;  { U+2155 VULGAR FRACTION ONE FIFTH }
+  XK_twofifths            = $0ab3;  { U+2156 VULGAR FRACTION TWO FIFTHS }
+  XK_threefifths          = $0ab4;  { U+2157 VULGAR FRACTION THREE FIFTHS }
+  XK_fourfifths           = $0ab5;  { U+2158 VULGAR FRACTION FOUR FIFTHS }
+  XK_onesixth             = $0ab6;  { U+2159 VULGAR FRACTION ONE SIXTH }
+  XK_fivesixths           = $0ab7;  { U+215A VULGAR FRACTION FIVE SIXTHS }
+  XK_careof               = $0ab8;  { U+2105 CARE OF }
+  XK_figdash              = $0abb;  { U+2012 FIGURE DASH }
+  XK_leftanglebracket     = $0abc;  {(U+27E8 MATHEMATICAL LEFT ANGLE BRACKET)}
+  XK_decimalpoint         = $0abd;  {(U+002E FULL STOP)}
+  XK_rightanglebracket    = $0abe;  {(U+27E9 MATHEMATICAL RIGHT ANGLE BRACKET)}
+  XK_marker               = $0abf;
+  XK_oneeighth            = $0ac3;  { U+215B VULGAR FRACTION ONE EIGHTH }
+  XK_threeeighths         = $0ac4;  { U+215C VULGAR FRACTION THREE EIGHTHS }
+  XK_fiveeighths          = $0ac5;  { U+215D VULGAR FRACTION FIVE EIGHTHS }
+  XK_seveneighths         = $0ac6;  { U+215E VULGAR FRACTION SEVEN EIGHTHS }
+  XK_trademark            = $0ac9;  { U+2122 TRADE MARK SIGN }
+  XK_signaturemark        = $0aca;  {(U+2613 SALTIRE)}
+  XK_trademarkincircle    = $0acb;
+  XK_leftopentriangle     = $0acc;  {(U+25C1 WHITE LEFT-POINTING TRIANGLE)}
+  XK_rightopentriangle    = $0acd;  {(U+25B7 WHITE RIGHT-POINTING TRIANGLE)}
+  XK_emopencircle         = $0ace;  {(U+25CB WHITE CIRCLE)}
+  XK_emopenrectangle      = $0acf;  {(U+25AF WHITE VERTICAL RECTANGLE)}
+  XK_leftsinglequotemark  = $0ad0;  { U+2018 LEFT SINGLE QUOTATION MARK }
+  XK_rightsinglequotemark = $0ad1;  { U+2019 RIGHT SINGLE QUOTATION MARK }
+  XK_leftdoublequotemark  = $0ad2;  { U+201C LEFT DOUBLE QUOTATION MARK }
+  XK_rightdoublequotemark = $0ad3;  { U+201D RIGHT DOUBLE QUOTATION MARK }
+  XK_prescription         = $0ad4;  { U+211E PRESCRIPTION TAKE }
+  XK_permille             = $0ad5;  { U+2030 PER MILLE SIGN }
+  XK_minutes              = $0ad6;  { U+2032 PRIME }
+  XK_seconds              = $0ad7;  { U+2033 DOUBLE PRIME }
+  XK_latincross           = $0ad9;  { U+271D LATIN CROSS }
+  XK_hexagram             = $0ada;
+  XK_filledrectbullet     = $0adb;  {(U+25AC BLACK RECTANGLE)}
+  XK_filledlefttribullet  = $0adc;  {(U+25C0 BLACK LEFT-POINTING TRIANGLE)}
+  XK_filledrighttribullet = $0add;  {(U+25B6 BLACK RIGHT-POINTING TRIANGLE)}
+  XK_emfilledcircle       = $0ade;  {(U+25CF BLACK CIRCLE)}
+  XK_emfilledrect         = $0adf;  {(U+25AE BLACK VERTICAL RECTANGLE)}
+  XK_enopencircbullet     = $0ae0;  {(U+25E6 WHITE BULLET)}
+  XK_enopensquarebullet   = $0ae1;  {(U+25AB WHITE SMALL SQUARE)}
+  XK_openrectbullet       = $0ae2;  {(U+25AD WHITE RECTANGLE)}
+  XK_opentribulletup      = $0ae3;  {(U+25B3 WHITE UP-POINTING TRIANGLE)}
+  XK_opentribulletdown    = $0ae4;  {(U+25BD WHITE DOWN-POINTING TRIANGLE)}
+  XK_openstar             = $0ae5;  {(U+2606 WHITE STAR)}
+  XK_enfilledcircbullet   = $0ae6;  {(U+2022 BULLET)}
+  XK_enfilledsqbullet     = $0ae7;  {(U+25AA BLACK SMALL SQUARE)}
+  XK_filledtribulletup    = $0ae8;  {(U+25B2 BLACK UP-POINTING TRIANGLE)}
+  XK_filledtribulletdown  = $0ae9;  {(U+25BC BLACK DOWN-POINTING TRIANGLE)}
+  XK_leftpointer          = $0aea;  {(U+261C WHITE LEFT POINTING INDEX)}
+  XK_rightpointer         = $0aeb;  {(U+261E WHITE RIGHT POINTING INDEX)}
+  XK_club                 = $0aec;  { U+2663 BLACK CLUB SUIT }
+  XK_diamond              = $0aed;  { U+2666 BLACK DIAMOND SUIT }
+  XK_heart                = $0aee;  { U+2665 BLACK HEART SUIT }
+  XK_maltesecross         = $0af0;  { U+2720 MALTESE CROSS }
+  XK_dagger               = $0af1;  { U+2020 DAGGER }
+  XK_doubledagger         = $0af2;  { U+2021 DOUBLE DAGGER }
+  XK_checkmark            = $0af3;  { U+2713 CHECK MARK }
+  XK_ballotcross          = $0af4;  { U+2717 BALLOT X }
+  XK_musicalsharp         = $0af5;  { U+266F MUSIC SHARP SIGN }
+  XK_musicalflat          = $0af6;  { U+266D MUSIC FLAT SIGN }
+  XK_malesymbol           = $0af7;  { U+2642 MALE SIGN }
+  XK_femalesymbol         = $0af8;  { U+2640 FEMALE SIGN }
+  XK_telephone            = $0af9;  { U+260E BLACK TELEPHONE }
+  XK_telephonerecorder    = $0afa;  { U+2315 TELEPHONE RECORDER }
+  XK_phonographcopyright  = $0afb;  { U+2117 SOUND RECORDING COPYRIGHT }
+  XK_caret                = $0afc;  { U+2038 CARET }
+  XK_singlelowquotemark   = $0afd;  { U+201A SINGLE LOW-9 QUOTATION MARK }
+  XK_doublelowquotemark   = $0afe;  { U+201E DOUBLE LOW-9 QUOTATION MARK }
+  XK_cursor               = $0aff;
 {$ENDIF} { XK_PUBLISHING }
 
 {*
- *  APL
- *  Byte 3 = b
+ * APL
+ * Byte 3 = $0b
  *}
 
 {$IFDEF XK_APL}
-  XK_leftcaret                                   = $ba3;
-  XK_rightcaret                                  = $ba6;
-  XK_downcaret                                   = $ba8;
-  XK_upcaret                                     = $ba9;
-  XK_overbar                                     = $bc0;
-  XK_downtack                                    = $bc2;
-  XK_upshoe                                      = $bc3;
-  XK_downstile                                   = $bc4;
-  XK_underbar                                    = $bc6;
-  XK_jot                                         = $bca;
-  XK_quad                                        = $bcc;
-  XK_uptack                                      = $bce;
-  XK_circle                                      = $bcf;
-  XK_upstile                                     = $bd3;
-  XK_downshoe                                    = $bd6;
-  XK_rightshoe                                   = $bd8;
-  XK_leftshoe                                    = $bda;
-  XK_lefttack                                    = $bdc;
-  XK_righttack                                   = $bfc;
+  XK_leftcaret  = $0ba3;  {(U+003C LESS-THAN SIGN)}
+  XK_rightcaret = $0ba6;  {(U+003E GREATER-THAN SIGN)}
+  XK_downcaret  = $0ba8;  {(U+2228 LOGICAL OR)}
+  XK_upcaret    = $0ba9;  {(U+2227 LOGICAL AND)}
+  XK_overbar    = $0bc0;  {(U+00AF MACRON)}
+  XK_downtack   = $0bc2;  { U+22A4 DOWN TACK }
+  XK_upshoe     = $0bc3;  {(U+2229 INTERSECTION)}
+  XK_downstile  = $0bc4;  { U+230A LEFT FLOOR }
+  XK_underbar   = $0bc6;  {(U+005F LOW LINE)}
+  XK_jot        = $0bca;  { U+2218 RING OPERATOR }
+  XK_quad       = $0bcc;  { U+2395 APL FUNCTIONAL SYMBOL QUAD }
+  XK_uptack     = $0bce;  { U+22A5 UP TACK }
+  XK_circle     = $0bcf;  { U+25CB WHITE CIRCLE }
+  XK_upstile    = $0bd3;  { U+2308 LEFT CEILING }
+  XK_downshoe   = $0bd6;  {(U+222A UNION)}
+  XK_rightshoe  = $0bd8;  {(U+2283 SUPERSET OF)}
+  XK_leftshoe   = $0bda;  {(U+2282 SUBSET OF)}
+  XK_lefttack   = $0bdc;  { U+22A3 LEFT TACK }
+  XK_righttack  = $0bfc;  { U+22A2 RIGHT TACK }
 {$ENDIF} { XK_APL }
 
 {*
  * Hebrew
- * Byte 3 = c
+ * Byte 3 = $0c
  *}
 
 {$IFDEF XK_HEBREW}
-  XK_hebrew_doublelowline                        = $cdf;
-  XK_hebrew_aleph                                = $ce0;
-  XK_hebrew_bet                                  = $ce1;
-  XK_hebrew_beth                                 = $ce1;  { deprecated }
-  XK_hebrew_gimel                                = $ce2;
-  XK_hebrew_gimmel                               = $ce2;  { deprecated }
-  XK_hebrew_dalet                                = $ce3;
-  XK_hebrew_daleth                               = $ce3;  { deprecated }
-  XK_hebrew_he                                   = $ce4;
-  XK_hebrew_waw                                  = $ce5;
-  XK_hebrew_zain                                 = $ce6;
-  XK_hebrew_zayin                                = $ce6;  { deprecated }
-  XK_hebrew_chet                                 = $ce7;
-  XK_hebrew_het                                  = $ce7;  { deprecated }
-  XK_hebrew_tet                                  = $ce8;
-  XK_hebrew_teth                                 = $ce8;  { deprecated }
-  XK_hebrew_yod                                  = $ce9;
-  XK_hebrew_finalkaph                            = $cea;
-  XK_hebrew_kaph                                 = $ceb;
-  XK_hebrew_lamed                                = $cec;
-  XK_hebrew_finalmem                             = $ced;
-  XK_hebrew_mem                                  = $cee;
-  XK_hebrew_finalnun                             = $cef;
-  XK_hebrew_nun                                  = $cf0;
-  XK_hebrew_samech                               = $cf1;
-  XK_hebrew_samekh                               = $cf1;  { deprecated }
-  XK_hebrew_ayin                                 = $cf2;
-  XK_hebrew_finalpe                              = $cf3;
-  XK_hebrew_pe                                   = $cf4;
-  XK_hebrew_finalzade                            = $cf5;
-  XK_hebrew_finalzadi                            = $cf5;  { deprecated }
-  XK_hebrew_zade                                 = $cf6;
-  XK_hebrew_zadi                                 = $cf6;  { deprecated }
-  XK_hebrew_qoph                                 = $cf7;
-  XK_hebrew_kuf                                  = $cf7;  { deprecated }
-  XK_hebrew_resh                                 = $cf8;
-  XK_hebrew_shin                                 = $cf9;
-  XK_hebrew_taw                                  = $cfa;
-  XK_hebrew_taf                                  = $cfa;  { deprecated }
-  XK_Hebrew_switch        = $FF7E;  { Alias for mode_switch }
+  XK_hebrew_doublelowline = $0cdf;  { U+2017 DOUBLE LOW LINE }
+  XK_hebrew_aleph         = $0ce0;  { U+05D0 HEBREW LETTER ALEF }
+  XK_hebrew_bet           = $0ce1;  { U+05D1 HEBREW LETTER BET }
+  XK_hebrew_beth          = $0ce1;  { deprecated }
+  XK_hebrew_gimel         = $0ce2;  { U+05D2 HEBREW LETTER GIMEL }
+  XK_hebrew_gimmel        = $0ce2;  { deprecated }
+  XK_hebrew_dalet         = $0ce3;  { U+05D3 HEBREW LETTER DALET }
+  XK_hebrew_daleth        = $0ce3;  { deprecated }
+  XK_hebrew_he            = $0ce4;  { U+05D4 HEBREW LETTER HE }
+  XK_hebrew_waw           = $0ce5;  { U+05D5 HEBREW LETTER VAV }
+  XK_hebrew_zain          = $0ce6;  { U+05D6 HEBREW LETTER ZAYIN }
+  XK_hebrew_zayin         = $0ce6;  { deprecated }
+  XK_hebrew_chet          = $0ce7;  { U+05D7 HEBREW LETTER HET }
+  XK_hebrew_het           = $0ce7;  { deprecated }
+  XK_hebrew_tet           = $0ce8;  { U+05D8 HEBREW LETTER TET }
+  XK_hebrew_teth          = $0ce8;  { deprecated }
+  XK_hebrew_yod           = $0ce9;  { U+05D9 HEBREW LETTER YOD }
+  XK_hebrew_finalkaph     = $0cea;  { U+05DA HEBREW LETTER FINAL KAF }
+  XK_hebrew_kaph          = $0ceb;  { U+05DB HEBREW LETTER KAF }
+  XK_hebrew_lamed         = $0cec;  { U+05DC HEBREW LETTER LAMED }
+  XK_hebrew_finalmem      = $0ced;  { U+05DD HEBREW LETTER FINAL MEM }
+  XK_hebrew_mem           = $0cee;  { U+05DE HEBREW LETTER MEM }
+  XK_hebrew_finalnun      = $0cef;  { U+05DF HEBREW LETTER FINAL NUN }
+  XK_hebrew_nun           = $0cf0;  { U+05E0 HEBREW LETTER NUN }
+  XK_hebrew_samech        = $0cf1;  { U+05E1 HEBREW LETTER SAMEKH }
+  XK_hebrew_samekh        = $0cf1;  { deprecated }
+  XK_hebrew_ayin          = $0cf2;  { U+05E2 HEBREW LETTER AYIN }
+  XK_hebrew_finalpe       = $0cf3;  { U+05E3 HEBREW LETTER FINAL PE }
+  XK_hebrew_pe            = $0cf4;  { U+05E4 HEBREW LETTER PE }
+  XK_hebrew_finalzade     = $0cf5;  { U+05E5 HEBREW LETTER FINAL TSADI }
+  XK_hebrew_finalzadi     = $0cf5;  { deprecated }
+  XK_hebrew_zade          = $0cf6;  { U+05E6 HEBREW LETTER TSADI }
+  XK_hebrew_zadi          = $0cf6;  { deprecated }
+  XK_hebrew_qoph          = $0cf7;  { U+05E7 HEBREW LETTER QOF }
+  XK_hebrew_kuf           = $0cf7;  { deprecated }
+  XK_hebrew_resh          = $0cf8;  { U+05E8 HEBREW LETTER RESH }
+  XK_hebrew_shin          = $0cf9;  { U+05E9 HEBREW LETTER SHIN }
+  XK_hebrew_taw           = $0cfa;  { U+05EA HEBREW LETTER TAV }
+  XK_hebrew_taf           = $0cfa;  { deprecated }
+  XK_Hebrew_switch        = $ff7e;  { Alias for mode_switch }
 {$ENDIF} { XK_HEBREW }
 
 {*
  * Thai
- * Byte 3 = d
+ * Byte 3 = $0d
  *}
 
 {$IFDEF XK_THAI}
-  XK_Thai_kokai                                 = $da1;
-  XK_Thai_khokhai                                       = $da2;
-  XK_Thai_khokhuat                              = $da3;
-  XK_Thai_khokhwai                              = $da4;
-  XK_Thai_khokhon                                       = $da5;
-  XK_Thai_khorakhang                            = $da6;
-  XK_Thai_ngongu                                        = $da7;
-  XK_Thai_chochan                                       = $da8;
-  XK_Thai_choching                              = $da9;
-  XK_Thai_chochang                              = $daa;
-  XK_Thai_soso                                  = $dab;
-  XK_Thai_chochoe                                       = $dac;
-  XK_Thai_yoying                                        = $dad;
-  XK_Thai_dochada                                       = $dae;
-  XK_Thai_topatak                                       = $daf;
-  XK_Thai_thothan                                       = $db0;
-  XK_Thai_thonangmontho                         = $db1;
-  XK_Thai_thophuthao                            = $db2;
-  XK_Thai_nonen                                 = $db3;
-  XK_Thai_dodek                                 = $db4;
-  XK_Thai_totao                                 = $db5;
-  XK_Thai_thothung                              = $db6;
-  XK_Thai_thothahan                             = $db7;
-  XK_Thai_thothong                              = $db8;
-  XK_Thai_nonu                                  = $db9;
-  XK_Thai_bobaimai                              = $dba;
-  XK_Thai_popla                                 = $dbb;
-  XK_Thai_phophung                              = $dbc;
-  XK_Thai_fofa                                  = $dbd;
-  XK_Thai_phophan                                       = $dbe;
-  XK_Thai_fofan                                 = $dbf;
-  XK_Thai_phosamphao                            = $dc0;
-  XK_Thai_moma                                  = $dc1;
-  XK_Thai_yoyak                                 = $dc2;
-  XK_Thai_rorua                                 = $dc3;
-  XK_Thai_ru                                    = $dc4;
-  XK_Thai_loling                                        = $dc5;
-  XK_Thai_lu                                    = $dc6;
-  XK_Thai_wowaen                                        = $dc7;
-  XK_Thai_sosala                                        = $dc8;
-  XK_Thai_sorusi                                        = $dc9;
-  XK_Thai_sosua                                 = $dca;
-  XK_Thai_hohip                                 = $dcb;
-  XK_Thai_lochula                                       = $dcc;
-  XK_Thai_oang                                  = $dcd;
-  XK_Thai_honokhuk                              = $dce;
-  XK_Thai_paiyannoi                             = $dcf;
-  XK_Thai_saraa                                 = $dd0;
-  XK_Thai_maihanakat                            = $dd1;
-  XK_Thai_saraaa                                        = $dd2;
-  XK_Thai_saraam                                        = $dd3;
-  XK_Thai_sarai                                 = $dd4;
-  XK_Thai_saraii                                        = $dd5;
-  XK_Thai_saraue                                        = $dd6;
-  XK_Thai_sarauee                                       = $dd7;
-  XK_Thai_sarau                                 = $dd8;
-  XK_Thai_sarauu                                        = $dd9;
-  XK_Thai_phinthu                                       = $dda;
-  XK_Thai_maihanakat_maitho                     = $dde;
-  XK_Thai_baht                                  = $ddf;
-  XK_Thai_sarae                                 = $de0;
-  XK_Thai_saraae                                        = $de1;
-  XK_Thai_sarao                                 = $de2;
-  XK_Thai_saraaimaimuan                         = $de3;
-  XK_Thai_saraaimaimalai                                = $de4;
-  XK_Thai_lakkhangyao                           = $de5;
-  XK_Thai_maiyamok                              = $de6;
-  XK_Thai_maitaikhu                             = $de7;
-  XK_Thai_maiek                                 = $de8;
-  XK_Thai_maitho                                        = $de9;
-  XK_Thai_maitri                                        = $dea;
-  XK_Thai_maichattawa                           = $deb;
-  XK_Thai_thanthakhat                           = $dec;
-  XK_Thai_nikhahit                              = $ded;
-  XK_Thai_leksun                                        = $df0;
-  XK_Thai_leknung                                       = $df1;
-  XK_Thai_leksong                                       = $df2;
-  XK_Thai_leksam                                        = $df3;
-  XK_Thai_leksi                                 = $df4;
-  XK_Thai_lekha                                 = $df5;
-  XK_Thai_lekhok                                        = $df6;
-  XK_Thai_lekchet                                       = $df7;
-  XK_Thai_lekpaet                                       = $df8;
-  XK_Thai_lekkao                                        = $df9;
+  XK_Thai_kokai             = $0da1;  { U+0E01 THAI CHARACTER KO KAI }
+  XK_Thai_khokhai           = $0da2;  { U+0E02 THAI CHARACTER KHO KHAI }
+  XK_Thai_khokhuat          = $0da3;  { U+0E03 THAI CHARACTER KHO KHUAT }
+  XK_Thai_khokhwai          = $0da4;  { U+0E04 THAI CHARACTER KHO KHWAI }
+  XK_Thai_khokhon           = $0da5;  { U+0E05 THAI CHARACTER KHO KHON }
+  XK_Thai_khorakhang        = $0da6;  { U+0E06 THAI CHARACTER KHO RAKHANG }
+  XK_Thai_ngongu            = $0da7;  { U+0E07 THAI CHARACTER NGO NGU }
+  XK_Thai_chochan           = $0da8;  { U+0E08 THAI CHARACTER CHO CHAN }
+  XK_Thai_choching          = $0da9;  { U+0E09 THAI CHARACTER CHO CHING }
+  XK_Thai_chochang          = $0daa;  { U+0E0A THAI CHARACTER CHO CHANG }
+  XK_Thai_soso              = $0dab;  { U+0E0B THAI CHARACTER SO SO }
+  XK_Thai_chochoe           = $0dac;  { U+0E0C THAI CHARACTER CHO CHOE }
+  XK_Thai_yoying            = $0dad;  { U+0E0D THAI CHARACTER YO YING }
+  XK_Thai_dochada           = $0dae;  { U+0E0E THAI CHARACTER DO CHADA }
+  XK_Thai_topatak           = $0daf;  { U+0E0F THAI CHARACTER TO PATAK }
+  XK_Thai_thothan           = $0db0;  { U+0E10 THAI CHARACTER THO THAN }
+  XK_Thai_thonangmontho     = $0db1;  { U+0E11 THAI CHARACTER THO NANGMONTHO }
+  XK_Thai_thophuthao        = $0db2;  { U+0E12 THAI CHARACTER THO PHUTHAO }
+  XK_Thai_nonen             = $0db3;  { U+0E13 THAI CHARACTER NO NEN }
+  XK_Thai_dodek             = $0db4;  { U+0E14 THAI CHARACTER DO DEK }
+  XK_Thai_totao             = $0db5;  { U+0E15 THAI CHARACTER TO TAO }
+  XK_Thai_thothung          = $0db6;  { U+0E16 THAI CHARACTER THO THUNG }
+  XK_Thai_thothahan         = $0db7;  { U+0E17 THAI CHARACTER THO THAHAN }
+  XK_Thai_thothong          = $0db8;  { U+0E18 THAI CHARACTER THO THONG }
+  XK_Thai_nonu              = $0db9;  { U+0E19 THAI CHARACTER NO NU }
+  XK_Thai_bobaimai          = $0dba;  { U+0E1A THAI CHARACTER BO BAIMAI }
+  XK_Thai_popla             = $0dbb;  { U+0E1B THAI CHARACTER PO PLA }
+  XK_Thai_phophung          = $0dbc;  { U+0E1C THAI CHARACTER PHO PHUNG }
+  XK_Thai_fofa              = $0dbd;  { U+0E1D THAI CHARACTER FO FA }
+  XK_Thai_phophan           = $0dbe;  { U+0E1E THAI CHARACTER PHO PHAN }
+  XK_Thai_fofan             = $0dbf;  { U+0E1F THAI CHARACTER FO FAN }
+  XK_Thai_phosamphao        = $0dc0;  { U+0E20 THAI CHARACTER PHO SAMPHAO }
+  XK_Thai_moma              = $0dc1;  { U+0E21 THAI CHARACTER MO MA }
+  XK_Thai_yoyak             = $0dc2;  { U+0E22 THAI CHARACTER YO YAK }
+  XK_Thai_rorua             = $0dc3;  { U+0E23 THAI CHARACTER RO RUA }
+  XK_Thai_ru                = $0dc4;  { U+0E24 THAI CHARACTER RU }
+  XK_Thai_loling            = $0dc5;  { U+0E25 THAI CHARACTER LO LING }
+  XK_Thai_lu                = $0dc6;  { U+0E26 THAI CHARACTER LU }
+  XK_Thai_wowaen            = $0dc7;  { U+0E27 THAI CHARACTER WO WAEN }
+  XK_Thai_sosala            = $0dc8;  { U+0E28 THAI CHARACTER SO SALA }
+  XK_Thai_sorusi            = $0dc9;  { U+0E29 THAI CHARACTER SO RUSI }
+  XK_Thai_sosua             = $0dca;  { U+0E2A THAI CHARACTER SO SUA }
+  XK_Thai_hohip             = $0dcb;  { U+0E2B THAI CHARACTER HO HIP }
+  XK_Thai_lochula           = $0dcc;  { U+0E2C THAI CHARACTER LO CHULA }
+  XK_Thai_oang              = $0dcd;  { U+0E2D THAI CHARACTER O ANG }
+  XK_Thai_honokhuk          = $0dce;  { U+0E2E THAI CHARACTER HO NOKHUK }
+  XK_Thai_paiyannoi         = $0dcf;  { U+0E2F THAI CHARACTER PAIYANNOI }
+  XK_Thai_saraa             = $0dd0;  { U+0E30 THAI CHARACTER SARA A }
+  XK_Thai_maihanakat        = $0dd1;  { U+0E31 THAI CHARACTER MAI HAN-AKAT }
+  XK_Thai_saraaa            = $0dd2;  { U+0E32 THAI CHARACTER SARA AA }
+  XK_Thai_saraam            = $0dd3;  { U+0E33 THAI CHARACTER SARA AM }
+  XK_Thai_sarai             = $0dd4;  { U+0E34 THAI CHARACTER SARA I }
+  XK_Thai_saraii            = $0dd5;  { U+0E35 THAI CHARACTER SARA II }
+  XK_Thai_saraue            = $0dd6;  { U+0E36 THAI CHARACTER SARA UE }
+  XK_Thai_sarauee           = $0dd7;  { U+0E37 THAI CHARACTER SARA UEE }
+  XK_Thai_sarau             = $0dd8;  { U+0E38 THAI CHARACTER SARA U }
+  XK_Thai_sarauu            = $0dd9;  { U+0E39 THAI CHARACTER SARA UU }
+  XK_Thai_phinthu           = $0dda;  { U+0E3A THAI CHARACTER PHINTHU }
+  XK_Thai_maihanakat_maitho = $0dde;
+  XK_Thai_baht              = $0ddf;  { U+0E3F THAI CURRENCY SYMBOL BAHT }
+  XK_Thai_sarae             = $0de0;  { U+0E40 THAI CHARACTER SARA E }
+  XK_Thai_saraae            = $0de1;  { U+0E41 THAI CHARACTER SARA AE }
+  XK_Thai_sarao             = $0de2;  { U+0E42 THAI CHARACTER SARA O }
+  XK_Thai_saraaimaimuan     = $0de3;  { U+0E43 THAI CHARACTER SARA AI MAIMUAN }
+  XK_Thai_saraaimaimalai    = $0de4;  { U+0E44 THAI CHARACTER SARA AI MAIMALAI }
+  XK_Thai_lakkhangyao       = $0de5;  { U+0E45 THAI CHARACTER LAKKHANGYAO }
+  XK_Thai_maiyamok          = $0de6;  { U+0E46 THAI CHARACTER MAIYAMOK }
+  XK_Thai_maitaikhu         = $0de7;  { U+0E47 THAI CHARACTER MAITAIKHU }
+  XK_Thai_maiek             = $0de8;  { U+0E48 THAI CHARACTER MAI EK }
+  XK_Thai_maitho            = $0de9;  { U+0E49 THAI CHARACTER MAI THO }
+  XK_Thai_maitri            = $0dea;  { U+0E4A THAI CHARACTER MAI TRI }
+  XK_Thai_maichattawa       = $0deb;  { U+0E4B THAI CHARACTER MAI CHATTAWA }
+  XK_Thai_thanthakhat       = $0dec;  { U+0E4C THAI CHARACTER THANTHAKHAT }
+  XK_Thai_nikhahit          = $0ded;  { U+0E4D THAI CHARACTER NIKHAHIT }
+  XK_Thai_leksun            = $0df0;  { U+0E50 THAI DIGIT ZERO }
+  XK_Thai_leknung           = $0df1;  { U+0E51 THAI DIGIT ONE }
+  XK_Thai_leksong           = $0df2;  { U+0E52 THAI DIGIT TWO }
+  XK_Thai_leksam            = $0df3;  { U+0E53 THAI DIGIT THREE }
+  XK_Thai_leksi             = $0df4;  { U+0E54 THAI DIGIT FOUR }
+  XK_Thai_lekha             = $0df5;  { U+0E55 THAI DIGIT FIVE }
+  XK_Thai_lekhok            = $0df6;  { U+0E56 THAI DIGIT SIX }
+  XK_Thai_lekchet           = $0df7;  { U+0E57 THAI DIGIT SEVEN }
+  XK_Thai_lekpaet           = $0df8;  { U+0E58 THAI DIGIT EIGHT }
+  XK_Thai_lekkao            = $0df9;  { U+0E59 THAI DIGIT NINE }
 {$ENDIF} { XK_THAI }
 
 {*
  *   Korean
- *   Byte 3 = e
+ *   Byte 3 = $0e
  *}
 
 {$IFDEF XK_KOREAN}
 
-  XK_Hangul             = $ff31;    { Hangul start/stop(toggle) }
+  XK_Hangul                     = $ff31;    { Hangul start/stop(toggle) }
   XK_Hangul_Start               = $ff32;    { Hangul start }
-  XK_Hangul_End         = $ff33;    { Hangul end, English start }
+  XK_Hangul_End                 = $ff33;    { Hangul end, English start }
   XK_Hangul_Hanja               = $ff34;    { Start Hangul->Hanja Conversion }
   XK_Hangul_Jamo                = $ff35;    { Hangul Jamo mode }
-  XK_Hangul_Romaja      = $ff36;    { Hangul Romaja mode }
-  XK_Hangul_Codeinput   = $ff37;    { Hangul code input mode }
-  XK_Hangul_Jeonja      = $ff38;    { Jeonja mode }
+  XK_Hangul_Romaja              = $ff36;    { Hangul Romaja mode }
+  XK_Hangul_Codeinput           = $ff37;    { Hangul code input mode }
+  XK_Hangul_Jeonja              = $ff38;    { Jeonja mode }
   XK_Hangul_Banja               = $ff39;    { Banja mode }
-  XK_Hangul_PreHanja    = $ff3a;    { Pre Hanja conversion }
-  XK_Hangul_PostHanja   = $ff3b;    { Post Hanja conversion }
+  XK_Hangul_PreHanja            = $ff3a;    { Pre Hanja conversion }
+  XK_Hangul_PostHanja           = $ff3b;    { Post Hanja conversion }
   XK_Hangul_SingleCandidate     = $ff3c;    { Single candidate }
   XK_Hangul_MultipleCandidate   = $ff3d;    { Multiple candidate }
   XK_Hangul_PreviousCandidate   = $ff3e;    { Previous candidate }
-  XK_Hangul_Special     = $ff3f;    { Special symbols }
-  XK_Hangul_switch      = $FF7E;    { Alias for mode_switch }
+  XK_Hangul_Special             = $ff3f;    { Special symbols }
+  XK_Hangul_switch              = $ff7e;    { Alias for mode_switch }
 
 { Hangul Consonant Characters }
-  XK_Hangul_Kiyeog                              = $ea1;
-  XK_Hangul_SsangKiyeog                         = $ea2;
-  XK_Hangul_KiyeogSios                          = $ea3;
-  XK_Hangul_Nieun                                       = $ea4;
-  XK_Hangul_NieunJieuj                          = $ea5;
-  XK_Hangul_NieunHieuh                          = $ea6;
-  XK_Hangul_Dikeud                              = $ea7;
-  XK_Hangul_SsangDikeud                         = $ea8;
-  XK_Hangul_Rieul                                       = $ea9;
-  XK_Hangul_RieulKiyeog                         = $eaa;
-  XK_Hangul_RieulMieum                          = $eab;
-  XK_Hangul_RieulPieub                          = $eac;
-  XK_Hangul_RieulSios                           = $ead;
-  XK_Hangul_RieulTieut                          = $eae;
-  XK_Hangul_RieulPhieuf                         = $eaf;
-  XK_Hangul_RieulHieuh                          = $eb0;
-  XK_Hangul_Mieum                                       = $eb1;
-  XK_Hangul_Pieub                                       = $eb2;
-  XK_Hangul_SsangPieub                          = $eb3;
-  XK_Hangul_PieubSios                           = $eb4;
-  XK_Hangul_Sios                                        = $eb5;
-  XK_Hangul_SsangSios                           = $eb6;
-  XK_Hangul_Ieung                                       = $eb7;
-  XK_Hangul_Jieuj                                       = $eb8;
-  XK_Hangul_SsangJieuj                          = $eb9;
-  XK_Hangul_Cieuc                                       = $eba;
-  XK_Hangul_Khieuq                              = $ebb;
-  XK_Hangul_Tieut                                       = $ebc;
-  XK_Hangul_Phieuf                              = $ebd;
-  XK_Hangul_Hieuh                                       = $ebe;
+  XK_Hangul_Kiyeog              = $0ea1;
+  XK_Hangul_SsangKiyeog         = $0ea2;
+  XK_Hangul_KiyeogSios          = $0ea3;
+  XK_Hangul_Nieun               = $0ea4;
+  XK_Hangul_NieunJieuj          = $0ea5;
+  XK_Hangul_NieunHieuh          = $0ea6;
+  XK_Hangul_Dikeud              = $0ea7;
+  XK_Hangul_SsangDikeud         = $0ea8;
+  XK_Hangul_Rieul               = $0ea9;
+  XK_Hangul_RieulKiyeog         = $0eaa;
+  XK_Hangul_RieulMieum          = $0eab;
+  XK_Hangul_RieulPieub          = $0eac;
+  XK_Hangul_RieulSios           = $0ead;
+  XK_Hangul_RieulTieut          = $0eae;
+  XK_Hangul_RieulPhieuf         = $0eaf;
+  XK_Hangul_RieulHieuh          = $0eb0;
+  XK_Hangul_Mieum               = $0eb1;
+  XK_Hangul_Pieub               = $0eb2;
+  XK_Hangul_SsangPieub          = $0eb3;
+  XK_Hangul_PieubSios           = $0eb4;
+  XK_Hangul_Sios                = $0eb5;
+  XK_Hangul_SsangSios           = $0eb6;
+  XK_Hangul_Ieung               = $0eb7;
+  XK_Hangul_Jieuj               = $0eb8;
+  XK_Hangul_SsangJieuj          = $0eb9;
+  XK_Hangul_Cieuc               = $0eba;
+  XK_Hangul_Khieuq              = $0ebb;
+  XK_Hangul_Tieut               = $0ebc;
+  XK_Hangul_Phieuf              = $0ebd;
+  XK_Hangul_Hieuh               = $0ebe;
 
 { Hangul Vowel Characters }
-  XK_Hangul_A                                   = $ebf;
-  XK_Hangul_AE                                  = $ec0;
-  XK_Hangul_YA                                  = $ec1;
-  XK_Hangul_YAE                                 = $ec2;
-  XK_Hangul_EO                                  = $ec3;
-  XK_Hangul_E                                   = $ec4;
-  XK_Hangul_YEO                                 = $ec5;
-  XK_Hangul_YE                                  = $ec6;
-  XK_Hangul_O                                   = $ec7;
-  XK_Hangul_WA                                  = $ec8;
-  XK_Hangul_WAE                                 = $ec9;
-  XK_Hangul_OE                                  = $eca;
-  XK_Hangul_YO                                  = $ecb;
-  XK_Hangul_U                                   = $ecc;
-  XK_Hangul_WEO                                 = $ecd;
-  XK_Hangul_WE                                  = $ece;
-  XK_Hangul_WI                                  = $ecf;
-  XK_Hangul_YU                                  = $ed0;
-  XK_Hangul_EU                                  = $ed1;
-  XK_Hangul_YI                                  = $ed2;
-  XK_Hangul_I                                   = $ed3;
+  XK_Hangul_A                   = $0ebf;
+  XK_Hangul_AE                  = $0ec0;
+  XK_Hangul_YA                  = $0ec1;
+  XK_Hangul_YAE                 = $0ec2;
+  XK_Hangul_EO                  = $0ec3;
+  XK_Hangul_E                   = $0ec4;
+  XK_Hangul_YEO                 = $0ec5;
+  XK_Hangul_YE                  = $0ec6;
+  XK_Hangul_O                   = $0ec7;
+  XK_Hangul_WA                  = $0ec8;
+  XK_Hangul_WAE                 = $0ec9;
+  XK_Hangul_OE                  = $0eca;
+  XK_Hangul_YO                  = $0ecb;
+  XK_Hangul_U                   = $0ecc;
+  XK_Hangul_WEO                 = $0ecd;
+  XK_Hangul_WE                  = $0ece;
+  XK_Hangul_WI                  = $0ecf;
+  XK_Hangul_YU                  = $0ed0;
+  XK_Hangul_EU                  = $0ed1;
+  XK_Hangul_YI                  = $0ed2;
+  XK_Hangul_I                   = $0ed3;
 
 { Hangul syllable-final (JongSeong) Characters }
-  XK_Hangul_J_Kiyeog                            = $ed4;
-  XK_Hangul_J_SsangKiyeog                               = $ed5;
-  XK_Hangul_J_KiyeogSios                                = $ed6;
-  XK_Hangul_J_Nieun                             = $ed7;
-  XK_Hangul_J_NieunJieuj                                = $ed8;
-  XK_Hangul_J_NieunHieuh                                = $ed9;
-  XK_Hangul_J_Dikeud                            = $eda;
-  XK_Hangul_J_Rieul                             = $edb;
-  XK_Hangul_J_RieulKiyeog                               = $edc;
-  XK_Hangul_J_RieulMieum                                = $edd;
-  XK_Hangul_J_RieulPieub                                = $ede;
-  XK_Hangul_J_RieulSios                         = $edf;
-  XK_Hangul_J_RieulTieut                                = $ee0;
-  XK_Hangul_J_RieulPhieuf                               = $ee1;
-  XK_Hangul_J_RieulHieuh                                = $ee2;
-  XK_Hangul_J_Mieum                             = $ee3;
-  XK_Hangul_J_Pieub                             = $ee4;
-  XK_Hangul_J_PieubSios                         = $ee5;
-  XK_Hangul_J_Sios                              = $ee6;
-  XK_Hangul_J_SsangSios                         = $ee7;
-  XK_Hangul_J_Ieung                             = $ee8;
-  XK_Hangul_J_Jieuj                             = $ee9;
-  XK_Hangul_J_Cieuc                             = $eea;
-  XK_Hangul_J_Khieuq                            = $eeb;
-  XK_Hangul_J_Tieut                             = $eec;
-  XK_Hangul_J_Phieuf                            = $eed;
-  XK_Hangul_J_Hieuh                             = $eee;
+  XK_Hangul_J_Kiyeog            = $0ed4;
+  XK_Hangul_J_SsangKiyeog       = $0ed5;
+  XK_Hangul_J_KiyeogSios        = $0ed6;
+  XK_Hangul_J_Nieun             = $0ed7;
+  XK_Hangul_J_NieunJieuj        = $0ed8;
+  XK_Hangul_J_NieunHieuh        = $0ed9;
+  XK_Hangul_J_Dikeud            = $0eda;
+  XK_Hangul_J_Rieul             = $0edb;
+  XK_Hangul_J_RieulKiyeog       = $0edc;
+  XK_Hangul_J_RieulMieum        = $0edd;
+  XK_Hangul_J_RieulPieub        = $0ede;
+  XK_Hangul_J_RieulSios         = $0edf;
+  XK_Hangul_J_RieulTieut        = $0ee0;
+  XK_Hangul_J_RieulPhieuf       = $0ee1;
+  XK_Hangul_J_RieulHieuh        = $0ee2;
+  XK_Hangul_J_Mieum             = $0ee3;
+  XK_Hangul_J_Pieub             = $0ee4;
+  XK_Hangul_J_PieubSios         = $0ee5;
+  XK_Hangul_J_Sios              = $0ee6;
+  XK_Hangul_J_SsangSios         = $0ee7;
+  XK_Hangul_J_Ieung             = $0ee8;
+  XK_Hangul_J_Jieuj             = $0ee9;
+  XK_Hangul_J_Cieuc             = $0eea;
+  XK_Hangul_J_Khieuq            = $0eeb;
+  XK_Hangul_J_Tieut             = $0eec;
+  XK_Hangul_J_Phieuf            = $0eed;
+  XK_Hangul_J_Hieuh             = $0eee;
 
 { Ancient Hangul Consonant Characters }
-  XK_Hangul_RieulYeorinHieuh                    = $eef;
-  XK_Hangul_SunkyeongeumMieum                   = $ef0;
-  XK_Hangul_SunkyeongeumPieub                   = $ef1;
-  XK_Hangul_PanSios                             = $ef2;
-  XK_Hangul_KkogjiDalrinIeung                   = $ef3;
-  XK_Hangul_SunkyeongeumPhieuf                  = $ef4;
-  XK_Hangul_YeorinHieuh                         = $ef5;
+  XK_Hangul_RieulYeorinHieuh    = $0eef;
+  XK_Hangul_SunkyeongeumMieum   = $0ef0;
+  XK_Hangul_SunkyeongeumPieub   = $0ef1;
+  XK_Hangul_PanSios             = $0ef2;
+  XK_Hangul_KkogjiDalrinIeung   = $0ef3;
+  XK_Hangul_SunkyeongeumPhieuf  = $0ef4;
+  XK_Hangul_YeorinHieuh         = $0ef5;
 
 { Ancient Hangul Vowel Characters }
-  XK_Hangul_AraeA                                       = $ef6;
-  XK_Hangul_AraeAE                              = $ef7;
+  XK_Hangul_AraeA               = $0ef6;
+  XK_Hangul_AraeAE              = $0ef7;
 
 { Ancient Hangul syllable-final (JongSeong) Characters }
-  XK_Hangul_J_PanSios                           = $ef8;
-  XK_Hangul_J_KkogjiDalrinIeung                 = $ef9;
-  XK_Hangul_J_YeorinHieuh                               = $efa;
+  XK_Hangul_J_PanSios           = $0ef8;
+  XK_Hangul_J_KkogjiDalrinIeung = $0ef9;
+  XK_Hangul_J_YeorinHieuh       = $0efa;
 
 { Korean currency symbol }
-  XK_Korean_Won                                 = $eff;
+  XK_Korean_Won                 = $0eff;  {(U+20A9 WON SIGN)}
 
 {$ENDIF} { XK_KOREAN }
 
 {*
- *   Armenian
- *   Byte 3 = = $14
+ * Armenian
  *}
 
 {$IFDEF XK_ARMENIAN}
-  XK_Armenian_eternity                          = $14a1;
-  XK_Armenian_ligature_ew                               = $14a2;
-  XK_Armenian_full_stop                         = $14a3;
-  XK_Armenian_verjaket                          = $14a3;
-  XK_Armenian_parenright                                = $14a4;
-  XK_Armenian_parenleft                         = $14a5;
-  XK_Armenian_guillemotright                    = $14a6;
-  XK_Armenian_guillemotleft                     = $14a7;
-  XK_Armenian_em_dash                           = $14a8;
-  XK_Armenian_dot                                       = $14a9;
-  XK_Armenian_mijaket                           = $14a9;
-  XK_Armenian_separation_mark                   = $14aa;
-  XK_Armenian_but                                       = $14aa;
-  XK_Armenian_comma                             = $14ab;
-  XK_Armenian_en_dash                           = $14ac;
-  XK_Armenian_hyphen                            = $14ad;
-  XK_Armenian_yentamna                          = $14ad;
-  XK_Armenian_ellipsis                          = $14ae;
-  XK_Armenian_exclam                            = $14af;
-  XK_Armenian_amanak                            = $14af;
-  XK_Armenian_accent                            = $14b0;
-  XK_Armenian_shesht                            = $14b0;
-  XK_Armenian_question                          = $14b1;
-  XK_Armenian_paruyk                            = $14b1;
-  XKc_Armenian_AYB                                      = $14b2;
-  XK_Armenian_ayb                                       = $14b3;
-  XKc_Armenian_BEN                                      = $14b4;
-  XK_Armenian_ben                                       = $14b5;
-  XKc_Armenian_GIM                                      = $14b6;
-  XK_Armenian_gim                                       = $14b7;
-  XKc_Armenian_DA                                       = $14b8;
-  XK_Armenian_da                                        = $14b9;
-  XKc_Armenian_YECH                             = $14ba;
-  XK_Armenian_yech                              = $14bb;
-  XKc_Armenian_ZA                                       = $14bc;
-  XK_Armenian_za                                        = $14bd;
-  XKc_Armenian_E                                        = $14be;
-  XK_Armenian_e                                 = $14bf;
-  XKc_Armenian_AT                                       = $14c0;
-  XK_Armenian_at                                        = $14c1;
-  XKc_Armenian_TO                                       = $14c2;
-  XK_Armenian_to                                        = $14c3;
-  XKc_Armenian_ZHE                                      = $14c4;
-  XK_Armenian_zhe                                       = $14c5;
-  XKc_Armenian_INI                                      = $14c6;
-  XK_Armenian_ini                                       = $14c7;
-  XKc_Armenian_LYUN                             = $14c8;
-  XK_Armenian_lyun                              = $14c9;
-  XKc_Armenian_KHE                                      = $14ca;
-  XK_Armenian_khe                                       = $14cb;
-  XKc_Armenian_TSA                                      = $14cc;
-  XK_Armenian_tsa                                       = $14cd;
-  XKc_Armenian_KEN                                      = $14ce;
-  XK_Armenian_ken                                       = $14cf;
-  XKc_Armenian_HO                                       = $14d0;
-  XK_Armenian_ho                                        = $14d1;
-  XKc_Armenian_DZA                                      = $14d2;
-  XK_Armenian_dza                                       = $14d3;
-  XKc_Armenian_GHAT                             = $14d4;
-  XK_Armenian_ghat                              = $14d5;
-  XKc_Armenian_TCHE                             = $14d6;
-  XK_Armenian_tche                              = $14d7;
-  XKc_Armenian_MEN                                      = $14d8;
-  XK_Armenian_men                                       = $14d9;
-  XKc_Armenian_HI                                       = $14da;
-  XK_Armenian_hi                                        = $14db;
-  XKc_Armenian_NU                                       = $14dc;
-  XK_Armenian_nu                                        = $14dd;
-  XKc_Armenian_SHA                                      = $14de;
-  XK_Armenian_sha                                       = $14df;
-  XKc_Armenian_VO                                       = $14e0;
-  XK_Armenian_vo                                        = $14e1;
-  XKc_Armenian_CHA                                      = $14e2;
-  XK_Armenian_cha                                       = $14e3;
-  XKc_Armenian_PE                                       = $14e4;
-  XK_Armenian_pe                                        = $14e5;
-  XKc_Armenian_JE                                       = $14e6;
-  XK_Armenian_je                                        = $14e7;
-  XKc_Armenian_RA                                       = $14e8;
-  XK_Armenian_ra                                        = $14e9;
-  XKc_Armenian_SE                                       = $14ea;
-  XK_Armenian_se                                        = $14eb;
-  XKc_Armenian_VEV                                      = $14ec;
-  XK_Armenian_vev                                       = $14ed;
-  XKc_Armenian_TYUN                             = $14ee;
-  XK_Armenian_tyun                              = $14ef;
-  XKc_Armenian_RE                                       = $14f0;
-  XK_Armenian_re                                        = $14f1;
-  XKc_Armenian_TSO                                      = $14f2;
-  XK_Armenian_tso                                       = $14f3;
-  XKc_Armenian_VYUN                             = $14f4;
-  XK_Armenian_vyun                              = $14f5;
-  XKc_Armenian_PYUR                             = $14f6;
-  XK_Armenian_pyur                              = $14f7;
-  XKc_Armenian_KE                                       = $14f8;
-  XK_Armenian_ke                                        = $14f9;
-  XKc_Armenian_O                                        = $14fa;
-  XK_Armenian_o                                 = $14fb;
-  XKc_Armenian_FE                                       = $14fc;
-  XK_Armenian_fe                                        = $14fd;
-  XK_Armenian_apostrophe                                = $14fe;
-  XK_Armenian_section_sign                      = $14ff;
+  XK_Armenian_ligature_ew     = $1000587;  { U+0587 ARMENIAN SMALL LIGATURE ECH YIWN }
+  XK_Armenian_full_stop       = $1000589;  { U+0589 ARMENIAN FULL STOP }
+  XK_Armenian_verjaket        = $1000589;  { U+0589 ARMENIAN FULL STOP }
+  XK_Armenian_separation_mark = $100055d;  { U+055D ARMENIAN COMMA }
+  XK_Armenian_but             = $100055d;  { U+055D ARMENIAN COMMA }
+  XK_Armenian_hyphen          = $100058a;  { U+058A ARMENIAN HYPHEN }
+  XK_Armenian_yentamna        = $100058a;  { U+058A ARMENIAN HYPHEN }
+  XK_Armenian_exclam          = $100055c;  { U+055C ARMENIAN EXCLAMATION MARK }
+  XK_Armenian_amanak          = $100055c;  { U+055C ARMENIAN EXCLAMATION MARK }
+  XK_Armenian_accent          = $100055b;  { U+055B ARMENIAN EMPHASIS MARK }
+  XK_Armenian_shesht          = $100055b;  { U+055B ARMENIAN EMPHASIS MARK }
+  XK_Armenian_question        = $100055e;  { U+055E ARMENIAN QUESTION MARK }
+  XK_Armenian_paruyk          = $100055e;  { U+055E ARMENIAN QUESTION MARK }
+  XKc_Armenian_AYB            = $1000531;  { U+0531 ARMENIAN CAPITAL LETTER AYB }
+  XK_Armenian_ayb             = $1000561;  { U+0561 ARMENIAN SMALL LETTER AYB }
+  XKc_Armenian_BEN            = $1000532;  { U+0532 ARMENIAN CAPITAL LETTER BEN }
+  XK_Armenian_ben             = $1000562;  { U+0562 ARMENIAN SMALL LETTER BEN }
+  XKc_Armenian_GIM            = $1000533;  { U+0533 ARMENIAN CAPITAL LETTER GIM }
+  XK_Armenian_gim             = $1000563;  { U+0563 ARMENIAN SMALL LETTER GIM }
+  XKc_Armenian_DA             = $1000534;  { U+0534 ARMENIAN CAPITAL LETTER DA }
+  XK_Armenian_da              = $1000564;  { U+0564 ARMENIAN SMALL LETTER DA }
+  XKc_Armenian_YECH           = $1000535;  { U+0535 ARMENIAN CAPITAL LETTER ECH }
+  XK_Armenian_yech            = $1000565;  { U+0565 ARMENIAN SMALL LETTER ECH }
+  XKc_Armenian_ZA             = $1000536;  { U+0536 ARMENIAN CAPITAL LETTER ZA }
+  XK_Armenian_za              = $1000566;  { U+0566 ARMENIAN SMALL LETTER ZA }
+  XKc_Armenian_E              = $1000537;  { U+0537 ARMENIAN CAPITAL LETTER EH }
+  XK_Armenian_e               = $1000567;  { U+0567 ARMENIAN SMALL LETTER EH }
+  XKc_Armenian_AT             = $1000538;  { U+0538 ARMENIAN CAPITAL LETTER ET }
+  XK_Armenian_at              = $1000568;  { U+0568 ARMENIAN SMALL LETTER ET }
+  XKc_Armenian_TO             = $1000539;  { U+0539 ARMENIAN CAPITAL LETTER TO }
+  XK_Armenian_to              = $1000569;  { U+0569 ARMENIAN SMALL LETTER TO }
+  XKc_Armenian_ZHE            = $100053a;  { U+053A ARMENIAN CAPITAL LETTER ZHE }
+  XK_Armenian_zhe             = $100056a;  { U+056A ARMENIAN SMALL LETTER ZHE }
+  XKc_Armenian_INI            = $100053b;  { U+053B ARMENIAN CAPITAL LETTER INI }
+  XK_Armenian_ini             = $100056b;  { U+056B ARMENIAN SMALL LETTER INI }
+  XKc_Armenian_LYUN           = $100053c;  { U+053C ARMENIAN CAPITAL LETTER LIWN }
+  XK_Armenian_lyun            = $100056c;  { U+056C ARMENIAN SMALL LETTER LIWN }
+  XKc_Armenian_KHE            = $100053d;  { U+053D ARMENIAN CAPITAL LETTER XEH }
+  XK_Armenian_khe             = $100056d;  { U+056D ARMENIAN SMALL LETTER XEH }
+  XKc_Armenian_TSA            = $100053e;  { U+053E ARMENIAN CAPITAL LETTER CA }
+  XK_Armenian_tsa             = $100056e;  { U+056E ARMENIAN SMALL LETTER CA }
+  XKc_Armenian_KEN            = $100053f;  { U+053F ARMENIAN CAPITAL LETTER KEN }
+  XK_Armenian_ken             = $100056f;  { U+056F ARMENIAN SMALL LETTER KEN }
+  XKc_Armenian_HO             = $1000540;  { U+0540 ARMENIAN CAPITAL LETTER HO }
+  XK_Armenian_ho              = $1000570;  { U+0570 ARMENIAN SMALL LETTER HO }
+  XKc_Armenian_DZA            = $1000541;  { U+0541 ARMENIAN CAPITAL LETTER JA }
+  XK_Armenian_dza             = $1000571;  { U+0571 ARMENIAN SMALL LETTER JA }
+  XKc_Armenian_GHAT           = $1000542;  { U+0542 ARMENIAN CAPITAL LETTER GHAD }
+  XK_Armenian_ghat            = $1000572;  { U+0572 ARMENIAN SMALL LETTER GHAD }
+  XKc_Armenian_TCHE           = $1000543;  { U+0543 ARMENIAN CAPITAL LETTER CHEH }
+  XK_Armenian_tche            = $1000573;  { U+0573 ARMENIAN SMALL LETTER CHEH }
+  XKc_Armenian_MEN            = $1000544;  { U+0544 ARMENIAN CAPITAL LETTER MEN }
+  XK_Armenian_men             = $1000574;  { U+0574 ARMENIAN SMALL LETTER MEN }
+  XKc_Armenian_HI             = $1000545;  { U+0545 ARMENIAN CAPITAL LETTER YI }
+  XK_Armenian_hi              = $1000575;  { U+0575 ARMENIAN SMALL LETTER YI }
+  XKc_Armenian_NU             = $1000546;  { U+0546 ARMENIAN CAPITAL LETTER NOW }
+  XK_Armenian_nu              = $1000576;  { U+0576 ARMENIAN SMALL LETTER NOW }
+  XKc_Armenian_SHA            = $1000547;  { U+0547 ARMENIAN CAPITAL LETTER SHA }
+  XK_Armenian_sha             = $1000577;  { U+0577 ARMENIAN SMALL LETTER SHA }
+  XKc_Armenian_VO             = $1000548;  { U+0548 ARMENIAN CAPITAL LETTER VO }
+  XK_Armenian_vo              = $1000578;  { U+0578 ARMENIAN SMALL LETTER VO }
+  XKc_Armenian_CHA            = $1000549;  { U+0549 ARMENIAN CAPITAL LETTER CHA }
+  XK_Armenian_cha             = $1000579;  { U+0579 ARMENIAN SMALL LETTER CHA }
+  XKc_Armenian_PE             = $100054a;  { U+054A ARMENIAN CAPITAL LETTER PEH }
+  XK_Armenian_pe              = $100057a;  { U+057A ARMENIAN SMALL LETTER PEH }
+  XKc_Armenian_JE             = $100054b;  { U+054B ARMENIAN CAPITAL LETTER JHEH }
+  XK_Armenian_je              = $100057b;  { U+057B ARMENIAN SMALL LETTER JHEH }
+  XKc_Armenian_RA             = $100054c;  { U+054C ARMENIAN CAPITAL LETTER RA }
+  XK_Armenian_ra              = $100057c;  { U+057C ARMENIAN SMALL LETTER RA }
+  XKc_Armenian_SE             = $100054d;  { U+054D ARMENIAN CAPITAL LETTER SEH }
+  XK_Armenian_se              = $100057d;  { U+057D ARMENIAN SMALL LETTER SEH }
+  XKc_Armenian_VEV            = $100054e;  { U+054E ARMENIAN CAPITAL LETTER VEW }
+  XK_Armenian_vev             = $100057e;  { U+057E ARMENIAN SMALL LETTER VEW }
+  XKc_Armenian_TYUN           = $100054f;  { U+054F ARMENIAN CAPITAL LETTER TIWN }
+  XK_Armenian_tyun            = $100057f;  { U+057F ARMENIAN SMALL LETTER TIWN }
+  XKc_Armenian_RE             = $1000550;  { U+0550 ARMENIAN CAPITAL LETTER REH }
+  XK_Armenian_re              = $1000580;  { U+0580 ARMENIAN SMALL LETTER REH }
+  XKc_Armenian_TSO            = $1000551;  { U+0551 ARMENIAN CAPITAL LETTER CO }
+  XK_Armenian_tso             = $1000581;  { U+0581 ARMENIAN SMALL LETTER CO }
+  XKc_Armenian_VYUN           = $1000552;  { U+0552 ARMENIAN CAPITAL LETTER YIWN }
+  XK_Armenian_vyun            = $1000582;  { U+0582 ARMENIAN SMALL LETTER YIWN }
+  XKc_Armenian_PYUR           = $1000553;  { U+0553 ARMENIAN CAPITAL LETTER PIWR }
+  XK_Armenian_pyur            = $1000583;  { U+0583 ARMENIAN SMALL LETTER PIWR }
+  XKc_Armenian_KE             = $1000554;  { U+0554 ARMENIAN CAPITAL LETTER KEH }
+  XK_Armenian_ke              = $1000584;  { U+0584 ARMENIAN SMALL LETTER KEH }
+  XKc_Armenian_O              = $1000555;  { U+0555 ARMENIAN CAPITAL LETTER OH }
+  XK_Armenian_o               = $1000585;  { U+0585 ARMENIAN SMALL LETTER OH }
+  XKc_Armenian_FE             = $1000556;  { U+0556 ARMENIAN CAPITAL LETTER FEH }
+  XK_Armenian_fe              = $1000586;  { U+0586 ARMENIAN SMALL LETTER FEH }
+  XK_Armenian_apostrophe      = $100055a;  { U+055A ARMENIAN APOSTROPHE }
 {$ENDIF} { XK_ARMENIAN }
 
 {*
- *   Georgian
- *   Byte 3 = = $15
+ * Georgian
  *}
 
 {$IFDEF XK_GEORGIAN}
-  XK_Georgian_an                                        = $15d0;
-  XK_Georgian_ban                                       = $15d1;
-  XK_Georgian_gan                                       = $15d2;
-  XK_Georgian_don                                       = $15d3;
-  XK_Georgian_en                                        = $15d4;
-  XK_Georgian_vin                                       = $15d5;
-  XK_Georgian_zen                                       = $15d6;
-  XK_Georgian_tan                                       = $15d7;
-  XK_Georgian_in                                        = $15d8;
-  XK_Georgian_kan                                       = $15d9;
-  XK_Georgian_las                                       = $15da;
-  XK_Georgian_man                                       = $15db;
-  XK_Georgian_nar                                       = $15dc;
-  XK_Georgian_on                                        = $15dd;
-  XK_Georgian_par                                       = $15de;
-  XK_Georgian_zhar                              = $15df;
-  XK_Georgian_rae                                       = $15e0;
-  XK_Georgian_san                                       = $15e1;
-  XK_Georgian_tar                                       = $15e2;
-  XK_Georgian_un                                        = $15e3;
-  XK_Georgian_phar                              = $15e4;
-  XK_Georgian_khar                              = $15e5;
-  XK_Georgian_ghan                              = $15e6;
-  XK_Georgian_qar                                       = $15e7;
-  XK_Georgian_shin                              = $15e8;
-  XK_Georgian_chin                              = $15e9;
-  XK_Georgian_can                                       = $15ea;
-  XK_Georgian_jil                                       = $15eb;
-  XK_Georgian_cil                                       = $15ec;
-  XK_Georgian_char                              = $15ed;
-  XK_Georgian_xan                                       = $15ee;
-  XK_Georgian_jhan                              = $15ef;
-  XK_Georgian_hae                                       = $15f0;
-  XK_Georgian_he                                        = $15f1;
-  XK_Georgian_hie                                       = $15f2;
-  XK_Georgian_we                                        = $15f3;
-  XK_Georgian_har                                       = $15f4;
-  XK_Georgian_hoe                                       = $15f5;
-  XK_Georgian_fi                                        = $15f6;
+  XK_Georgian_an   = $10010d0;  { U+10D0 GEORGIAN LETTER AN }
+  XK_Georgian_ban  = $10010d1;  { U+10D1 GEORGIAN LETTER BAN }
+  XK_Georgian_gan  = $10010d2;  { U+10D2 GEORGIAN LETTER GAN }
+  XK_Georgian_don  = $10010d3;  { U+10D3 GEORGIAN LETTER DON }
+  XK_Georgian_en   = $10010d4;  { U+10D4 GEORGIAN LETTER EN }
+  XK_Georgian_vin  = $10010d5;  { U+10D5 GEORGIAN LETTER VIN }
+  XK_Georgian_zen  = $10010d6;  { U+10D6 GEORGIAN LETTER ZEN }
+  XK_Georgian_tan  = $10010d7;  { U+10D7 GEORGIAN LETTER TAN }
+  XK_Georgian_in   = $10010d8;  { U+10D8 GEORGIAN LETTER IN }
+  XK_Georgian_kan  = $10010d9;  { U+10D9 GEORGIAN LETTER KAN }
+  XK_Georgian_las  = $10010da;  { U+10DA GEORGIAN LETTER LAS }
+  XK_Georgian_man  = $10010db;  { U+10DB GEORGIAN LETTER MAN }
+  XK_Georgian_nar  = $10010dc;  { U+10DC GEORGIAN LETTER NAR }
+  XK_Georgian_on   = $10010dd;  { U+10DD GEORGIAN LETTER ON }
+  XK_Georgian_par  = $10010de;  { U+10DE GEORGIAN LETTER PAR }
+  XK_Georgian_zhar = $10010df;  { U+10DF GEORGIAN LETTER ZHAR }
+  XK_Georgian_rae  = $10010e0;  { U+10E0 GEORGIAN LETTER RAE }
+  XK_Georgian_san  = $10010e1;  { U+10E1 GEORGIAN LETTER SAN }
+  XK_Georgian_tar  = $10010e2;  { U+10E2 GEORGIAN LETTER TAR }
+  XK_Georgian_un   = $10010e3;  { U+10E3 GEORGIAN LETTER UN }
+  XK_Georgian_phar = $10010e4;  { U+10E4 GEORGIAN LETTER PHAR }
+  XK_Georgian_khar = $10010e5;  { U+10E5 GEORGIAN LETTER KHAR }
+  XK_Georgian_ghan = $10010e6;  { U+10E6 GEORGIAN LETTER GHAN }
+  XK_Georgian_qar  = $10010e7;  { U+10E7 GEORGIAN LETTER QAR }
+  XK_Georgian_shin = $10010e8;  { U+10E8 GEORGIAN LETTER SHIN }
+  XK_Georgian_chin = $10010e9;  { U+10E9 GEORGIAN LETTER CHIN }
+  XK_Georgian_can  = $10010ea;  { U+10EA GEORGIAN LETTER CAN }
+  XK_Georgian_jil  = $10010eb;  { U+10EB GEORGIAN LETTER JIL }
+  XK_Georgian_cil  = $10010ec;  { U+10EC GEORGIAN LETTER CIL }
+  XK_Georgian_char = $10010ed;  { U+10ED GEORGIAN LETTER CHAR }
+  XK_Georgian_xan  = $10010ee;  { U+10EE GEORGIAN LETTER XAN }
+  XK_Georgian_jhan = $10010ef;  { U+10EF GEORGIAN LETTER JHAN }
+  XK_Georgian_hae  = $10010f0;  { U+10F0 GEORGIAN LETTER HAE }
+  XK_Georgian_he   = $10010f1;  { U+10F1 GEORGIAN LETTER HE }
+  XK_Georgian_hie  = $10010f2;  { U+10F2 GEORGIAN LETTER HIE }
+  XK_Georgian_we   = $10010f3;  { U+10F3 GEORGIAN LETTER WE }
+  XK_Georgian_har  = $10010f4;  { U+10F4 GEORGIAN LETTER HAR }
+  XK_Georgian_hoe  = $10010f5;  { U+10F5 GEORGIAN LETTER HOE }
+  XK_Georgian_fi   = $10010f6;  { U+10F6 GEORGIAN LETTER FI }
 {$ENDIF} { XK_GEORGIAN }
 
 {*
- * Azeri (and other Turkic or Caucasian languages of ex-USSR)
- * Byte 3 = = $16
+ * Azeri (and other Turkic or Caucasian languages)
  *}
 
 {$IFDEF XK_CAUCASUS}
 { latin }
-  XKc_Ccedillaabovedot  = $16a2;
-  XKc_Xabovedot         = $16a3;
-  XKc_Qabovedot         = $16a5;
-  XKc_Ibreve            = $16a6;
-  XKc_IE                        = $16a7;
-  XKc_UO                        = $16a8;
-  XKc_Zstroke           = $16a9;
-  XKc_Gcaron            = $16aa;
-  XKc_Obarred           = $16af;
-  XK_ccedillaabovedot   = $16b2;
-  XK_xabovedot          = $16b3;
-  XKc_Ocaron            = $16b4;
-  XK_qabovedot          = $16b5;
-  XK_ibreve             = $16b6;
-  XK_ie                 = $16b7;
-  XK_uo                 = $16b8;
-  XK_zstroke            = $16b9;
-  XK_gcaron             = $16ba;
-  XK_ocaron             = $16bd;
-  XK_obarred            = $16bf;
-  XKc_SCHWA             = $16c6;
-  XK_schwa              = $16f6;
-{ those are not really Caucasus, but I put them here for now }
+  XKc_Xabovedot = $1001e8a;  { U+1E8A LATIN CAPITAL LETTER X WITH DOT ABOVE }
+  XKc_Ibreve    = $100012c;  { U+012C LATIN CAPITAL LETTER I WITH BREVE }
+  XKc_Zstroke   = $10001b5;  { U+01B5 LATIN CAPITAL LETTER Z WITH STROKE }
+  XKc_Gcaron    = $10001e6;  { U+01E6 LATIN CAPITAL LETTER G WITH CARON }
+  XKc_Ocaron    = $10001d1;  { U+01D2 LATIN CAPITAL LETTER O WITH CARON }
+  XKc_Obarred   = $100019f;  { U+019F LATIN CAPITAL LETTER O WITH MIDDLE TILDE }
+  XK_xabovedot  = $1001e8b;  { U+1E8B LATIN SMALL LETTER X WITH DOT ABOVE }
+  XK_ibreve     = $100012d;  { U+012D LATIN SMALL LETTER I WITH BREVE }
+  XK_zstroke    = $10001b6;  { U+01B6 LATIN SMALL LETTER Z WITH STROKE }
+  XK_gcaron     = $10001e7;  { U+01E7 LATIN SMALL LETTER G WITH CARON }
+  XK_ocaron     = $10001d2;  { U+01D2 LATIN SMALL LETTER O WITH CARON }
+  XK_obarred    = $1000275;  { U+0275 LATIN SMALL LETTER BARRED O }
+  XKc_SCHWA     = $100018f;  { U+018F LATIN CAPITAL LETTER SCHWA }
+  XK_schwa      = $1000259;  { U+0259 LATIN SMALL LETTER SCHWA }
+  XKc_EZH       = $10001b7;  { U+01B7 LATIN CAPITAL LETTER EZH }
+  XK_ezh        = $1000292;  { U+0292 LATIN SMALL LETTER EZH }
+{ those are not really Caucasus }
 { For Inupiak }
-  XKc_Lbelowdot         = $16d1;
-  XKc_Lstrokebelowdot   = $16d2;
-  XK_lbelowdot          = $16e1;
-  XK_lstrokebelowdot    = $16e2;
-{ For Guarani }
-  XKc_Gtilde            = $16d3;
-  XK_gtilde             = $16e3;
+  XKc_Lbelowdot = $1001e36;  { U+1E36 LATIN CAPITAL LETTER L WITH DOT BELOW }
+  XK_lbelowdot  = $1001e37;  { U+1E37 LATIN SMALL LETTER L WITH DOT BELOW }
 {$ENDIF} { XK_CAUCASUS }
 
 {*
- *   Vietnamese
- *   Byte 3 = = $1e
+ * Vietnamese
  *}
 
 {$IFDEF XK_VIETNAMESE}
-  XKc_Abelowdot                                 = $1ea0;
-  XK_abelowdot                                  = $1ea1;
-  XKc_Ahook                                     = $1ea2;
-  XK_ahook                                      = $1ea3;
-  XKc_Acircumflexacute                          = $1ea4;
-  XK_acircumflexacute                           = $1ea5;
-  XKc_Acircumflexgrave                          = $1ea6;
-  XK_acircumflexgrave                           = $1ea7;
-  XKc_Acircumflexhook                           = $1ea8;
-  XK_acircumflexhook                            = $1ea9;
-  XKc_Acircumflextilde                          = $1eaa;
-  XK_acircumflextilde                           = $1eab;
-  XKc_Acircumflexbelowdot                               = $1eac;
-  XK_acircumflexbelowdot                                = $1ead;
-  XKc_Abreveacute                                       = $1eae;
-  XK_abreveacute                                        = $1eaf;
-  XKc_Abrevegrave                                       = $1eb0;
-  XK_abrevegrave                                        = $1eb1;
-  XKc_Abrevehook                                        = $1eb2;
-  XK_abrevehook                                 = $1eb3;
-  XKc_Abrevetilde                                       = $1eb4;
-  XK_abrevetilde                                        = $1eb5;
-  XKc_Abrevebelowdot                            = $1eb6;
-  XK_abrevebelowdot                             = $1eb7;
-  XKc_Ebelowdot                                 = $1eb8;
-  XK_ebelowdot                                  = $1eb9;
-  XKc_Ehook                                     = $1eba;
-  XK_ehook                                      = $1ebb;
-  XKc_Etilde                                    = $1ebc;
-  XK_etilde                                     = $1ebd;
-  XKc_Ecircumflexacute                          = $1ebe;
-  XK_ecircumflexacute                           = $1ebf;
-  XKc_Ecircumflexgrave                          = $1ec0;
-  XK_ecircumflexgrave                           = $1ec1;
-  XKc_Ecircumflexhook                           = $1ec2;
-  XK_ecircumflexhook                            = $1ec3;
-  XKc_Ecircumflextilde                          = $1ec4;
-  XK_ecircumflextilde                           = $1ec5;
-  XKc_Ecircumflexbelowdot                               = $1ec6;
-  XK_ecircumflexbelowdot                                = $1ec7;
-  XKc_Ihook                                     = $1ec8;
-  XK_ihook                                      = $1ec9;
-  XKc_Ibelowdot                                 = $1eca;
-  XK_ibelowdot                                  = $1ecb;
-  XKc_Obelowdot                                 = $1ecc;
-  XK_obelowdot                                  = $1ecd;
-  XKc_Ohook                                     = $1ece;
-  XK_ohook                                      = $1ecf;
-  XKc_Ocircumflexacute                          = $1ed0;
-  XK_ocircumflexacute                           = $1ed1;
-  XKc_Ocircumflexgrave                          = $1ed2;
-  XK_ocircumflexgrave                           = $1ed3;
-  XKc_Ocircumflexhook                           = $1ed4;
-  XK_ocircumflexhook                            = $1ed5;
-  XKc_Ocircumflextilde                          = $1ed6;
-  XK_ocircumflextilde                           = $1ed7;
-  XKc_Ocircumflexbelowdot                               = $1ed8;
-  XK_ocircumflexbelowdot                                = $1ed9;
-  XKc_Ohornacute                                        = $1eda;
-  XK_ohornacute                                 = $1edb;
-  XKc_Ohorngrave                                        = $1edc;
-  XK_ohorngrave                                 = $1edd;
-  XKc_Ohornhook                                 = $1ede;
-  XK_ohornhook                                  = $1edf;
-  XKc_Ohorntilde                                        = $1ee0;
-  XK_ohorntilde                                 = $1ee1;
-  XKc_Ohornbelowdot                             = $1ee2;
-  XK_ohornbelowdot                              = $1ee3;
-  XKc_Ubelowdot                                 = $1ee4;
-  XK_ubelowdot                                  = $1ee5;
-  XKc_Uhook                                     = $1ee6;
-  XK_uhook                                      = $1ee7;
-  XKc_Uhornacute                                        = $1ee8;
-  XK_uhornacute                                 = $1ee9;
-  XKc_Uhorngrave                                        = $1eea;
-  XK_uhorngrave                                 = $1eeb;
-  XKc_Uhornhook                                 = $1eec;
-  XK_uhornhook                                  = $1eed;
-  XKc_Uhorntilde                                        = $1eee;
-  XK_uhorntilde                                 = $1eef;
-  XKc_Uhornbelowdot                             = $1ef0;
-  XK_uhornbelowdot                              = $1ef1;
-  XKc_Ybelowdot                                 = $1ef4;
-  XK_ybelowdot                                  = $1ef5;
-  XKc_Yhook                                     = $1ef6;
-  XK_yhook                                      = $1ef7;
-  XKc_Ytilde                                    = $1ef8;
-  XK_ytilde                                     = $1ef9;
-  XKc_Ohorn                                     = $1efa; { U+01a0 }
-  XK_ohorn                                      = $1efb; { U+01a1 }
-  XKc_Uhorn                                     = $1efc; { U+01af }
-  XK_uhorn                                      = $1efd; { U+01b0 }
-
-  XK_combining_tilde                            = $1e9f; { U+0303 }
-  XK_combining_grave                            = $1ef2; { U+0300 }
-  XK_combining_acute                            = $1ef3; { U+0301 }
-  XK_combining_hook                             = $1efe; { U+0309 }
-  XK_combining_belowdot                         = $1eff; { U+0323 }
+  XKc_Abelowdot           = $1001ea0;  { U+1EA0 LATIN CAPITAL LETTER A WITH DOT BELOW }
+  XK_abelowdot            = $1001ea1;  { U+1EA1 LATIN SMALL LETTER A WITH DOT BELOW }
+  XKc_Ahook               = $1001ea2;  { U+1EA2 LATIN CAPITAL LETTER A WITH HOOK ABOVE }
+  XK_ahook                = $1001ea3;  { U+1EA3 LATIN SMALL LETTER A WITH HOOK ABOVE }
+  XKc_Acircumflexacute    = $1001ea4;  { U+1EA4 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE }
+  XK_acircumflexacute     = $1001ea5;  { U+1EA5 LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE }
+  XKc_Acircumflexgrave    = $1001ea6;  { U+1EA6 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE }
+  XK_acircumflexgrave     = $1001ea7;  { U+1EA7 LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE }
+  XKc_Acircumflexhook     = $1001ea8;  { U+1EA8 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE }
+  XK_acircumflexhook      = $1001ea9;  { U+1EA9 LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE }
+  XKc_Acircumflextilde    = $1001eaa;  { U+1EAA LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE }
+  XK_acircumflextilde     = $1001eab;  { U+1EAB LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE }
+  XKc_Acircumflexbelowdot = $1001eac;  { U+1EAC LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW }
+  XK_acircumflexbelowdot  = $1001ead;  { U+1EAD LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW }
+  XKc_Abreveacute         = $1001eae;  { U+1EAE LATIN CAPITAL LETTER A WITH BREVE AND ACUTE }
+  XK_abreveacute          = $1001eaf;  { U+1EAF LATIN SMALL LETTER A WITH BREVE AND ACUTE }
+  XKc_Abrevegrave         = $1001eb0;  { U+1EB0 LATIN CAPITAL LETTER A WITH BREVE AND GRAVE }
+  XK_abrevegrave          = $1001eb1;  { U+1EB1 LATIN SMALL LETTER A WITH BREVE AND GRAVE }
+  XKc_Abrevehook          = $1001eb2;  { U+1EB2 LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE }
+  XK_abrevehook           = $1001eb3;  { U+1EB3 LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE }
+  XKc_Abrevetilde         = $1001eb4;  { U+1EB4 LATIN CAPITAL LETTER A WITH BREVE AND TILDE }
+  XK_abrevetilde          = $1001eb5;  { U+1EB5 LATIN SMALL LETTER A WITH BREVE AND TILDE }
+  XKc_Abrevebelowdot      = $1001eb6;  { U+1EB6 LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW }
+  XK_abrevebelowdot       = $1001eb7;  { U+1EB7 LATIN SMALL LETTER A WITH BREVE AND DOT BELOW }
+  XKc_Ebelowdot           = $1001eb8;  { U+1EB8 LATIN CAPITAL LETTER E WITH DOT BELOW }
+  XK_ebelowdot            = $1001eb9;  { U+1EB9 LATIN SMALL LETTER E WITH DOT BELOW }
+  XKc_Ehook               = $1001eba;  { U+1EBA LATIN CAPITAL LETTER E WITH HOOK ABOVE }
+  XK_ehook                = $1001ebb;  { U+1EBB LATIN SMALL LETTER E WITH HOOK ABOVE }
+  XKc_Etilde              = $1001ebc;  { U+1EBC LATIN CAPITAL LETTER E WITH TILDE }
+  XK_etilde               = $1001ebd;  { U+1EBD LATIN SMALL LETTER E WITH TILDE }
+  XKc_Ecircumflexacute    = $1001ebe;  { U+1EBE LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE }
+  XK_ecircumflexacute     = $1001ebf;  { U+1EBF LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE }
+  XKc_Ecircumflexgrave    = $1001ec0;  { U+1EC0 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE }
+  XK_ecircumflexgrave     = $1001ec1;  { U+1EC1 LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE }
+  XKc_Ecircumflexhook     = $1001ec2;  { U+1EC2 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE }
+  XK_ecircumflexhook      = $1001ec3;  { U+1EC3 LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE }
+  XKc_Ecircumflextilde    = $1001ec4;  { U+1EC4 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE }
+  XK_ecircumflextilde     = $1001ec5;  { U+1EC5 LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE }
+  XKc_Ecircumflexbelowdot = $1001ec6;  { U+1EC6 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW }
+  XK_ecircumflexbelowdot  = $1001ec7;  { U+1EC7 LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW }
+  XKc_Ihook               = $1001ec8;  { U+1EC8 LATIN CAPITAL LETTER I WITH HOOK ABOVE }
+  XK_ihook                = $1001ec9;  { U+1EC9 LATIN SMALL LETTER I WITH HOOK ABOVE }
+  XKc_Ibelowdot           = $1001eca;  { U+1ECA LATIN CAPITAL LETTER I WITH DOT BELOW }
+  XK_ibelowdot            = $1001ecb;  { U+1ECB LATIN SMALL LETTER I WITH DOT BELOW }
+  XKc_Obelowdot           = $1001ecc;  { U+1ECC LATIN CAPITAL LETTER O WITH DOT BELOW }
+  XK_obelowdot            = $1001ecd;  { U+1ECD LATIN SMALL LETTER O WITH DOT BELOW }
+  XKc_Ohook               = $1001ece;  { U+1ECE LATIN CAPITAL LETTER O WITH HOOK ABOVE }
+  XK_ohook                = $1001ecf;  { U+1ECF LATIN SMALL LETTER O WITH HOOK ABOVE }
+  XKc_Ocircumflexacute    = $1001ed0;  { U+1ED0 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE }
+  XK_ocircumflexacute     = $1001ed1;  { U+1ED1 LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE }
+  XKc_Ocircumflexgrave    = $1001ed2;  { U+1ED2 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE }
+  XK_ocircumflexgrave     = $1001ed3;  { U+1ED3 LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE }
+  XKc_Ocircumflexhook     = $1001ed4;  { U+1ED4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE }
+  XK_ocircumflexhook      = $1001ed5;  { U+1ED5 LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE }
+  XKc_Ocircumflextilde    = $1001ed6;  { U+1ED6 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE }
+  XK_ocircumflextilde     = $1001ed7;  { U+1ED7 LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE }
+  XKc_Ocircumflexbelowdot = $1001ed8;  { U+1ED8 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW }
+  XK_ocircumflexbelowdot  = $1001ed9;  { U+1ED9 LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW }
+  XKc_Ohornacute          = $1001eda;  { U+1EDA LATIN CAPITAL LETTER O WITH HORN AND ACUTE }
+  XK_ohornacute           = $1001edb;  { U+1EDB LATIN SMALL LETTER O WITH HORN AND ACUTE }
+  XKc_Ohorngrave          = $1001edc;  { U+1EDC LATIN CAPITAL LETTER O WITH HORN AND GRAVE }
+  XK_ohorngrave           = $1001edd;  { U+1EDD LATIN SMALL LETTER O WITH HORN AND GRAVE }
+  XKc_Ohornhook           = $1001ede;  { U+1EDE LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE }
+  XK_ohornhook            = $1001edf;  { U+1EDF LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE }
+  XKc_Ohorntilde          = $1001ee0;  { U+1EE0 LATIN CAPITAL LETTER O WITH HORN AND TILDE }
+  XK_ohorntilde           = $1001ee1;  { U+1EE1 LATIN SMALL LETTER O WITH HORN AND TILDE }
+  XKc_Ohornbelowdot       = $1001ee2;  { U+1EE2 LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW }
+  XK_ohornbelowdot        = $1001ee3;  { U+1EE3 LATIN SMALL LETTER O WITH HORN AND DOT BELOW }
+  XKc_Ubelowdot           = $1001ee4;  { U+1EE4 LATIN CAPITAL LETTER U WITH DOT BELOW }
+  XK_ubelowdot            = $1001ee5;  { U+1EE5 LATIN SMALL LETTER U WITH DOT BELOW }
+  XKc_Uhook               = $1001ee6;  { U+1EE6 LATIN CAPITAL LETTER U WITH HOOK ABOVE }
+  XK_uhook                = $1001ee7;  { U+1EE7 LATIN SMALL LETTER U WITH HOOK ABOVE }
+  XKc_Uhornacute          = $1001ee8;  { U+1EE8 LATIN CAPITAL LETTER U WITH HORN AND ACUTE }
+  XK_uhornacute           = $1001ee9;  { U+1EE9 LATIN SMALL LETTER U WITH HORN AND ACUTE }
+  XKc_Uhorngrave          = $1001eea;  { U+1EEA LATIN CAPITAL LETTER U WITH HORN AND GRAVE }
+  XK_uhorngrave           = $1001eeb;  { U+1EEB LATIN SMALL LETTER U WITH HORN AND GRAVE }
+  XKc_Uhornhook           = $1001eec;  { U+1EEC LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE }
+  XK_uhornhook            = $1001eed;  { U+1EED LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE }
+  XKc_Uhorntilde          = $1001eee;  { U+1EEE LATIN CAPITAL LETTER U WITH HORN AND TILDE }
+  XK_uhorntilde           = $1001eef;  { U+1EEF LATIN SMALL LETTER U WITH HORN AND TILDE }
+  XKc_Uhornbelowdot       = $1001ef0;  { U+1EF0 LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW }
+  XK_uhornbelowdot        = $1001ef1;  { U+1EF1 LATIN SMALL LETTER U WITH HORN AND DOT BELOW }
+  XKc_Ybelowdot           = $1001ef4;  { U+1EF4 LATIN CAPITAL LETTER Y WITH DOT BELOW }
+  XK_ybelowdot            = $1001ef5;  { U+1EF5 LATIN SMALL LETTER Y WITH DOT BELOW }
+  XKc_Yhook               = $1001ef6;  { U+1EF6 LATIN CAPITAL LETTER Y WITH HOOK ABOVE }
+  XK_yhook                = $1001ef7;  { U+1EF7 LATIN SMALL LETTER Y WITH HOOK ABOVE }
+  XKc_Ytilde              = $1001ef8;  { U+1EF8 LATIN CAPITAL LETTER Y WITH TILDE }
+  XK_ytilde               = $1001ef9;  { U+1EF9 LATIN SMALL LETTER Y WITH TILDE }
+  XKc_Ohorn               = $10001a0;  { U+01A0 LATIN CAPITAL LETTER O WITH HORN }
+  XK_ohorn                = $10001a1;  { U+01A1 LATIN SMALL LETTER O WITH HORN }
+  XKc_Uhorn               = $10001af;  { U+01AF LATIN CAPITAL LETTER U WITH HORN }
+  XK_uhorn                = $10001b0;  { U+01B0 LATIN SMALL LETTER U WITH HORN }
+
 {$ENDIF} { XK_VIETNAMESE }
 
 {$IFDEF XK_CURRENCY}
-  XK_EcuSign                                    = $20a0;
-  XK_ColonSign                                  = $20a1;
-  XK_CruzeiroSign                                       = $20a2;
-  XK_FFrancSign                                 = $20a3;
-  XK_LiraSign                                   = $20a4;
-  XK_MillSign                                   = $20a5;
-  XK_NairaSign                                  = $20a6;
-  XK_PesetaSign                                 = $20a7;
-  XK_RupeeSign                                  = $20a8;
-  XK_WonSign                                    = $20a9;
-  XK_NewSheqelSign                              = $20aa;
-  XK_DongSign                                   = $20ab;
-  XK_EuroSign                                   = $20ac;
+  XK_EcuSign       = $10020a0;  { U+20A0 EURO-CURRENCY SIGN }
+  XK_ColonSign     = $10020a1;  { U+20A1 COLON SIGN }
+  XK_CruzeiroSign  = $10020a2;  { U+20A2 CRUZEIRO SIGN }
+  XK_FFrancSign    = $10020a3;  { U+20A3 FRENCH FRANC SIGN }
+  XK_LiraSign      = $10020a4;  { U+20A4 LIRA SIGN }
+  XK_MillSign      = $10020a5;  { U+20A5 MILL SIGN }
+  XK_NairaSign     = $10020a6;  { U+20A6 NAIRA SIGN }
+  XK_PesetaSign    = $10020a7;  { U+20A7 PESETA SIGN }
+  XK_RupeeSign     = $10020a8;  { U+20A8 RUPEE SIGN }
+  XK_WonSign       = $10020a9;  { U+20A9 WON SIGN }
+  XK_NewSheqelSign = $10020aa;  { U+20AA NEW SHEQEL SIGN }
+  XK_DongSign      = $10020ab;  { U+20AB DONG SIGN }
+  XK_EuroSign      = $20ac;     { U+20AC EURO SIGN }
 {$ENDIF}
+
+{$IFDEF XK_MATHEMATICAL}
+{ one, two and three are defined above. }
+  XK_zerosuperior     = $1002070;  { U+2070 SUPERSCRIPT ZERO }
+  XK_foursuperior     = $1002074;  { U+2074 SUPERSCRIPT FOUR }
+  XK_fivesuperior     = $1002075;  { U+2075 SUPERSCRIPT FIVE }
+  XK_sixsuperior      = $1002076;  { U+2076 SUPERSCRIPT SIX }
+  XK_sevensuperior    = $1002077;  { U+2077 SUPERSCRIPT SEVEN }
+  XK_eightsuperior    = $1002078;  { U+2078 SUPERSCRIPT EIGHT }
+  XK_ninesuperior     = $1002079;  { U+2079 SUPERSCRIPT NINE }
+  XK_zerosubscript    = $1002080;  { U+2080 SUBSCRIPT ZERO }
+  XK_onesubscript     = $1002081;  { U+2081 SUBSCRIPT ONE }
+  XK_twosubscript     = $1002082;  { U+2082 SUBSCRIPT TWO }
+  XK_threesubscript   = $1002083;  { U+2083 SUBSCRIPT THREE }
+  XK_foursubscript    = $1002084;  { U+2084 SUBSCRIPT FOUR }
+  XK_fivesubscript    = $1002085;  { U+2085 SUBSCRIPT FIVE }
+  XK_sixsubscript     = $1002086;  { U+2086 SUBSCRIPT SIX }
+  XK_sevensubscript   = $1002087;  { U+2087 SUBSCRIPT SEVEN }
+  XK_eightsubscript   = $1002088;  { U+2088 SUBSCRIPT EIGHT }
+  XK_ninesubscript    = $1002089;  { U+2089 SUBSCRIPT NINE }
+  XK_partdifferential = $1002202;  { U+2202 PARTIAL DIFFERENTIAL }
+  XK_emptyset         = $1002205;  { U+2205 NULL SET }
+  XK_elementof        = $1002208;  { U+2208 ELEMENT OF }
+  XK_notelementof     = $1002209;  { U+2209 NOT AN ELEMENT OF }
+  XK_containsas       = $100220B;  { U+220B CONTAINS AS MEMBER }
+  XK_squareroot       = $100221A;  { U+221A SQUARE ROOT }
+  XK_cuberoot         = $100221B;  { U+221B CUBE ROOT }
+  XK_fourthroot       = $100221C;  { U+221C FOURTH ROOT }
+  XK_dintegral        = $100222C;  { U+222C DOUBLE INTEGRAL }
+  XK_tintegral        = $100222D;  { U+222D TRIPLE INTEGRAL }
+  XK_because          = $1002235;  { U+2235 BECAUSE }
+  XK_approxeq         = $1002248;  { U+2245 ALMOST EQUAL TO }
+  XK_notapproxeq      = $1002247;  { U+2247 NOT ALMOST EQUAL TO }
+  XK_notidentical     = $1002262;  { U+2262 NOT IDENTICAL TO }
+  XK_stricteq         = $1002263;  { U+2263 STRICTLY EQUIVALENT TO }
+{$ENDIF} { XK_MATHEMATICAL }
+
+{$IFDEF XK_BRAILLE}
+  XK_braille_dot_1         = $fff1;
+  XK_braille_dot_2         = $fff2;
+  XK_braille_dot_3         = $fff3;
+  XK_braille_dot_4         = $fff4;
+  XK_braille_dot_5         = $fff5;
+  XK_braille_dot_6         = $fff6;
+  XK_braille_dot_7         = $fff7;
+  XK_braille_dot_8         = $fff8;
+  XK_braille_dot_9         = $fff9;
+  XK_braille_dot_10        = $fffa;
+  XK_braille_blank         = $1002800;  { U+2800 BRAILLE PATTERN BLANK }
+  XK_braille_dots_1        = $1002801;  { U+2801 BRAILLE PATTERN DOTS-1 }
+  XK_braille_dots_2        = $1002802;  { U+2802 BRAILLE PATTERN DOTS-2 }
+  XK_braille_dots_12       = $1002803;  { U+2803 BRAILLE PATTERN DOTS-12 }
+  XK_braille_dots_3        = $1002804;  { U+2804 BRAILLE PATTERN DOTS-3 }
+  XK_braille_dots_13       = $1002805;  { U+2805 BRAILLE PATTERN DOTS-13 }
+  XK_braille_dots_23       = $1002806;  { U+2806 BRAILLE PATTERN DOTS-23 }
+  XK_braille_dots_123      = $1002807;  { U+2807 BRAILLE PATTERN DOTS-123 }
+  XK_braille_dots_4        = $1002808;  { U+2808 BRAILLE PATTERN DOTS-4 }
+  XK_braille_dots_14       = $1002809;  { U+2809 BRAILLE PATTERN DOTS-14 }
+  XK_braille_dots_24       = $100280a;  { U+280a BRAILLE PATTERN DOTS-24 }
+  XK_braille_dots_124      = $100280b;  { U+280b BRAILLE PATTERN DOTS-124 }
+  XK_braille_dots_34       = $100280c;  { U+280c BRAILLE PATTERN DOTS-34 }
+  XK_braille_dots_134      = $100280d;  { U+280d BRAILLE PATTERN DOTS-134 }
+  XK_braille_dots_234      = $100280e;  { U+280e BRAILLE PATTERN DOTS-234 }
+  XK_braille_dots_1234     = $100280f;  { U+280f BRAILLE PATTERN DOTS-1234 }
+  XK_braille_dots_5        = $1002810;  { U+2810 BRAILLE PATTERN DOTS-5 }
+  XK_braille_dots_15       = $1002811;  { U+2811 BRAILLE PATTERN DOTS-15 }
+  XK_braille_dots_25       = $1002812;  { U+2812 BRAILLE PATTERN DOTS-25 }
+  XK_braille_dots_125      = $1002813;  { U+2813 BRAILLE PATTERN DOTS-125 }
+  XK_braille_dots_35       = $1002814;  { U+2814 BRAILLE PATTERN DOTS-35 }
+  XK_braille_dots_135      = $1002815;  { U+2815 BRAILLE PATTERN DOTS-135 }
+  XK_braille_dots_235      = $1002816;  { U+2816 BRAILLE PATTERN DOTS-235 }
+  XK_braille_dots_1235     = $1002817;  { U+2817 BRAILLE PATTERN DOTS-1235 }
+  XK_braille_dots_45       = $1002818;  { U+2818 BRAILLE PATTERN DOTS-45 }
+  XK_braille_dots_145      = $1002819;  { U+2819 BRAILLE PATTERN DOTS-145 }
+  XK_braille_dots_245      = $100281a;  { U+281a BRAILLE PATTERN DOTS-245 }
+  XK_braille_dots_1245     = $100281b;  { U+281b BRAILLE PATTERN DOTS-1245 }
+  XK_braille_dots_345      = $100281c;  { U+281c BRAILLE PATTERN DOTS-345 }
+  XK_braille_dots_1345     = $100281d;  { U+281d BRAILLE PATTERN DOTS-1345 }
+  XK_braille_dots_2345     = $100281e;  { U+281e BRAILLE PATTERN DOTS-2345 }
+  XK_braille_dots_12345    = $100281f;  { U+281f BRAILLE PATTERN DOTS-12345 }
+  XK_braille_dots_6        = $1002820;  { U+2820 BRAILLE PATTERN DOTS-6 }
+  XK_braille_dots_16       = $1002821;  { U+2821 BRAILLE PATTERN DOTS-16 }
+  XK_braille_dots_26       = $1002822;  { U+2822 BRAILLE PATTERN DOTS-26 }
+  XK_braille_dots_126      = $1002823;  { U+2823 BRAILLE PATTERN DOTS-126 }
+  XK_braille_dots_36       = $1002824;  { U+2824 BRAILLE PATTERN DOTS-36 }
+  XK_braille_dots_136      = $1002825;  { U+2825 BRAILLE PATTERN DOTS-136 }
+  XK_braille_dots_236      = $1002826;  { U+2826 BRAILLE PATTERN DOTS-236 }
+  XK_braille_dots_1236     = $1002827;  { U+2827 BRAILLE PATTERN DOTS-1236 }
+  XK_braille_dots_46       = $1002828;  { U+2828 BRAILLE PATTERN DOTS-46 }
+  XK_braille_dots_146      = $1002829;  { U+2829 BRAILLE PATTERN DOTS-146 }
+  XK_braille_dots_246      = $100282a;  { U+282a BRAILLE PATTERN DOTS-246 }
+  XK_braille_dots_1246     = $100282b;  { U+282b BRAILLE PATTERN DOTS-1246 }
+  XK_braille_dots_346      = $100282c;  { U+282c BRAILLE PATTERN DOTS-346 }
+  XK_braille_dots_1346     = $100282d;  { U+282d BRAILLE PATTERN DOTS-1346 }
+  XK_braille_dots_2346     = $100282e;  { U+282e BRAILLE PATTERN DOTS-2346 }
+  XK_braille_dots_12346    = $100282f;  { U+282f BRAILLE PATTERN DOTS-12346 }
+  XK_braille_dots_56       = $1002830;  { U+2830 BRAILLE PATTERN DOTS-56 }
+  XK_braille_dots_156      = $1002831;  { U+2831 BRAILLE PATTERN DOTS-156 }
+  XK_braille_dots_256      = $1002832;  { U+2832 BRAILLE PATTERN DOTS-256 }
+  XK_braille_dots_1256     = $1002833;  { U+2833 BRAILLE PATTERN DOTS-1256 }
+  XK_braille_dots_356      = $1002834;  { U+2834 BRAILLE PATTERN DOTS-356 }
+  XK_braille_dots_1356     = $1002835;  { U+2835 BRAILLE PATTERN DOTS-1356 }
+  XK_braille_dots_2356     = $1002836;  { U+2836 BRAILLE PATTERN DOTS-2356 }
+  XK_braille_dots_12356    = $1002837;  { U+2837 BRAILLE PATTERN DOTS-12356 }
+  XK_braille_dots_456      = $1002838;  { U+2838 BRAILLE PATTERN DOTS-456 }
+  XK_braille_dots_1456     = $1002839;  { U+2839 BRAILLE PATTERN DOTS-1456 }
+  XK_braille_dots_2456     = $100283a;  { U+283a BRAILLE PATTERN DOTS-2456 }
+  XK_braille_dots_12456    = $100283b;  { U+283b BRAILLE PATTERN DOTS-12456 }
+  XK_braille_dots_3456     = $100283c;  { U+283c BRAILLE PATTERN DOTS-3456 }
+  XK_braille_dots_13456    = $100283d;  { U+283d BRAILLE PATTERN DOTS-13456 }
+  XK_braille_dots_23456    = $100283e;  { U+283e BRAILLE PATTERN DOTS-23456 }
+  XK_braille_dots_123456   = $100283f;  { U+283f BRAILLE PATTERN DOTS-123456 }
+  XK_braille_dots_7        = $1002840;  { U+2840 BRAILLE PATTERN DOTS-7 }
+  XK_braille_dots_17       = $1002841;  { U+2841 BRAILLE PATTERN DOTS-17 }
+  XK_braille_dots_27       = $1002842;  { U+2842 BRAILLE PATTERN DOTS-27 }
+  XK_braille_dots_127      = $1002843;  { U+2843 BRAILLE PATTERN DOTS-127 }
+  XK_braille_dots_37       = $1002844;  { U+2844 BRAILLE PATTERN DOTS-37 }
+  XK_braille_dots_137      = $1002845;  { U+2845 BRAILLE PATTERN DOTS-137 }
+  XK_braille_dots_237      = $1002846;  { U+2846 BRAILLE PATTERN DOTS-237 }
+  XK_braille_dots_1237     = $1002847;  { U+2847 BRAILLE PATTERN DOTS-1237 }
+  XK_braille_dots_47       = $1002848;  { U+2848 BRAILLE PATTERN DOTS-47 }
+  XK_braille_dots_147      = $1002849;  { U+2849 BRAILLE PATTERN DOTS-147 }
+  XK_braille_dots_247      = $100284a;  { U+284a BRAILLE PATTERN DOTS-247 }
+  XK_braille_dots_1247     = $100284b;  { U+284b BRAILLE PATTERN DOTS-1247 }
+  XK_braille_dots_347      = $100284c;  { U+284c BRAILLE PATTERN DOTS-347 }
+  XK_braille_dots_1347     = $100284d;  { U+284d BRAILLE PATTERN DOTS-1347 }
+  XK_braille_dots_2347     = $100284e;  { U+284e BRAILLE PATTERN DOTS-2347 }
+  XK_braille_dots_12347    = $100284f;  { U+284f BRAILLE PATTERN DOTS-12347 }
+  XK_braille_dots_57       = $1002850;  { U+2850 BRAILLE PATTERN DOTS-57 }
+  XK_braille_dots_157      = $1002851;  { U+2851 BRAILLE PATTERN DOTS-157 }
+  XK_braille_dots_257      = $1002852;  { U+2852 BRAILLE PATTERN DOTS-257 }
+  XK_braille_dots_1257     = $1002853;  { U+2853 BRAILLE PATTERN DOTS-1257 }
+  XK_braille_dots_357      = $1002854;  { U+2854 BRAILLE PATTERN DOTS-357 }
+  XK_braille_dots_1357     = $1002855;  { U+2855 BRAILLE PATTERN DOTS-1357 }
+  XK_braille_dots_2357     = $1002856;  { U+2856 BRAILLE PATTERN DOTS-2357 }
+  XK_braille_dots_12357    = $1002857;  { U+2857 BRAILLE PATTERN DOTS-12357 }
+  XK_braille_dots_457      = $1002858;  { U+2858 BRAILLE PATTERN DOTS-457 }
+  XK_braille_dots_1457     = $1002859;  { U+2859 BRAILLE PATTERN DOTS-1457 }
+  XK_braille_dots_2457     = $100285a;  { U+285a BRAILLE PATTERN DOTS-2457 }
+  XK_braille_dots_12457    = $100285b;  { U+285b BRAILLE PATTERN DOTS-12457 }
+  XK_braille_dots_3457     = $100285c;  { U+285c BRAILLE PATTERN DOTS-3457 }
+  XK_braille_dots_13457    = $100285d;  { U+285d BRAILLE PATTERN DOTS-13457 }
+  XK_braille_dots_23457    = $100285e;  { U+285e BRAILLE PATTERN DOTS-23457 }
+  XK_braille_dots_123457   = $100285f;  { U+285f BRAILLE PATTERN DOTS-123457 }
+  XK_braille_dots_67       = $1002860;  { U+2860 BRAILLE PATTERN DOTS-67 }
+  XK_braille_dots_167      = $1002861;  { U+2861 BRAILLE PATTERN DOTS-167 }
+  XK_braille_dots_267      = $1002862;  { U+2862 BRAILLE PATTERN DOTS-267 }
+  XK_braille_dots_1267     = $1002863;  { U+2863 BRAILLE PATTERN DOTS-1267 }
+  XK_braille_dots_367      = $1002864;  { U+2864 BRAILLE PATTERN DOTS-367 }
+  XK_braille_dots_1367     = $1002865;  { U+2865 BRAILLE PATTERN DOTS-1367 }
+  XK_braille_dots_2367     = $1002866;  { U+2866 BRAILLE PATTERN DOTS-2367 }
+  XK_braille_dots_12367    = $1002867;  { U+2867 BRAILLE PATTERN DOTS-12367 }
+  XK_braille_dots_467      = $1002868;  { U+2868 BRAILLE PATTERN DOTS-467 }
+  XK_braille_dots_1467     = $1002869;  { U+2869 BRAILLE PATTERN DOTS-1467 }
+  XK_braille_dots_2467     = $100286a;  { U+286a BRAILLE PATTERN DOTS-2467 }
+  XK_braille_dots_12467    = $100286b;  { U+286b BRAILLE PATTERN DOTS-12467 }
+  XK_braille_dots_3467     = $100286c;  { U+286c BRAILLE PATTERN DOTS-3467 }
+  XK_braille_dots_13467    = $100286d;  { U+286d BRAILLE PATTERN DOTS-13467 }
+  XK_braille_dots_23467    = $100286e;  { U+286e BRAILLE PATTERN DOTS-23467 }
+  XK_braille_dots_123467   = $100286f;  { U+286f BRAILLE PATTERN DOTS-123467 }
+  XK_braille_dots_567      = $1002870;  { U+2870 BRAILLE PATTERN DOTS-567 }
+  XK_braille_dots_1567     = $1002871;  { U+2871 BRAILLE PATTERN DOTS-1567 }
+  XK_braille_dots_2567     = $1002872;  { U+2872 BRAILLE PATTERN DOTS-2567 }
+  XK_braille_dots_12567    = $1002873;  { U+2873 BRAILLE PATTERN DOTS-12567 }
+  XK_braille_dots_3567     = $1002874;  { U+2874 BRAILLE PATTERN DOTS-3567 }
+  XK_braille_dots_13567    = $1002875;  { U+2875 BRAILLE PATTERN DOTS-13567 }
+  XK_braille_dots_23567    = $1002876;  { U+2876 BRAILLE PATTERN DOTS-23567 }
+  XK_braille_dots_123567   = $1002877;  { U+2877 BRAILLE PATTERN DOTS-123567 }
+  XK_braille_dots_4567     = $1002878;  { U+2878 BRAILLE PATTERN DOTS-4567 }
+  XK_braille_dots_14567    = $1002879;  { U+2879 BRAILLE PATTERN DOTS-14567 }
+  XK_braille_dots_24567    = $100287a;  { U+287a BRAILLE PATTERN DOTS-24567 }
+  XK_braille_dots_124567   = $100287b;  { U+287b BRAILLE PATTERN DOTS-124567 }
+  XK_braille_dots_34567    = $100287c;  { U+287c BRAILLE PATTERN DOTS-34567 }
+  XK_braille_dots_134567   = $100287d;  { U+287d BRAILLE PATTERN DOTS-134567 }
+  XK_braille_dots_234567   = $100287e;  { U+287e BRAILLE PATTERN DOTS-234567 }
+  XK_braille_dots_1234567  = $100287f;  { U+287f BRAILLE PATTERN DOTS-1234567 }
+  XK_braille_dots_8        = $1002880;  { U+2880 BRAILLE PATTERN DOTS-8 }
+  XK_braille_dots_18       = $1002881;  { U+2881 BRAILLE PATTERN DOTS-18 }
+  XK_braille_dots_28       = $1002882;  { U+2882 BRAILLE PATTERN DOTS-28 }
+  XK_braille_dots_128      = $1002883;  { U+2883 BRAILLE PATTERN DOTS-128 }
+  XK_braille_dots_38       = $1002884;  { U+2884 BRAILLE PATTERN DOTS-38 }
+  XK_braille_dots_138      = $1002885;  { U+2885 BRAILLE PATTERN DOTS-138 }
+  XK_braille_dots_238      = $1002886;  { U+2886 BRAILLE PATTERN DOTS-238 }
+  XK_braille_dots_1238     = $1002887;  { U+2887 BRAILLE PATTERN DOTS-1238 }
+  XK_braille_dots_48       = $1002888;  { U+2888 BRAILLE PATTERN DOTS-48 }
+  XK_braille_dots_148      = $1002889;  { U+2889 BRAILLE PATTERN DOTS-148 }
+  XK_braille_dots_248      = $100288a;  { U+288a BRAILLE PATTERN DOTS-248 }
+  XK_braille_dots_1248     = $100288b;  { U+288b BRAILLE PATTERN DOTS-1248 }
+  XK_braille_dots_348      = $100288c;  { U+288c BRAILLE PATTERN DOTS-348 }
+  XK_braille_dots_1348     = $100288d;  { U+288d BRAILLE PATTERN DOTS-1348 }
+  XK_braille_dots_2348     = $100288e;  { U+288e BRAILLE PATTERN DOTS-2348 }
+  XK_braille_dots_12348    = $100288f;  { U+288f BRAILLE PATTERN DOTS-12348 }
+  XK_braille_dots_58       = $1002890;  { U+2890 BRAILLE PATTERN DOTS-58 }
+  XK_braille_dots_158      = $1002891;  { U+2891 BRAILLE PATTERN DOTS-158 }
+  XK_braille_dots_258      = $1002892;  { U+2892 BRAILLE PATTERN DOTS-258 }
+  XK_braille_dots_1258     = $1002893;  { U+2893 BRAILLE PATTERN DOTS-1258 }
+  XK_braille_dots_358      = $1002894;  { U+2894 BRAILLE PATTERN DOTS-358 }
+  XK_braille_dots_1358     = $1002895;  { U+2895 BRAILLE PATTERN DOTS-1358 }
+  XK_braille_dots_2358     = $1002896;  { U+2896 BRAILLE PATTERN DOTS-2358 }
+  XK_braille_dots_12358    = $1002897;  { U+2897 BRAILLE PATTERN DOTS-12358 }
+  XK_braille_dots_458      = $1002898;  { U+2898 BRAILLE PATTERN DOTS-458 }
+  XK_braille_dots_1458     = $1002899;  { U+2899 BRAILLE PATTERN DOTS-1458 }
+  XK_braille_dots_2458     = $100289a;  { U+289a BRAILLE PATTERN DOTS-2458 }
+  XK_braille_dots_12458    = $100289b;  { U+289b BRAILLE PATTERN DOTS-12458 }
+  XK_braille_dots_3458     = $100289c;  { U+289c BRAILLE PATTERN DOTS-3458 }
+  XK_braille_dots_13458    = $100289d;  { U+289d BRAILLE PATTERN DOTS-13458 }
+  XK_braille_dots_23458    = $100289e;  { U+289e BRAILLE PATTERN DOTS-23458 }
+  XK_braille_dots_123458   = $100289f;  { U+289f BRAILLE PATTERN DOTS-123458 }
+  XK_braille_dots_68       = $10028a0;  { U+28a0 BRAILLE PATTERN DOTS-68 }
+  XK_braille_dots_168      = $10028a1;  { U+28a1 BRAILLE PATTERN DOTS-168 }
+  XK_braille_dots_268      = $10028a2;  { U+28a2 BRAILLE PATTERN DOTS-268 }
+  XK_braille_dots_1268     = $10028a3;  { U+28a3 BRAILLE PATTERN DOTS-1268 }
+  XK_braille_dots_368      = $10028a4;  { U+28a4 BRAILLE PATTERN DOTS-368 }
+  XK_braille_dots_1368     = $10028a5;  { U+28a5 BRAILLE PATTERN DOTS-1368 }
+  XK_braille_dots_2368     = $10028a6;  { U+28a6 BRAILLE PATTERN DOTS-2368 }
+  XK_braille_dots_12368    = $10028a7;  { U+28a7 BRAILLE PATTERN DOTS-12368 }
+  XK_braille_dots_468      = $10028a8;  { U+28a8 BRAILLE PATTERN DOTS-468 }
+  XK_braille_dots_1468     = $10028a9;  { U+28a9 BRAILLE PATTERN DOTS-1468 }
+  XK_braille_dots_2468     = $10028aa;  { U+28aa BRAILLE PATTERN DOTS-2468 }
+  XK_braille_dots_12468    = $10028ab;  { U+28ab BRAILLE PATTERN DOTS-12468 }
+  XK_braille_dots_3468     = $10028ac;  { U+28ac BRAILLE PATTERN DOTS-3468 }
+  XK_braille_dots_13468    = $10028ad;  { U+28ad BRAILLE PATTERN DOTS-13468 }
+  XK_braille_dots_23468    = $10028ae;  { U+28ae BRAILLE PATTERN DOTS-23468 }
+  XK_braille_dots_123468   = $10028af;  { U+28af BRAILLE PATTERN DOTS-123468 }
+  XK_braille_dots_568      = $10028b0;  { U+28b0 BRAILLE PATTERN DOTS-568 }
+  XK_braille_dots_1568     = $10028b1;  { U+28b1 BRAILLE PATTERN DOTS-1568 }
+  XK_braille_dots_2568     = $10028b2;  { U+28b2 BRAILLE PATTERN DOTS-2568 }
+  XK_braille_dots_12568    = $10028b3;  { U+28b3 BRAILLE PATTERN DOTS-12568 }
+  XK_braille_dots_3568     = $10028b4;  { U+28b4 BRAILLE PATTERN DOTS-3568 }
+  XK_braille_dots_13568    = $10028b5;  { U+28b5 BRAILLE PATTERN DOTS-13568 }
+  XK_braille_dots_23568    = $10028b6;  { U+28b6 BRAILLE PATTERN DOTS-23568 }
+  XK_braille_dots_123568   = $10028b7;  { U+28b7 BRAILLE PATTERN DOTS-123568 }
+  XK_braille_dots_4568     = $10028b8;  { U+28b8 BRAILLE PATTERN DOTS-4568 }
+  XK_braille_dots_14568    = $10028b9;  { U+28b9 BRAILLE PATTERN DOTS-14568 }
+  XK_braille_dots_24568    = $10028ba;  { U+28ba BRAILLE PATTERN DOTS-24568 }
+  XK_braille_dots_124568   = $10028bb;  { U+28bb BRAILLE PATTERN DOTS-124568 }
+  XK_braille_dots_34568    = $10028bc;  { U+28bc BRAILLE PATTERN DOTS-34568 }
+  XK_braille_dots_134568   = $10028bd;  { U+28bd BRAILLE PATTERN DOTS-134568 }
+  XK_braille_dots_234568   = $10028be;  { U+28be BRAILLE PATTERN DOTS-234568 }
+  XK_braille_dots_1234568  = $10028bf;  { U+28bf BRAILLE PATTERN DOTS-1234568 }
+  XK_braille_dots_78       = $10028c0;  { U+28c0 BRAILLE PATTERN DOTS-78 }
+  XK_braille_dots_178      = $10028c1;  { U+28c1 BRAILLE PATTERN DOTS-178 }
+  XK_braille_dots_278      = $10028c2;  { U+28c2 BRAILLE PATTERN DOTS-278 }
+  XK_braille_dots_1278     = $10028c3;  { U+28c3 BRAILLE PATTERN DOTS-1278 }
+  XK_braille_dots_378      = $10028c4;  { U+28c4 BRAILLE PATTERN DOTS-378 }
+  XK_braille_dots_1378     = $10028c5;  { U+28c5 BRAILLE PATTERN DOTS-1378 }
+  XK_braille_dots_2378     = $10028c6;  { U+28c6 BRAILLE PATTERN DOTS-2378 }
+  XK_braille_dots_12378    = $10028c7;  { U+28c7 BRAILLE PATTERN DOTS-12378 }
+  XK_braille_dots_478      = $10028c8;  { U+28c8 BRAILLE PATTERN DOTS-478 }
+  XK_braille_dots_1478     = $10028c9;  { U+28c9 BRAILLE PATTERN DOTS-1478 }
+  XK_braille_dots_2478     = $10028ca;  { U+28ca BRAILLE PATTERN DOTS-2478 }
+  XK_braille_dots_12478    = $10028cb;  { U+28cb BRAILLE PATTERN DOTS-12478 }
+  XK_braille_dots_3478     = $10028cc;  { U+28cc BRAILLE PATTERN DOTS-3478 }
+  XK_braille_dots_13478    = $10028cd;  { U+28cd BRAILLE PATTERN DOTS-13478 }
+  XK_braille_dots_23478    = $10028ce;  { U+28ce BRAILLE PATTERN DOTS-23478 }
+  XK_braille_dots_123478   = $10028cf;  { U+28cf BRAILLE PATTERN DOTS-123478 }
+  XK_braille_dots_578      = $10028d0;  { U+28d0 BRAILLE PATTERN DOTS-578 }
+  XK_braille_dots_1578     = $10028d1;  { U+28d1 BRAILLE PATTERN DOTS-1578 }
+  XK_braille_dots_2578     = $10028d2;  { U+28d2 BRAILLE PATTERN DOTS-2578 }
+  XK_braille_dots_12578    = $10028d3;  { U+28d3 BRAILLE PATTERN DOTS-12578 }
+  XK_braille_dots_3578     = $10028d4;  { U+28d4 BRAILLE PATTERN DOTS-3578 }
+  XK_braille_dots_13578    = $10028d5;  { U+28d5 BRAILLE PATTERN DOTS-13578 }
+  XK_braille_dots_23578    = $10028d6;  { U+28d6 BRAILLE PATTERN DOTS-23578 }
+  XK_braille_dots_123578   = $10028d7;  { U+28d7 BRAILLE PATTERN DOTS-123578 }
+  XK_braille_dots_4578     = $10028d8;  { U+28d8 BRAILLE PATTERN DOTS-4578 }
+  XK_braille_dots_14578    = $10028d9;  { U+28d9 BRAILLE PATTERN DOTS-14578 }
+  XK_braille_dots_24578    = $10028da;  { U+28da BRAILLE PATTERN DOTS-24578 }
+  XK_braille_dots_124578   = $10028db;  { U+28db BRAILLE PATTERN DOTS-124578 }
+  XK_braille_dots_34578    = $10028dc;  { U+28dc BRAILLE PATTERN DOTS-34578 }
+  XK_braille_dots_134578   = $10028dd;  { U+28dd BRAILLE PATTERN DOTS-134578 }
+  XK_braille_dots_234578   = $10028de;  { U+28de BRAILLE PATTERN DOTS-234578 }
+  XK_braille_dots_1234578  = $10028df;  { U+28df BRAILLE PATTERN DOTS-1234578 }
+  XK_braille_dots_678      = $10028e0;  { U+28e0 BRAILLE PATTERN DOTS-678 }
+  XK_braille_dots_1678     = $10028e1;  { U+28e1 BRAILLE PATTERN DOTS-1678 }
+  XK_braille_dots_2678     = $10028e2;  { U+28e2 BRAILLE PATTERN DOTS-2678 }
+  XK_braille_dots_12678    = $10028e3;  { U+28e3 BRAILLE PATTERN DOTS-12678 }
+  XK_braille_dots_3678     = $10028e4;  { U+28e4 BRAILLE PATTERN DOTS-3678 }
+  XK_braille_dots_13678    = $10028e5;  { U+28e5 BRAILLE PATTERN DOTS-13678 }
+  XK_braille_dots_23678    = $10028e6;  { U+28e6 BRAILLE PATTERN DOTS-23678 }
+  XK_braille_dots_123678   = $10028e7;  { U+28e7 BRAILLE PATTERN DOTS-123678 }
+  XK_braille_dots_4678     = $10028e8;  { U+28e8 BRAILLE PATTERN DOTS-4678 }
+  XK_braille_dots_14678    = $10028e9;  { U+28e9 BRAILLE PATTERN DOTS-14678 }
+  XK_braille_dots_24678    = $10028ea;  { U+28ea BRAILLE PATTERN DOTS-24678 }
+  XK_braille_dots_124678   = $10028eb;  { U+28eb BRAILLE PATTERN DOTS-124678 }
+  XK_braille_dots_34678    = $10028ec;  { U+28ec BRAILLE PATTERN DOTS-34678 }
+  XK_braille_dots_134678   = $10028ed;  { U+28ed BRAILLE PATTERN DOTS-134678 }
+  XK_braille_dots_234678   = $10028ee;  { U+28ee BRAILLE PATTERN DOTS-234678 }
+  XK_braille_dots_1234678  = $10028ef;  { U+28ef BRAILLE PATTERN DOTS-1234678 }
+  XK_braille_dots_5678     = $10028f0;  { U+28f0 BRAILLE PATTERN DOTS-5678 }
+  XK_braille_dots_15678    = $10028f1;  { U+28f1 BRAILLE PATTERN DOTS-15678 }
+  XK_braille_dots_25678    = $10028f2;  { U+28f2 BRAILLE PATTERN DOTS-25678 }
+  XK_braille_dots_125678   = $10028f3;  { U+28f3 BRAILLE PATTERN DOTS-125678 }
+  XK_braille_dots_35678    = $10028f4;  { U+28f4 BRAILLE PATTERN DOTS-35678 }
+  XK_braille_dots_135678   = $10028f5;  { U+28f5 BRAILLE PATTERN DOTS-135678 }
+  XK_braille_dots_235678   = $10028f6;  { U+28f6 BRAILLE PATTERN DOTS-235678 }
+  XK_braille_dots_1235678  = $10028f7;  { U+28f7 BRAILLE PATTERN DOTS-1235678 }
+  XK_braille_dots_45678    = $10028f8;  { U+28f8 BRAILLE PATTERN DOTS-45678 }
+  XK_braille_dots_145678   = $10028f9;  { U+28f9 BRAILLE PATTERN DOTS-145678 }
+  XK_braille_dots_245678   = $10028fa;  { U+28fa BRAILLE PATTERN DOTS-245678 }
+  XK_braille_dots_1245678  = $10028fb;  { U+28fb BRAILLE PATTERN DOTS-1245678 }
+  XK_braille_dots_345678   = $10028fc;  { U+28fc BRAILLE PATTERN DOTS-345678 }
+  XK_braille_dots_1345678  = $10028fd;  { U+28fd BRAILLE PATTERN DOTS-1345678 }
+  XK_braille_dots_2345678  = $10028fe;  { U+28fe BRAILLE PATTERN DOTS-2345678 }
+  XK_braille_dots_12345678 = $10028ff;  { U+28ff BRAILLE PATTERN DOTS-12345678 }
+{$ENDIF} { XK_BRAILLE }
+
+{*
+ * Sinhala (http://unicode.org/charts/PDF/U0D80.pdf)
+ * http://www.nongnu.org/sinhala/doc/transliteration/sinhala-transliteration_6.html
+ *}
+
+{$IFDEF XK_SINHALA}
+  XK_Sinh_ng         = $1000d82;  { U+0D82 SINHALA ANUSVARAYA }
+  XK_Sinh_h2         = $1000d83;  { U+0D83 SINHALA VISARGAYA }
+  XK_Sinh_a          = $1000d85;  { U+0D85 SINHALA AYANNA }
+  XK_Sinh_aa         = $1000d86;  { U+0D86 SINHALA AAYANNA }
+  XK_Sinh_ae         = $1000d87;  { U+0D87 SINHALA AEYANNA }
+  XK_Sinh_aee        = $1000d88;  { U+0D88 SINHALA AEEYANNA }
+  XK_Sinh_i          = $1000d89;  { U+0D89 SINHALA IYANNA }
+  XK_Sinh_ii         = $1000d8a;  { U+0D8A SINHALA IIYANNA }
+  XK_Sinh_u          = $1000d8b;  { U+0D8B SINHALA UYANNA }
+  XK_Sinh_uu         = $1000d8c;  { U+0D8C SINHALA UUYANNA }
+  XK_Sinh_ri         = $1000d8d;  { U+0D8D SINHALA IRUYANNA }
+  XK_Sinh_rii        = $1000d8e;  { U+0D8E SINHALA IRUUYANNA }
+  XK_Sinh_lu         = $1000d8f;  { U+0D8F SINHALA ILUYANNA }
+  XK_Sinh_luu        = $1000d90;  { U+0D90 SINHALA ILUUYANNA }
+  XK_Sinh_e          = $1000d91;  { U+0D91 SINHALA EYANNA }
+  XK_Sinh_ee         = $1000d92;  { U+0D92 SINHALA EEYANNA }
+  XK_Sinh_ai         = $1000d93;  { U+0D93 SINHALA AIYANNA }
+  XK_Sinh_o          = $1000d94;  { U+0D94 SINHALA OYANNA }
+  XK_Sinh_oo         = $1000d95;  { U+0D95 SINHALA OOYANNA }
+  XK_Sinh_au         = $1000d96;  { U+0D96 SINHALA AUYANNA }
+  XK_Sinh_ka         = $1000d9a;  { U+0D9A SINHALA KAYANNA }
+  XK_Sinh_kha        = $1000d9b;  { U+0D9B SINHALA MAHA. KAYANNA }
+  XK_Sinh_ga         = $1000d9c;  { U+0D9C SINHALA GAYANNA }
+  XK_Sinh_gha        = $1000d9d;  { U+0D9D SINHALA MAHA. GAYANNA }
+  XK_Sinh_ng2        = $1000d9e;  { U+0D9E SINHALA KANTAJA NAASIKYAYA }
+  XK_Sinh_nga        = $1000d9f;  { U+0D9F SINHALA SANYAKA GAYANNA }
+  XK_Sinh_ca         = $1000da0;  { U+0DA0 SINHALA CAYANNA }
+  XK_Sinh_cha        = $1000da1;  { U+0DA1 SINHALA MAHA. CAYANNA }
+  XK_Sinh_ja         = $1000da2;  { U+0DA2 SINHALA JAYANNA }
+  XK_Sinh_jha        = $1000da3;  { U+0DA3 SINHALA MAHA. JAYANNA }
+  XK_Sinh_nya        = $1000da4;  { U+0DA4 SINHALA TAALUJA NAASIKYAYA }
+  XK_Sinh_jnya       = $1000da5;  { U+0DA5 SINHALA TAALUJA SANYOOGA NAASIKYAYA }
+  XK_Sinh_nja        = $1000da6;  { U+0DA6 SINHALA SANYAKA JAYANNA }
+  XK_Sinh_tta        = $1000da7;  { U+0DA7 SINHALA TTAYANNA }
+  XK_Sinh_ttha       = $1000da8;  { U+0DA8 SINHALA MAHA. TTAYANNA }
+  XK_Sinh_dda        = $1000da9;  { U+0DA9 SINHALA DDAYANNA }
+  XK_Sinh_ddha       = $1000daa;  { U+0DAA SINHALA MAHA. DDAYANNA }
+  XK_Sinh_nna        = $1000dab;  { U+0DAB SINHALA MUURDHAJA NAYANNA }
+  XK_Sinh_ndda       = $1000dac;  { U+0DAC SINHALA SANYAKA DDAYANNA }
+  XK_Sinh_tha        = $1000dad;  { U+0DAD SINHALA TAYANNA }
+  XK_Sinh_thha       = $1000dae;  { U+0DAE SINHALA MAHA. TAYANNA }
+  XK_Sinh_dha        = $1000daf;  { U+0DAF SINHALA DAYANNA }
+  XK_Sinh_dhha       = $1000db0;  { U+0DB0 SINHALA MAHA. DAYANNA }
+  XK_Sinh_na         = $1000db1;  { U+0DB1 SINHALA DANTAJA NAYANNA }
+  XK_Sinh_ndha       = $1000db3;  { U+0DB3 SINHALA SANYAKA DAYANNA }
+  XK_Sinh_pa         = $1000db4;  { U+0DB4 SINHALA PAYANNA }
+  XK_Sinh_pha        = $1000db5;  { U+0DB5 SINHALA MAHA. PAYANNA }
+  XK_Sinh_ba         = $1000db6;  { U+0DB6 SINHALA BAYANNA }
+  XK_Sinh_bha        = $1000db7;  { U+0DB7 SINHALA MAHA. BAYANNA }
+  XK_Sinh_ma         = $1000db8;  { U+0DB8 SINHALA MAYANNA }
+  XK_Sinh_mba        = $1000db9;  { U+0DB9 SINHALA AMBA BAYANNA }
+  XK_Sinh_ya         = $1000dba;  { U+0DBA SINHALA YAYANNA }
+  XK_Sinh_ra         = $1000dbb;  { U+0DBB SINHALA RAYANNA }
+  XK_Sinh_la         = $1000dbd;  { U+0DBD SINHALA DANTAJA LAYANNA }
+  XK_Sinh_va         = $1000dc0;  { U+0DC0 SINHALA VAYANNA }
+  XK_Sinh_sha        = $1000dc1;  { U+0DC1 SINHALA TAALUJA SAYANNA }
+  XK_Sinh_ssha       = $1000dc2;  { U+0DC2 SINHALA MUURDHAJA SAYANNA }
+  XK_Sinh_sa         = $1000dc3;  { U+0DC3 SINHALA DANTAJA SAYANNA }
+  XK_Sinh_ha         = $1000dc4;  { U+0DC4 SINHALA HAYANNA }
+  XK_Sinh_lla        = $1000dc5;  { U+0DC5 SINHALA MUURDHAJA LAYANNA }
+  XK_Sinh_fa         = $1000dc6;  { U+0DC6 SINHALA FAYANNA }
+  XK_Sinh_al         = $1000dca;  { U+0DCA SINHALA AL-LAKUNA }
+  XK_Sinh_aa2        = $1000dcf;  { U+0DCF SINHALA AELA-PILLA }
+  XK_Sinh_ae2        = $1000dd0;  { U+0DD0 SINHALA AEDA-PILLA }
+  XK_Sinh_aee2       = $1000dd1;  { U+0DD1 SINHALA DIGA AEDA-PILLA }
+  XK_Sinh_i2         = $1000dd2;  { U+0DD2 SINHALA IS-PILLA }
+  XK_Sinh_ii2        = $1000dd3;  { U+0DD3 SINHALA DIGA IS-PILLA }
+  XK_Sinh_u2         = $1000dd4;  { U+0DD4 SINHALA PAA-PILLA }
+  XK_Sinh_uu2        = $1000dd6;  { U+0DD6 SINHALA DIGA PAA-PILLA }
+  XK_Sinh_ru2        = $1000dd8;  { U+0DD8 SINHALA GAETTA-PILLA }
+  XK_Sinh_e2         = $1000dd9;  { U+0DD9 SINHALA KOMBUVA }
+  XK_Sinh_ee2        = $1000dda;  { U+0DDA SINHALA DIGA KOMBUVA }
+  XK_Sinh_ai2        = $1000ddb;  { U+0DDB SINHALA KOMBU DEKA }
+  XK_Sinh_o2         = $1000ddc;  { U+0DDC SINHALA KOMBUVA HAA AELA-PILLA}
+  XK_Sinh_oo2        = $1000ddd;  { U+0DDD SINHALA KOMBUVA HAA DIGA AELA-PILLA}
+  XK_Sinh_au2        = $1000dde;  { U+0DDE SINHALA KOMBUVA HAA GAYANUKITTA }
+  XK_Sinh_lu2        = $1000ddf;  { U+0DDF SINHALA GAYANUKITTA }
+  XK_Sinh_ruu2       = $1000df2;  { U+0DF2 SINHALA DIGA GAETTA-PILLA }
+  XK_Sinh_luu2       = $1000df3;  { U+0DF3 SINHALA DIGA GAYANUKITTA }
+  XK_Sinh_kunddaliya = $1000df4;  { U+0DF4 SINHALA KUNDDALIYA }
+{$ENDIF} { XK_SINHALA }
+
 Implementation
 End.
diff --git a/packages/x11/src/sunkeysym.pp b/packages/x11/src/sunkeysym.pp
new file mode 100644
index 0000000000..e2ad4f62a1
--- /dev/null
+++ b/packages/x11/src/sunkeysym.pp
@@ -0,0 +1,113 @@
+(*
+ * Copyright (c) 1991, Oracle and/or its affiliates. All rights reserved.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice (including the next
+ * paragraph) shall be included in all copies or substantial portions of the
+ * Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ *)
+(************************************************************
+
+Copyright 1991, 1998  The Open Group
+
+Permission to use, copy, modify, distribute, and sell this software and its
+documentation for any purpose is hereby granted without fee, provided that
+the above copyright notice appear in all copies and that both that
+copyright notice and this permission notice appear in supporting
+documentation.
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+OPEN GROUP BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of The Open Group shall not be
+used in advertising or otherwise to promote the sale, use or other dealings
+in this Software without prior written authorization from The Open Group.
+
+***********************************************************)
+
+unit sunkeysym;
+
+interface
+
+{*
+ * Floating Accent
+ *}
+const
+  SunXK_FA_Grave     = $1005FF00;
+  SunXK_FA_Circum    = $1005FF01;
+  SunXK_FA_Tilde     = $1005FF02;
+  SunXK_FA_Acute     = $1005FF03;
+  SunXK_FA_Diaeresis = $1005FF04;
+  SunXK_FA_Cedilla   = $1005FF05;
+
+{*
+ * Miscellaneous Functions
+ *}
+
+  SunXK_F36 = $1005FF10;   { Labeled F11 }
+  SunXK_F37 = $1005FF11;   { Labeled F12 }
+
+  SunXK_Sys_Req      = $1005FF60;
+  SunXK_Print_Screen = $0000FF61;   { Same as XK_Print }
+
+{*
+ * International & Multi-Key Character Composition
+ *}
+
+  SunXK_Compose  = $0000FF20;   { Same as XK_Multi_key }
+  SunXK_AltGraph = $0000FF7E;   { Same as XK_Mode_switch }
+
+{*
+ * Cursor Control
+ *}
+
+  SunXK_PageUp   = $0000FF55;   { Same as XK_Prior }
+  SunXK_PageDown = $0000FF56;   { Same as XK_Next }
+
+{*
+ * Open Look Functions
+ *}
+
+  SunXK_Undo  = $0000FF65;   { Same as XK_Undo }
+  SunXK_Again = $0000FF66;   { Same as XK_Redo }
+  SunXK_Find  = $0000FF68;   { Same as XK_Find }
+  SunXK_Stop  = $0000FF69;   { Same as XK_Cancel }
+  SunXK_Props = $1005FF70;
+  SunXK_Front = $1005FF71;
+  SunXK_Copy  = $1005FF72;
+  SunXK_Open  = $1005FF73;
+  SunXK_Paste = $1005FF74;
+  SunXK_Cut   = $1005FF75;
+
+  SunXK_PowerSwitch          = $1005FF76;
+  SunXK_AudioLowerVolume     = $1005FF77;
+  SunXK_AudioMute            = $1005FF78;
+  SunXK_AudioRaiseVolume     = $1005FF79;
+  SunXK_VideoDegauss         = $1005FF7A;
+  SunXK_VideoLowerBrightness = $1005FF7B;
+  SunXK_VideoRaiseBrightness = $1005FF7C;
+  SunXK_PowerSwitchShift     = $1005FF7D;
+
+implementation
+end.
diff --git a/packages/x11/src/xf86keysym.pp b/packages/x11/src/xf86keysym.pp
new file mode 100644
index 0000000000..19cd37755d
--- /dev/null
+++ b/packages/x11/src/xf86keysym.pp
@@ -0,0 +1,227 @@
+(*
+ * XFree86 vendor specific keysyms.
+ *
+ * The XFree86 keysym range is 0x10080001 - 0x1008FFFF.
+ *
+ * X.Org will not be adding to the XF86 set of keysyms, though they have
+ * been adopted and are considered a "standard" part of X keysym definitions.
+ * XFree86 never properly commented these keysyms, so we have done our
+ * best to explain the semantic meaning of these keys.
+ *
+ * XFree86 has removed their mail archives of the period, that might have
+ * shed more light on some of these definitions. Until/unless we resurrect
+ * these archives, these are from memory and usage.
+ *)
+
+unit xf86keysym;
+
+interface
+
+(*
+ * ModeLock
+ *
+ * This one is old, and not really used any more since XKB offers this
+ * functionality.
+ *)
+const
+  XF86XK_ModeLock          = $1008FF01;   { Mode Switch Lock }
+
+{ Backlight controls. }
+  XF86XK_MonBrightnessUp   = $1008FF02;   { Monitor/panel brightness }
+  XF86XK_MonBrightnessDown = $1008FF03;   { Monitor/panel brightness }
+  XF86XK_KbdLightOnOff     = $1008FF04;   { Keyboards may be lit     }
+  XF86XK_KbdBrightnessUp   = $1008FF05;   { Keyboards may be lit     }
+  XF86XK_KbdBrightnessDown = $1008FF06;   { Keyboards may be lit     }
+
+{*
+ * Keys found on some "Internet" keyboards.
+ *}
+  XF86XK_Standby           = $1008FF10;   { System into standby mode   }
+  XF86XK_AudioLowerVolume  = $1008FF11;   { Volume control down        }
+  XF86XK_AudioMute         = $1008FF12;   { Mute sound from the system }
+  XF86XK_AudioRaiseVolume  = $1008FF13;   { Volume control up          }
+  XF86XK_AudioPlay         = $1008FF14;   { Start playing of audio >   }
+  XF86XK_AudioStop         = $1008FF15;   { Stop playing audio         }
+  XF86XK_AudioPrev         = $1008FF16;   { Previous track             }
+  XF86XK_AudioNext         = $1008FF17;   { Next track                 }
+  XF86XK_HomePage          = $1008FF18;   { Display user's home page   }
+  XF86XK_Mail              = $1008FF19;   { Invoke user's mail program }
+  XF86XK_Start             = $1008FF1A;   { Start application          }
+  XF86XK_Search            = $1008FF1B;   { Search                     }
+  XF86XK_AudioRecord       = $1008FF1C;   { Record audio application   }
+
+{ These are sometimes found on PDA's (e.g. Palm, PocketPC or elsewhere)   }
+  XF86XK_Calculator        = $1008FF1D;   { Invoke calculator program  }
+  XF86XK_Memo              = $1008FF1E;   { Invoke Memo taking program }
+  XF86XK_ToDoList          = $1008FF1F;   { Invoke To Do List program  }
+  XF86XK_Calendar          = $1008FF20;   { Invoke Calendar program    }
+  XF86XK_PowerDown         = $1008FF21;   { Deep sleep the system      }
+  XF86XK_ContrastAdjust    = $1008FF22;   { Adjust screen contrast     }
+  XF86XK_RockerUp          = $1008FF23;   { Rocker switches exist up   }
+  XF86XK_RockerDown        = $1008FF24;   { and down                   }
+  XF86XK_RockerEnter       = $1008FF25;   { and let you press them     }
+
+{ Some more "Internet" keyboard symbols }
+  XF86XK_Back              = $1008FF26;   { Like back on a browser     }
+  XF86XK_Forward           = $1008FF27;   { Like forward on a browser  }
+  XF86XK_Stop              = $1008FF28;   { Stop current operation     }
+  XF86XK_Refresh           = $1008FF29;   { Refresh the page           }
+  XF86XK_PowerOff          = $1008FF2A;   { Power off system entirely  }
+  XF86XK_WakeUp            = $1008FF2B;   { Wake up system from sleep  }
+  XF86XK_Eject             = $1008FF2C;   { Eject device (e.g. DVD)    }
+  XF86XK_ScreenSaver       = $1008FF2D;   { Invoke screensaver         }
+  XF86XK_WWW               = $1008FF2E;   { Invoke web browser         }
+  XF86XK_Sleep             = $1008FF2F;   { Put system to sleep        }
+  XF86XK_Favorites         = $1008FF30;   { Show favorite locations    }
+  XF86XK_AudioPause        = $1008FF31;   { Pause audio playing        }
+  XF86XK_AudioMedia        = $1008FF32;   { Launch media collection app }
+  XF86XK_MyComputer        = $1008FF33;   { Display "My Computer" window }
+  XF86XK_VendorHome        = $1008FF34;   { Display vendor home web site }
+  XF86XK_LightBulb         = $1008FF35;   { Light bulb keys exist       }
+  XF86XK_Shop              = $1008FF36;   { Display shopping web site   }
+  XF86XK_History           = $1008FF37;   { Show history of web surfing }
+  XF86XK_OpenURL           = $1008FF38;   { Open selected URL           }
+  XF86XK_AddFavorite       = $1008FF39;   { Add URL to favorites list   }
+  XF86XK_HotLinks          = $1008FF3A;   { Show "hot" links            }
+  XF86XK_BrightnessAdjust  = $1008FF3B;   { Invoke brightness adj. UI   }
+  XF86XK_Finance           = $1008FF3C;   { Display financial site      }
+  XF86XK_Community         = $1008FF3D;   { Display user's community    }
+  XF86XK_AudioRewind       = $1008FF3E;   { "rewind" audio track        }
+  XF86XK_BackForward       = $1008FF3F;   { ??? }
+  XF86XK_Launch0           = $1008FF40;   { Launch Application          }
+  XF86XK_Launch1           = $1008FF41;   { Launch Application          }
+  XF86XK_Launch2           = $1008FF42;   { Launch Application          }
+  XF86XK_Launch3           = $1008FF43;   { Launch Application          }
+  XF86XK_Launch4           = $1008FF44;   { Launch Application          }
+  XF86XK_Launch5           = $1008FF45;   { Launch Application          }
+  XF86XK_Launch6           = $1008FF46;   { Launch Application          }
+  XF86XK_Launch7           = $1008FF47;   { Launch Application          }
+  XF86XK_Launch8           = $1008FF48;   { Launch Application          }
+  XF86XK_Launch9           = $1008FF49;   { Launch Application          }
+  XF86XK_LaunchA           = $1008FF4A;   { Launch Application          }
+  XF86XK_LaunchB           = $1008FF4B;   { Launch Application          }
+  XF86XK_LaunchC           = $1008FF4C;   { Launch Application          }
+  XF86XK_LaunchD           = $1008FF4D;   { Launch Application          }
+  XF86XK_LaunchE           = $1008FF4E;   { Launch Application          }
+  XF86XK_LaunchF           = $1008FF4F;   { Launch Application          }
+
+  XF86XK_ApplicationLeft   = $1008FF50;   { switch to application, left }
+  XF86XK_ApplicationRight  = $1008FF51;   { switch to application, right}
+  XF86XK_Book              = $1008FF52;   { Launch bookreader           }
+  XF86XK_CD                = $1008FF53;   { Launch CD/DVD player        }
+  XF86XK_Calculater        = $1008FF54;   { Launch Calculater           }
+  XF86XK_Clear             = $1008FF55;   { Clear window, screen        }
+  XF86XK_Close             = $1008FF56;   { Close window                }
+  XF86XK_Copy              = $1008FF57;   { Copy selection              }
+  XF86XK_Cut               = $1008FF58;   { Cut selection               }
+  XF86XK_Display           = $1008FF59;   { Output switch key           }
+  XF86XK_DOS               = $1008FF5A;   { Launch DOS (emulation)      }
+  XF86XK_Documents         = $1008FF5B;   { Open documents window       }
+  XF86XK_Excel             = $1008FF5C;   { Launch spread sheet         }
+  XF86XK_Explorer          = $1008FF5D;   { Launch file explorer        }
+  XF86XK_Game              = $1008FF5E;   { Launch game                 }
+  XF86XK_Go                = $1008FF5F;   { Go to URL                   }
+  XF86XK_iTouch            = $1008FF60;   { Logitch iTouch- don't use   }
+  XF86XK_LogOff            = $1008FF61;   { Log off system              }
+  XF86XK_Market            = $1008FF62;   { ??                          }
+  XF86XK_Meeting           = $1008FF63;   { enter meeting in calendar   }
+  XF86XK_MenuKB            = $1008FF65;   { distingush keyboard from PB }
+  XF86XK_MenuPB            = $1008FF66;   { distinuish PB from keyboard }
+  XF86XK_MySites           = $1008FF67;   { Favourites                  }
+  XF86XK_New               = $1008FF68;   { New (folder, document...    }
+  XF86XK_News              = $1008FF69;   { News                        }
+  XF86XK_OfficeHome        = $1008FF6A;   { Office home (old Staroffice)}
+  XF86XK_Open              = $1008FF6B;   { Open                        }
+  XF86XK_Option            = $1008FF6C;   { ?? }
+  XF86XK_Paste             = $1008FF6D;   { Paste                       }
+  XF86XK_Phone             = $1008FF6E;   { Launch phone; dial number   }
+  XF86XK_Q                 = $1008FF70;   { Compaq's Q - don't use      }
+  XF86XK_Reply             = $1008FF72;   { Reply e.g., mail            }
+  XF86XK_Reload            = $1008FF73;   { Reload web page, file, etc. }
+  XF86XK_RotateWindows     = $1008FF74;   { Rotate windows e.g. xrandr  }
+  XF86XK_RotationPB        = $1008FF75;   { don't use                   }
+  XF86XK_RotationKB        = $1008FF76;   { don't use                   }
+  XF86XK_Save              = $1008FF77;   { Save (file, document, state }
+  XF86XK_ScrollUp          = $1008FF78;   { Scroll window/contents up   }
+  XF86XK_ScrollDown        = $1008FF79;   { Scrool window/contentd down }
+  XF86XK_ScrollClick       = $1008FF7A;   { Use XKB mousekeys instead   }
+  XF86XK_Send              = $1008FF7B;   { Send mail, file, object     }
+  XF86XK_Spell             = $1008FF7C;   { Spell checker               }
+  XF86XK_SplitScreen       = $1008FF7D;   { Split window or screen      }
+  XF86XK_Support           = $1008FF7E;   { Get support (??)            }
+  XF86XK_TaskPane          = $1008FF7F;   { Show tasks }
+  XF86XK_Terminal          = $1008FF80;   { Launch terminal emulator    }
+  XF86XK_Tools             = $1008FF81;   { toolbox of desktop/app.     }
+  XF86XK_Travel            = $1008FF82;   { ?? }
+  XF86XK_UserPB            = $1008FF84;   { ?? }
+  XF86XK_User1KB           = $1008FF85;   { ?? }
+  XF86XK_User2KB           = $1008FF86;   { ?? }
+  XF86XK_Video             = $1008FF87;   { Launch video player       }
+  XF86XK_WheelButton       = $1008FF88;   { button from a mouse wheel }
+  XF86XK_Word              = $1008FF89;   { Launch word processor     }
+  XF86XK_Xfer              = $1008FF8A;
+  XF86XK_ZoomIn            = $1008FF8B;   { zoom in view, map, etc.   }
+  XF86XK_ZoomOut           = $1008FF8C;   { zoom out view, map, etc.  }
+
+  XF86XK_Away              = $1008FF8D;   { mark yourself as away     }
+  XF86XK_Messenger         = $1008FF8E;   { as in instant messaging   }
+  XF86XK_WebCam            = $1008FF8F;   { Launch web camera app.    }
+  XF86XK_MailForward       = $1008FF90;   { Forward in mail           }
+  XF86XK_Pictures          = $1008FF91;   { Show pictures             }
+  XF86XK_Music             = $1008FF92;   { Launch music application  }
+
+  XF86XK_Battery           = $1008FF93;   { Display battery information }
+  XF86XK_Bluetooth         = $1008FF94;   { Enable/disable Bluetooth    }
+  XF86XK_WLAN              = $1008FF95;   { Enable/disable WLAN         }
+  XF86XK_UWB               = $1008FF96;   { Enable/disable UWB          }
+
+  XF86XK_AudioForward      = $1008FF97;   { fast-forward audio track    }
+  XF86XK_AudioRepeat       = $1008FF98;   { toggle repeat mode          }
+  XF86XK_AudioRandomPlay   = $1008FF99;   { toggle shuffle mode         }
+  XF86XK_Subtitle          = $1008FF9A;   { cycle through subtitle      }
+  XF86XK_AudioCycleTrack   = $1008FF9B;   { cycle through audio tracks  }
+  XF86XK_CycleAngle        = $1008FF9C;   { cycle through angles        }
+  XF86XK_FrameBack         = $1008FF9D;   { video: go one frame back    }
+  XF86XK_FrameForward      = $1008FF9E;   { video: go one frame forward }
+  XF86XK_Time              = $1008FF9F;   { display, or shows an entry for time seeking }
+  XF86XK_Select            = $1008FFA0;   { Select button on joypads and remotes }
+  XF86XK_View              = $1008FFA1;   { Show a view options/properties }
+  XF86XK_TopMenu           = $1008FFA2;   { Go to a top-level menu in a video }
+
+  XF86XK_Red               = $1008FFA3;   { Red button                  }
+  XF86XK_Green             = $1008FFA4;   { Green button                }
+  XF86XK_Yellow            = $1008FFA5;   { Yellow button               }
+  XF86XK_Blue              = $1008FFA6;   { Blue button                 }
+
+  XF86XK_Suspend           = $1008FFA7;   { Sleep to RAM                }
+  XF86XK_Hibernate         = $1008FFA8;   { Sleep to disk               }
+  XF86XK_TouchpadToggle    = $1008FFA9;   { Toggle between touchpad/trackstick }
+  XF86XK_TouchpadOn        = $1008FFB0;   { The touchpad got switched on }
+  XF86XK_TouchpadOff       = $1008FFB1;   { The touchpad got switched off }
+
+  XF86XK_AudioMicMute      = $1008FFB2;   { Mute the Mic from the system }
+
+{ Keys for special action keys (hot keys) }
+{ Virtual terminals on some operating systems }
+  XF86XK_Switch_VT_1       = $1008FE01;
+  XF86XK_Switch_VT_2       = $1008FE02;
+  XF86XK_Switch_VT_3       = $1008FE03;
+  XF86XK_Switch_VT_4       = $1008FE04;
+  XF86XK_Switch_VT_5       = $1008FE05;
+  XF86XK_Switch_VT_6       = $1008FE06;
+  XF86XK_Switch_VT_7       = $1008FE07;
+  XF86XK_Switch_VT_8       = $1008FE08;
+  XF86XK_Switch_VT_9       = $1008FE09;
+  XF86XK_Switch_VT_10      = $1008FE0A;
+  XF86XK_Switch_VT_11      = $1008FE0B;
+  XF86XK_Switch_VT_12      = $1008FE0C;
+
+  XF86XK_Ungrab            = $1008FE20;   { force ungrab               }
+  XF86XK_ClearGrab         = $1008FE21;   { kill application with grab }
+  XF86XK_Next_VMode        = $1008FE22;   { next video mode available  }
+  XF86XK_Prev_VMode        = $1008FE23;   { prev. video mode available }
+  XF86XK_LogWindowTree     = $1008FE24;   { print window tree to log   }
+  XF86XK_LogGrabInfo       = $1008FE25;   { print all active grabs to log }
+
+implementation
+end.
diff --git a/packages/x11/src/xlib.pp b/packages/x11/src/xlib.pp
index d125b6f7cd..004f9110e0 100644
--- a/packages/x11/src/xlib.pp
+++ b/packages/x11/src/xlib.pp
@@ -1019,9 +1019,9 @@ type
    TXIC = record
      end;
 
-   TXIMProc = procedure (para1:TXIM; para2:TXPointer; para3:TXPointer);cdecl;
+   TXIMProc = procedure (para1:PXIM; para2:TXPointer; para3:TXPointer);cdecl;
 
-   TXICProc = function (para1:TXIC; para2:TXPointer; para3:TXPointer):TBoolResult;cdecl;
+   TXICProc = function (para1:PXIC; para2:TXPointer; para3:TXPointer):TBoolResult;cdecl;
 
    TXIDProc = procedure (para1:PDisplay; para2:TXPointer; para3:TXPointer);cdecl;
 
@@ -1756,20 +1756,20 @@ procedure Xutf8DrawImageString(para1:PDisplay; para2:TDrawable; para3:TXFontSet;
             para6:cint; para7:Pchar; para8:cint);cdecl;external libX11;
 function XOpenIM(para1:PDisplay; para2:PXrmHashBucketRec; para3:Pchar; para4:Pchar):PXIM;cdecl;external libX11;
 function XCloseIM(para1:PXIM):TStatus;cdecl;external libX11;
-function XGetIMValues(para1:TXIM; dotdotdot:array of const):Pchar;cdecl;external libX11;
-function XSetIMValues(para1:TXIM; dotdotdot:array of const):Pchar;cdecl;external libX11;
-function XDisplayOfIM(para1:TXIM):PDisplay;cdecl;external libX11;
-function XLocaleOfIM(para1:TXIM):Pchar;cdecl;external libX11;
+function XGetIMValues(para1:PXIM; dotdotdot:array of const):Pchar;cdecl;external libX11;
+function XSetIMValues(para1:PXIM; dotdotdot:array of const):Pchar;cdecl;external libX11;
+function XDisplayOfIM(para1:PXIM):PDisplay;cdecl;external libX11;
+function XLocaleOfIM(para1:PXIM):Pchar;cdecl;external libX11;
 function XCreateIC(para1:PXIM; dotdotdot:array of const):PXIC;cdecl;external libX11;
 procedure XDestroyIC(para1:PXIC);cdecl;external libX11;
 procedure XSetICFocus(para1:PXIC);cdecl;external libX11;
 procedure XUnsetICFocus(para1:PXIC);cdecl;external libX11;
-function XwcResetIC(para1:TXIC):PWideChar;cdecl;external libX11;
-function XmbResetIC(para1:TXIC):Pchar;cdecl;external libX11;
+function XwcResetIC(para1:PXIC):PWideChar;cdecl;external libX11;
+function XmbResetIC(para1:PXIC):Pchar;cdecl;external libX11;
 function Xutf8ResetIC(para1:PXIC):Pchar;cdecl;external libX11;
-function XSetICValues(para1:TXIC; dotdotdot:array of const):Pchar;cdecl;external libX11;
-function XGetICValues(para1:TXIC; dotdotdot:array of const):Pchar;cdecl;external libX11;
-function XIMOfIC(para1:TXIC):TXIM;cdecl;external libX11;
+function XSetICValues(para1:PXIC; dotdotdot:array of const):Pchar;cdecl;external libX11;
+function XGetICValues(para1:PXIC; dotdotdot:array of const):Pchar;cdecl;external libX11;
+function XIMOfIC(para1:PXIC):PXIM;cdecl;external libX11;
 function XFilterEvent(para1:PXEvent; para2:TWindow):TBoolResult;cdecl;external libX11;
 function XmbLookupString(para1:PXIC; para2:PXKeyPressedEvent; para3:Pchar; para4:cint; para5:PKeySym;
            para6:PStatus):cint;cdecl;external libX11;
diff --git a/rtl/COPYING.txt b/rtl/COPYING.txt
index 40ff392ab0..9a408cc725 100644
--- a/rtl/COPYING.txt
+++ b/rtl/COPYING.txt
@@ -485,7 +485,7 @@ convey the exclusion of warranty; and each file should have at least the
 
     You should have received a copy of the GNU Lesser General Public
     License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 Also add information on how to contact you by electronic and paper mail.
 
diff --git a/rtl/aix/signal.inc b/rtl/aix/signal.inc
index 965e5d0466..e0ad178593 100644
--- a/rtl/aix/signal.inc
+++ b/rtl/aix/signal.inc
@@ -50,7 +50,7 @@ const
   SIGSYS     = 12;      { bad argument to system call }
   SIGCLD     = SIGCHLD; { child status change }
   SIGURG     = 16;      { (+) urgent contition on I/O channel  }
-  SIGPOLL    = 23;      { pollable event occured }
+  SIGPOLL    = 23;      { pollable event occurred }
   SIGXCPU    = 24;      { exceeded cpu limit }
   SIGXFSZ    = 25;
   SIGMSG     = 27;
diff --git a/rtl/android/Makefile b/rtl/android/Makefile
index c3a98ae127..2103055f21 100644
--- a/rtl/android/Makefile
+++ b/rtl/android/Makefile
@@ -3628,9 +3628,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(INC)/getopts.pp
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lineinfo.pp
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 	$(COMPILER) $(INC)/lnfodwrf.pp
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(INC)/charset.pp
diff --git a/rtl/android/Makefile.fpc b/rtl/android/Makefile.fpc
index c30757bf89..042dac3c6a 100644
--- a/rtl/android/Makefile.fpc
+++ b/rtl/android/Makefile.fpc
@@ -238,10 +238,10 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
         $(COMPILER) $(INC)/lineinfo.pp
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
         $(COMPILER) $(INC)/lnfodwrf.pp
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
diff --git a/rtl/android/cwstring.pp b/rtl/android/cwstring.pp
index 5e93c07117..5743d0ba66 100644
--- a/rtl/android/cwstring.pp
+++ b/rtl/android/cwstring.pp
@@ -253,21 +253,7 @@ begin
     result:=Count1 - Count2;
 end;
 
-function CompareUnicodeString(const s1, s2 : UnicodeString) : PtrInt;
-begin
-  if hlibICU = 0 then begin
-    // fallback implementation
-    Result:=_CompareStr(s1, s2);
-    exit;
-  end;
-  InitThreadData;
-  if DefColl <> nil then
-    Result:=ucol_strcoll(DefColl, PUnicodeChar(s1), Length(s1), PUnicodeChar(s2), Length(s2))
-  else
-    Result:=u_strCompare(PUnicodeChar(s1), Length(s1), PUnicodeChar(s2), Length(s2), True);
-end;
-
-function CompareTextUnicodeString(const s1, s2 : UnicodeString): PtrInt;
+function CompareUnicodeString(const s1, s2 : UnicodeString; Options : TCompareOptions) : PtrInt;
 const
   U_COMPARE_CODE_POINT_ORDER = $8000;
 var
@@ -275,11 +261,20 @@ var
 begin
   if hlibICU = 0 then begin
     // fallback implementation
-    Result:=_CompareStr(UpperUnicodeString(s1), UpperUnicodeString(s2));
+    Result:=_CompareStr(s1, s2);
     exit;
   end;
-  err:=0;
-  Result:=u_strCaseCompare(PUnicodeChar(s1), Length(s1), PUnicodeChar(s2), Length(s2), U_COMPARE_CODE_POINT_ORDER, err);
+  if (coIgnoreCase in Options) then begin
+    err:=0;
+    Result:=u_strCaseCompare(PUnicodeChar(s1), Length(s1), PUnicodeChar(s2), Length(s2), U_COMPARE_CODE_POINT_ORDER, err);
+  end
+  else begin
+    InitThreadData;
+    if DefColl <> nil then
+      Result:=ucol_strcoll(DefColl, PUnicodeChar(s1), Length(s1), PUnicodeChar(s2), Length(s2))
+    else
+      Result:=u_strCompare(PUnicodeChar(s1), Length(s1), PUnicodeChar(s2), Length(s2), True);
+  end;
 end;
 
 function UpperAnsiString(const s : AnsiString) : AnsiString;
@@ -294,22 +289,22 @@ end;
 
 function CompareStrAnsiString(const s1, s2: ansistring): PtrInt;
 begin
-  Result:=CompareUnicodeString(UnicodeString(s1), UnicodeString(s2));
+  Result:=CompareUnicodeString(UnicodeString(s1), UnicodeString(s2), []);
 end;
 
 function StrCompAnsi(s1,s2 : PChar): PtrInt;
 begin
-  Result:=CompareUnicodeString(UnicodeString(s1), UnicodeString(s2));
+  Result:=CompareUnicodeString(UnicodeString(s1), UnicodeString(s2), []);
 end;
 
 function AnsiCompareText(const S1, S2: ansistring): PtrInt;
 begin
-  Result:=CompareTextUnicodeString(UnicodeString(s1), UnicodeString(s2));
+  Result:=CompareUnicodeString(UnicodeString(s1), UnicodeString(s2), [coIgnoreCase]);
 end;
 
 function AnsiStrIComp(S1, S2: PChar): PtrInt;
 begin
-  Result:=CompareTextUnicodeString(UnicodeString(s1), UnicodeString(s2));
+  Result:=CompareUnicodeString(UnicodeString(s1), UnicodeString(s2), [coIgnoreCase]);
 end;
 
 function AnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
@@ -318,7 +313,7 @@ var
 begin
   SetString(as1, S1, MaxLen);
   SetString(as2, S2, MaxLen);
-  Result:=CompareUnicodeString(UnicodeString(as1), UnicodeString(as2));
+  Result:=CompareUnicodeString(UnicodeString(as1), UnicodeString(as2), []);
 end;
 
 function AnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
@@ -327,7 +322,7 @@ var
 begin
   SetString(as1, S1, MaxLen);
   SetString(as2, S2, MaxLen);
-  Result:=CompareTextUnicodeString(UnicodeString(as1), UnicodeString(as2));
+  Result:=CompareUnicodeString(UnicodeString(as1), UnicodeString(as2), [coIgnoreCase]);
 end;
 
 function AnsiStrLower(Str: PChar): PChar;
@@ -418,14 +413,9 @@ begin
   Result:=LowerUnicodeString(s);
 end;
 
-function CompareWideString(const s1, s2 : WideString) : PtrInt;
-begin
-  Result:=CompareUnicodeString(s1, s2);
-end;
-
-function CompareTextWideString(const s1, s2 : WideString): PtrInt;
+function CompareWideString(const s1, s2 : WideString; Options : TCompareOptions) : PtrInt;
 begin
-  Result:=CompareTextUnicodeString(s1, s2);
+  Result:=CompareUnicodeString(s1, s2, Options);
 end;
 
 Procedure SetCWideStringManager;
@@ -440,7 +430,6 @@ begin
       UpperWideStringProc:=@UpperWideString;
       LowerWideStringProc:=@LowerWideString;
       CompareWideStringProc:=@CompareWideString;
-      CompareTextWideStringProc:=@CompareTextWideString;
 
       UpperAnsiStringProc:=@UpperAnsiString;
       LowerAnsiStringProc:=@LowerAnsiString;
@@ -458,7 +447,6 @@ begin
       UpperUnicodeStringProc:=@UpperUnicodeString;
       LowerUnicodeStringProc:=@LowerUnicodeString;
       CompareUnicodeStringProc:=@CompareUnicodeString;
-      CompareTextUnicodeStringProc:=@CompareTextUnicodeString;
 
       GetStandardCodePageProc:=@GetStandardCodePage;
       CodePointLengthProc:=@CodePointLength;
diff --git a/rtl/beos/sysos.inc b/rtl/beos/sysos.inc
index afb18f962c..98deb00f8b 100644
--- a/rtl/beos/sysos.inc
+++ b/rtl/beos/sysos.inc
@@ -80,7 +80,7 @@ end;
 
 {
   The lowlevel file functions should take care of setting the InOutRes to the
-  correct value if an error has occured, else leave it untouched
+  correct value if an error has occurred, else leave it untouched
 }
 
 Function PosixToRunError  (PosixErrno : longint) : longint;
diff --git a/rtl/bsd/sysctl.pp b/rtl/bsd/sysctl.pp
index 6eeddd327b..2480d93169 100644
--- a/rtl/bsd/sysctl.pp
+++ b/rtl/bsd/sysctl.pp
@@ -83,7 +83,7 @@ TYPE    CtlNameRec = Record
 {$ifdef FPC_USE_LIBC}
 function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint; cdecl; external name 'sysctl';
 function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint; cdecl; external name 'sysctlbyname';
-function FPsysctlnametomib (Name: pchar;mibp:pcint;sizep:psize_t):cint; cdecl; external name 'sysctltomib';
+function FPsysctlnametomib (Name: pchar;mibp:pcint;sizep:psize_t):cint; cdecl; external name 'sysctlnametomib';
 {$else}
 function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
 function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
diff --git a/rtl/bsd/sysos.inc b/rtl/bsd/sysos.inc
index 50ab2bbff7..a9f31d179c 100644
--- a/rtl/bsd/sysos.inc
+++ b/rtl/bsd/sysos.inc
@@ -100,7 +100,7 @@ end;
 
 {
   The lowlevel file functions should take care of setting the InOutRes to the
-  correct value if an error has occured, else leave it untouched
+  correct value if an error has occurred, else leave it untouched
 }
 
 Function PosixToRunError  (PosixErrno : longint) : longint;
diff --git a/rtl/darwin/Makefile b/rtl/darwin/Makefile
index 42deb4b1b0..35d93f7ea0 100644
--- a/rtl/darwin/Makefile
+++ b/rtl/darwin/Makefile
@@ -2852,8 +2852,8 @@ mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp sysutils$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT) sysutils$(PPUEXT)
 lnfogdb$(PPUEXT) : $(UNIXINC)/lnfogdb.pp $(SYSTEMUNIT)$(PPUEXT) ctypes$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT)
 charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
 cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
diff --git a/rtl/darwin/Makefile.fpc b/rtl/darwin/Makefile.fpc
index fef43cf2f9..e4d8e2a4a0 100644
--- a/rtl/darwin/Makefile.fpc
+++ b/rtl/darwin/Makefile.fpc
@@ -130,6 +130,7 @@ fpintres$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT)
 fpextres$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) baseunix$(PPUEXT)
 
 iso7185$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
 
 objpas$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
@@ -240,9 +241,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp sysutils$(PPUEXT)
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT) sysutils$(PPUEXT)
 
 lnfogdb$(PPUEXT) : $(UNIXINC)/lnfogdb.pp $(SYSTEMUNIT)$(PPUEXT) ctypes$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT)
 
diff --git a/rtl/dragonfly/Makefile b/rtl/dragonfly/Makefile
index cf0a2189aa..b9c02dada5 100644
--- a/rtl/dragonfly/Makefile
+++ b/rtl/dragonfly/Makefile
@@ -3111,6 +3111,8 @@ character$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/character.pas objpas$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/character.pas
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(INC)/iso7185.pp
 x86$(PPUEXT) : $(UNIXINC)/x86.pp $(SYSTEMUNIT)$(PPUEXT)
 ifeq ($(ARCH),x86_64)
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
@@ -3121,8 +3123,8 @@ mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
 	$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
diff --git a/rtl/dragonfly/Makefile.fpc b/rtl/dragonfly/Makefile.fpc
index 13bf5dd85d..047daf384f 100644
--- a/rtl/dragonfly/Makefile.fpc
+++ b/rtl/dragonfly/Makefile.fpc
@@ -211,6 +211,13 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
         $(COMPILER) $(INC)/macpas.pp $(REDIR)
 
 #
+# ISO-Pascal Model
+#
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
+
+#
 # Other system-independent RTL Units
 #
 
@@ -229,9 +236,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 
diff --git a/rtl/freebsd/Makefile b/rtl/freebsd/Makefile
index 313dbaeaf0..bf8279423c 100644
--- a/rtl/freebsd/Makefile
+++ b/rtl/freebsd/Makefile
@@ -3072,26 +3072,37 @@ dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp unxconst.inc $(SYSDEPS)
 	$(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
-uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
+uuchar$(PPUEXT): $(INC)/uuchar.pp $(SYSTEMUNIT)$(PPUEXT) 
+	$(COMPILER) $<
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
 		   $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+fpintres$(PPUEXT): $(INC)/fpintres.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 unixtype$(PPUEXT): $(UNIXINC)/unixtype.pp $(UNIXINC)/ctypes.inc ptypes.inc $(SYSTEMUNIT)$(PPUEXT)
-baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+	$(COMPILER) $<
+baseunix$(PPUEXT) : $(UNIXINC)/baseunix.pp errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
   signal.inc $(UNIXINC)/bunxh.inc \
   $(BSDINC)/bunxsysc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
   $(BSDINC)/ostypes.inc $(BSDINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
   $(UNIXINC)/genfuncs.inc sysctl$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
 		 unxconst.inc $(UNIXINC)/timezone.inc \
 		 unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixcp.pp
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
 	       unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 		    objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
@@ -3114,28 +3125,56 @@ character$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/character.pas objpas$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/character.pas
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(INC)/iso7185.pp
 x86$(PPUEXT) : $(UNIXINC)/x86.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+ports$(PPUEXT) : $(UNIXINC)/ports.pp x86$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 ifeq ($(ARCH),x86_64)
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+	$(COMPILER) $<
 else
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 endif
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+	$(COMPILER) $<
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
+	$(COMPILER) $<
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
 	$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
 fpwidestring$(PPUEXT): $(OBJPASDIR)/fpwidestring.pp character$(PPUEXT) unixcp$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/fpwidestring.pp
 errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+syscall$(PPUEXT) : $(UNIXINC)/syscall.pp baseunix$(PPUEXT) unixtype$(PPUEXT)
+	$(COMPILER) $<
 sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT) syscall$(PPUEXT)
+	$(COMPILER) $<
 cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+	$(COMPILER) $<
+dl$(PPUEXT) : $(UNIXINC)/dl.pp ctypes$(PPUEXT) objpas$(PPUEXT)
+	$(COMPILER) $<
 ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT) dynlibs$(PPUEXT)
+	$(COMPILER) $<
+bsd$(PPUEXT) : $(BSDINC)/bsd.pas unix$(PPUEXT) syscall$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+initc$(PPUEXT) : $(UNIXINC)/initc.pp ctypes$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
diff --git a/rtl/freebsd/Makefile.fpc b/rtl/freebsd/Makefile.fpc
index 5c61a5a1f5..5c5b479aa4 100644
--- a/rtl/freebsd/Makefile.fpc
+++ b/rtl/freebsd/Makefile.fpc
@@ -23,7 +23,7 @@ units=$(SYSTEMUNIT) uuchar unixtype ctypes objpas macpas iso7185 \
 implicitunits=exeinfo \
       cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
       cp437 cp646 cp850 cp856 cp866 cp874 cp8859_1 cp8859_5 cp8859_2 cp852 \
-      unicodedata unicodenumtable 
+      unicodedata unicodenumtable
 
 rsts=math typinfo classes sysconst
 
@@ -81,7 +81,6 @@ ifeq ($(ARCH),x86_64)
 CPU_UNITS=x86 ports cpu
 endif
 
-
 # Use new feature from 1.0.5 version
 # that generates release PPU files
 # which will not be recompiled
@@ -133,7 +132,8 @@ dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp unxconst.inc $(SYSDEPS)
         $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
 
-uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
+uuchar$(PPUEXT): $(INC)/uuchar.pp $(SYSTEMUNIT)$(PPUEXT) 
+        $(COMPILER) $<
 
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
@@ -142,36 +142,46 @@ objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
                    $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
+fpintres$(PPUEXT): $(INC)/fpintres.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 #
 # System Dependent Units
 #
 
 unixtype$(PPUEXT): $(UNIXINC)/unixtype.pp $(UNIXINC)/ctypes.inc ptypes.inc $(SYSTEMUNIT)$(PPUEXT)
-
-baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
+        $(COMPILER) $<
+		
+baseunix$(PPUEXT) : $(UNIXINC)/baseunix.pp errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
   signal.inc $(UNIXINC)/bunxh.inc \
   $(BSDINC)/bunxsysc.inc $(BSDPROCINC)/syscallh.inc sysnr.inc \
   $(BSDINC)/ostypes.inc $(BSDINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
   $(UNIXINC)/genfuncs.inc sysctl$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 
 unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
                  unxconst.inc $(UNIXINC)/timezone.inc \
                  unxfunc.inc baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 unixcp$(PPUEXT) : $(UNIXINC)/unixcp.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) baseunix$(PPUEXT)
         $(COMPILER) $(UNIXINC)/unixcp.pp
-        
+
+unixutil$(PPUEXT) : $(UNIXINC)/unixutil.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
+
 #
 # TP7 Compatible RTL Units
 #
 
 dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
                unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-
+        $(COMPILER) $<
 
 #
 # Delphi Compatible Units
@@ -215,29 +225,46 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
         $(COMPILER) $(INC)/macpas.pp $(REDIR)
 
 #
+# ISO-Pascal Model
+#
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
+
 # Other system-independent RTL Units
 #
 
 x86$(PPUEXT) : $(UNIXINC)/x86.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
+
+ports$(PPUEXT) : $(UNIXINC)/ports.pp x86$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 ifeq ($(ARCH),x86_64)
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $<
 else
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 endif
 
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $<
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
+        $(COMPILER) $<
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
         $(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
@@ -250,18 +277,37 @@ fpwidestring$(PPUEXT): $(OBJPASDIR)/fpwidestring.pp character$(PPUEXT) unixcp$(P
 
 
 errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
+
+syscall$(PPUEXT) : $(UNIXINC)/syscall.pp baseunix$(PPUEXT) unixtype$(PPUEXT)
+        $(COMPILER) $<
 
 sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT) syscall$(PPUEXT)
+        $(COMPILER) $<
 
 cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+        $(COMPILER) $<
+		
+dl$(PPUEXT) : $(UNIXINC)/dl.pp ctypes$(PPUEXT) objpas$(PPUEXT)
+        $(COMPILER) $<
 
 ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT) dynlibs$(PPUEXT)
+        $(COMPILER) $<
+
+bsd$(PPUEXT) : $(BSDINC)/bsd.pas unix$(PPUEXT) syscall$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
+initc$(PPUEXT) : $(UNIXINC)/initc.pp ctypes$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
diff --git a/rtl/freebsd/i386/identpatch.sh b/rtl/freebsd/i386/identpatch.sh
index f7fd890349..dc2cb0aef9 100644
--- a/rtl/freebsd/i386/identpatch.sh
+++ b/rtl/freebsd/i386/identpatch.sh
@@ -1,12 +1,18 @@
 #!/bin/sh
+if [ "$#" -ne 1 ]
+then
 elfdump -n `which elfdump` |awk '/FreeBSD/{print $2}' >elfversion
 IDVERSION=`cat elfversion`
 rm elfversion
+else
+IDVERSION=$1
+fi
 echo Patching cprt0.as with version $IDVERSION
 
 sed -I.sav -es/900044/$IDVERSION/ cprt0.as
 sed -I.sav -es/900044/$IDVERSION/ dllprt0.as
 sed -I.sav -es/900044/$IDVERSION/ prt0.as
+sed -I.sav -es/900044/$IDVERSION/ gprt0.as
 sed -I.sav -es/900044/$IDVERSION/ si_c.inc
 sed -I.sav -es/900044/$IDVERSION/ si_prc.inc
 
diff --git a/rtl/gba/rtl.cfg b/rtl/gba/rtl.cfg
new file mode 100644
index 0000000000..d41af3d63c
--- /dev/null
+++ b/rtl/gba/rtl.cfg
@@ -0,0 +1,27 @@
+ -Sf-
+ -SfHEAP
+ -SfINITFINAL
+ -SfCLASSES
+ -SfEXCEPTIONS
+ -SfEXITCODE
+ -SfANSISTRINGS
+ -SfWIDESTRINGS
+ -SfTEXTIO
+# -SfCONSOLEIO
+ -SfFILEIO
+ -SfRANDOM
+ -SfVARIANTS
+ -SfOBJECTS
+ -SfRESOURCES
+ -SfDYNARRAYS
+ -SfTHREADING
+ -SfCOMMANDARGS
+ -SfPROCESSES
+ -SfSTACKCHECK
+# -SfDYNLIBS
+ -SfEXITCODE
+
+#ifdef CPUARM
+-SfSOFTFPU
+-SfRTTI
+#endif CPUARM
\ No newline at end of file
diff --git a/rtl/go32v2/dpmiexcp.pp b/rtl/go32v2/dpmiexcp.pp
index 51c1eeb35b..f8c8447957 100644
--- a/rtl/go32v2/dpmiexcp.pp
+++ b/rtl/go32v2/dpmiexcp.pp
@@ -1004,7 +1004,7 @@ begin
     show_call_frame(djgpp_exception_state_ptr)
 {$ifdef DPMIEXCP_DEBUG}
   else
-    errln('Exception occured in another context');
+    errln('Exception occurred in another context');
 {$endif def DPMIEXCP_DEBUG}
    ;
   if assigned(djgpp_exception_state_ptr^.__exception_ptr) then
@@ -1016,7 +1016,7 @@ begin
 {$ifdef DPMIEXCP_DEBUG}
   else
     begin
-       errln('First exception occured in another context');
+       errln('First exception occurred in another context');
        djgpp_exception_state_ptr:=djgpp_exception_state_ptr^.__exception_ptr;
        do_faulting_finish_message(false);
     end;
diff --git a/rtl/go32v2/go32.pp b/rtl/go32v2/go32.pp
index 571b8cf2c1..a56d2b5661 100644
--- a/rtl/go32v2/go32.pp
+++ b/rtl/go32v2/go32.pp
@@ -89,16 +89,16 @@ interface
     function segment_to_descriptor(seg : word) : word;
     function get_next_selector_increment_value : word;
     function get_segment_base_address(d : word) : longint;
-    function set_segment_base_address(d : word;s : longint) : boolean;
-    function set_segment_limit(d : word;s : longint) : boolean;
-    function set_descriptor_access_right(d : word;w : word) : longint;
+    function set_segment_base_address(d : word;s : dword) : boolean;
+    function set_segment_limit(d : word;s : dword): boolean;
+    function set_descriptor_access_right(d : word;w : word) : boolean;
     function create_code_segment_alias_descriptor(seg : word) : word;
-    function get_linear_addr(phys_addr : longint;size : longint) : longint;
+    function get_linear_addr(phys_addr : dword;size : longint) : dword;
     function free_linear_addr_mapping(linear_addr: dword): boolean;
-    function get_segment_limit(d : word) : longint;
+    function get_segment_limit(d : word) : dword;
     function get_descriptor_access_right(d : word) : longint;
     function get_page_size:longint;
-    function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+    function map_device_in_memory_block(handle,offset,pagecount,device:dword):boolean;
     function get_page_attributes(handle, offset, pagecount: dword; buf: pointer): boolean;
     function set_page_attributes(handle, offset, pagecount: dword; buf: pointer): boolean;
     function realintr(intnr : word;var regs : trealregs) : boolean;
@@ -969,7 +969,7 @@ interface
          unlock_code:=unlock_linear_region(linearaddr,size);
       end;
 
-    function set_segment_base_address(d : word;s : longint) : boolean;
+    function set_segment_base_address(d : word;s : dword) : boolean;
 
       begin
          asm
@@ -987,7 +987,7 @@ interface
          end;
       end;
 
-    function set_descriptor_access_right(d : word;w : word) : longint;
+    function set_descriptor_access_right(d : word;w : word) : boolean;
 
       begin
          asm
@@ -998,12 +998,12 @@ interface
             int $0x31
             pushf
             call test_int31
-            movw %ax,__RESULT
+            movb %al,__RESULT
             popl %ebx
          end;
       end;
 
-    function set_segment_limit(d : word;s : longint) : boolean;
+    function set_segment_limit(d : word;s : dword) : boolean;
 
       begin
          asm
@@ -1033,7 +1033,7 @@ interface
             movl %eax,__RESULT
          end;
       end;
-    function get_segment_limit(d : word) : longint;
+    function get_segment_limit(d : word) : dword;
 
       begin
          asm
@@ -1076,7 +1076,7 @@ interface
          end;
       end;
 
-    function get_linear_addr(phys_addr : longint;size : longint) : longint;
+    function get_linear_addr(phys_addr : dword;size : longint) : dword;
 
       begin
          asm
@@ -1143,7 +1143,7 @@ interface
          get_run_mode:=_run_mode;
       end;
 
-    function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+    function map_device_in_memory_block(handle,offset,pagecount,device:dword):boolean;
       begin
          asm
            pushl %ebx
diff --git a/rtl/haiku/sysheap.inc b/rtl/haiku/sysheap.inc
deleted file mode 100644
index 8672f53931..0000000000
--- a/rtl/haiku/sysheap.inc
+++ /dev/null
@@ -1,36 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by Free Pascal development team
-
-    This file implements all the base types and limits required
-    for a minimal POSIX compliant subset required to port the compiler
-    to a new OS.
-
-    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.
-
- **********************************************************************}
-function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
-
-function SysOSAlloc(size: ptruint): pointer;
-begin
-{  result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);}
-  result := sbrk2(size);
-  if result=pointer(-1) then
-    result:=nil
-  else
-    seterrno(0);
-end;
-
-{ $ define HAS_SYSOSFREE}
-
-procedure SysOSFree(p: pointer; size: ptruint);
-begin
-  //  fpmunmap(p, size);
-end;
-
-
diff --git a/rtl/haiku/sysos.inc b/rtl/haiku/sysos.inc
index 71069f6b27..8e34872080 100644
--- a/rtl/haiku/sysos.inc
+++ b/rtl/haiku/sysos.inc
@@ -80,7 +80,7 @@ end;
 
 {
   The lowlevel file functions should take care of setting the InOutRes to the
-  correct value if an error has occured, else leave it untouched
+  correct value if an error has occurred, else leave it untouched
 }
 
 Function PosixToRunError  (PosixErrno : longint) : longint;
diff --git a/rtl/i386/int64p.inc b/rtl/i386/int64p.inc
index 1935c4713a..e38927c4f3 100644
--- a/rtl/i386/int64p.inc
+++ b/rtl/i386/int64p.inc
@@ -197,7 +197,7 @@
             andl %eax,%edx
             andl 4(%esp),%eax
             addl %ebx,%eax
-            addl %ecx,%edx
+            adcl %ecx,%edx
             addl $16,%esp
 
 .Lmake_sign:
diff --git a/rtl/inc/exeinfo.pp b/rtl/inc/exeinfo.pp
index 47118932f2..7810260910 100644
--- a/rtl/inc/exeinfo.pp
+++ b/rtl/inc/exeinfo.pp
@@ -16,6 +16,13 @@
   This unit should not be compiled in objfpc mode, since this would make it
   dependent on objpas unit.
 }
+
+{ Disable checks of pointers explictly,
+  as we are dealing here with special pointer that
+  might be seen as invalid by heaptrc unit CheckPointer function }
+
+{$checkpointer off}
+
 unit exeinfo;
 interface
 
@@ -112,8 +119,10 @@ uses
 {$if defined(freebsd) or defined(netbsd) or defined (openbsd) or defined(linux) or defined(sunos) or defined(android) or defined(dragonfly)}
   {$ifdef cpu64}
     {$define ELF64}
+    {$define FIND_BASEADDR_ELF}
   {$else}
     {$define ELF32}
+    {$define FIND_BASEADDR_ELF}
   {$endif}
 {$endif}
 
@@ -789,6 +798,119 @@ type
 
 
 {$if defined(ELF32) or defined(ELF64) or defined(BEOS)}
+
+{$ifdef FIND_BASEADDR_ELF}
+{$ifndef SOLARIS}
+  { Solaris has envp variable in system unit interface,
+    so we directly use system envp variable in that case }
+var
+  envp : ppchar external name 'operatingsystem_parameter_envp';
+{$endif not SOLARIS}
+var
+  LocalJmpBuf : Jmp_Buf;  
+procedure LocalError;
+begin
+  Longjmp(LocalJmpBuf,1);
+end;
+
+procedure GetExeInMemoryBaseAddr(addr : pointer; var BaseAddr : pointer;
+                                 var filename : openstring);
+type
+  AT_HDR = record
+    typ : ptruint;
+    value : ptruint;
+  end;
+  P_AT_HDR = ^AT_HDR;
+
+{ Values taken from /usr/include/linux/auxvec.h }
+const
+  AT_HDR_COUNT = 5;{ AT_PHNUM }
+  AT_HDR_SIZE = 4; { AT_PHENT }
+  AT_HDR_Addr = 3; { AT_PHDR }
+  AT_EXE_FN = 31;  {AT_EXECFN }
+
+var
+  pc : ppchar;
+  pat_hdr : P_AT_HDR;
+  i, phdr_count : ptrint;
+  phdr_size : ptruint;
+  phdr :  ^telfproghdr;
+  found_addr : ptruint;
+  SavedExitProc : pointer;
+begin
+  filename:=ParamStr(0);
+  SavedExitProc:=ExitProc;
+  ExitProc:=@LocalError;
+  if SetJmp(LocalJmpBuf)=0 then
+  begin
+  { Try, avoided in order to remove exception installation }
+    pc:=envp;
+    phdr_count:=-1;
+    phdr_size:=0;
+    phdr:=nil;
+    found_addr:=ptruint(-1);
+    while (assigned(pc^)) do
+      inc (pointer(pc), sizeof(ptruint));
+    inc(pointer(pc), sizeof(ptruint));
+    pat_hdr:=P_AT_HDR(pc);
+    while assigned(pat_hdr) do
+      begin
+        if (pat_hdr^.typ=0) and (pat_hdr^.value=0) then
+          break;
+        if pat_hdr^.typ = AT_HDR_COUNT then
+          phdr_count:=pat_hdr^.value;
+        if pat_hdr^.typ = AT_HDR_SIZE then
+          phdr_size:=pat_hdr^.value;
+        if pat_hdr^.typ = AT_HDR_Addr then
+          phdr := pointer(pat_hdr^.value);
+        if pat_hdr^.typ = AT_EXE_FN then
+          filename:=strpas(pchar(pat_hdr^.value));
+        inc (pointer(pat_hdr),sizeof(AT_HDR));
+      end;
+    if (phdr_count>0) and (phdr_size = sizeof (telfproghdr))
+       and  assigned(phdr) then
+      begin
+        for i:=0 to phdr_count -1 do
+          begin
+            if (phdr^.p_type = 1 {PT_LOAD}) and (ptruint(phdr^.p_vaddr) < found_addr) then
+              found_addr:=phdr^.p_vaddr;
+            inc(pointer(phdr), phdr_size);
+          end;
+      {$ifdef DEBUG}
+      end
+    else
+      begin
+        if (phdr_count=-1) then
+           writeln(stderr,'AUX entry AT_PHNUM not found');
+        if (phdr_size=0) then
+           writeln(stderr,'AUX entry AT_PHENT not found');
+        if (phdr=nil) then
+           writeln(stderr,'AUX entry AT_PHDR not found');
+      {$endif DEBUG}
+      end;
+
+     if found_addr<>ptruint(-1) then
+       begin
+          {$ifdef DEBUG}
+          Writeln(stderr,'Found addr = $',hexstr(found_addr,2 * sizeof(ptruint)));
+          {$endif}
+          BaseAddr:=pointer(found_addr);
+       end
+  {$ifdef DEBUG}
+     else
+    writeln(stderr,'Error parsing stack');
+  {$endif DEBUG}
+  end
+  else
+  begin
+  {$ifdef DEBUG}
+    writeln(stderr,'Exception parsing stack');
+  {$endif DEBUG}
+  end;
+  ExitProc:=SavedExitProc;
+end;
+{$endif FIND_BASEADDR_ELF}
+
 function OpenElf(var e:TExeFile):boolean;
 var
   elfheader : telfheader;
@@ -1236,4 +1358,8 @@ begin
 end;
 
 
+begin
+{$ifdef FIND_BASEADDR_ELF}
+  UnixGetModuleByAddrHook:=@GetExeInMemoryBaseAddr;
+{$endif FIND_BASEADDR_ELF}
 end.
diff --git a/rtl/inc/flt_conv.inc b/rtl/inc/flt_conv.inc
index e5a674ad11..7d69427f09 100644
--- a/rtl/inc/flt_conv.inc
+++ b/rtl/inc/flt_conv.inc
@@ -27,7 +27,7 @@
 
     You should have received a copy of the GNU Library General Public License
     along with this library; if not, write to the Free Software Foundation,
-    Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+    Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
  ****************************************************************************
 }
diff --git a/rtl/inc/flt_core.inc b/rtl/inc/flt_core.inc
index 5837155d66..eae3950f96 100644
--- a/rtl/inc/flt_core.inc
+++ b/rtl/inc/flt_core.inc
@@ -29,7 +29,7 @@
 
     You should have received a copy of the GNU Library General Public License
     along with this library; if not, write to the Free Software Foundation,
-    Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+    Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
  ****************************************************************************
 }
diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp
index d03dec372e..9941c8974d 100644
--- a/rtl/inc/heaptrc.pp
+++ b/rtl/inc/heaptrc.pp
@@ -86,7 +86,7 @@ const
   printleakedblock: boolean = false;
   printfaultyblock: boolean = false;
   maxprintedblocklength: integer = 128;
-  
+
   GlobalSkipIfNoLeaks : Boolean = False;
 
 implementation
@@ -513,7 +513,7 @@ begin
   { clear the memory }
   fillchar(p^,size,#255);
   { retrieve backtrace info }
-  CaptureBacktrace(1,tracesize-1,@pp^.calls[1]);
+  CaptureBacktrace(1,tracesize,@pp^.calls[1]);
 
   { insert in the linked list }
   if loc_info^.heap_mem_root<>nil then
@@ -869,7 +869,7 @@ begin
   inc(loc_info^.getmem_size,size);
   inc(loc_info^.getmem8_size,(size+7) and not 7);
   { generate new backtrace }
-  CaptureBacktrace(1,tracesize-1,@pp^.calls[1]);
+  CaptureBacktrace(1,tracesize,@pp^.calls[1]);
   { regenerate signature }
   if usecrc then
     pp^.sig:=calculate_sig(pp);
@@ -1129,7 +1129,7 @@ begin
   else
     ptext:=textoutput;
   pp:=loc_info^.heap_mem_root;
-  if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then 
+  if ((loc_info^.getmem_size-loc_info^.freemem_size)=0) and SkipIfNoLeaks then
     exit;
   Writeln(ptext^,'Heap dump by heaptrc unit');
   Writeln(ptext^,loc_info^.getmem_cnt, ' memory blocks allocated : ',
diff --git a/rtl/inc/lineinfo.pp b/rtl/inc/lineinfo.pp
index 830e8c832b..fc3d90c2a0 100644
--- a/rtl/inc/lineinfo.pp
+++ b/rtl/inc/lineinfo.pp
@@ -71,7 +71,7 @@ type
   end;
 
 { We use static variable so almost no stack is required, and is thus
-  more safe when an error has occured in the program }
+  more safe when an error has occurred in the program }
 {$WARNING This code is not thread-safe, and needs improvement }  
 var
   e          : TExeFile;
diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc
index 4af69c8c49..bf1b049e71 100644
--- a/rtl/inc/objpash.inc
+++ b/rtl/inc/objpash.inc
@@ -180,6 +180,7 @@
          Entries    : array[0..0] of tinterfaceentry;
        end;
 
+       PMethod = ^TMethod;
        TMethod = record
          Code : CodePointer;
          Data : Pointer;
diff --git a/rtl/inc/system.fpd b/rtl/inc/system.fpd
index b865c28c67..9f0de7c413 100644
--- a/rtl/inc/system.fpd
+++ b/rtl/inc/system.fpd
@@ -61,10 +61,18 @@ Function SizeOf (X : TAnyType) : Longint;
 Procedure Str (Var X : TNumericType; Var S : String);
 Function Succ (X : TOrdinal) : TOrdinal;
 Procedure Val (const S : string;Var V;var Code : word);
-Procedure Write (Args : Arguments);
-Procedure Writeln (Args : Arguments);
-Procedure Write (Var F : Text; Args : Arguments);
-Procedure WriteLn (Var F : Text; Args : Arguments);
+Procedure Write (V1);
+Procedure Write (V1,V2);
+Procedure Write (V1,V2,v3);
+Procedure WriteLn (V1);
+Procedure WriteLn (V1,V2);
+Procedure WriteLn (V1,V2,v3);
+Procedure Write (var F : Text; V1);
+Procedure Write (var F : Text; V1,V2);
+Procedure Write (var F : Text; V1,V2,v3);
+Procedure WriteLn (var F : Text; V1);
+Procedure WriteLn (var F : Text; V1,V2);
+Procedure WriteLn (var F : Text; V1,V2,v3);
 Function Copy(S : AStringType; Index,Count : SizeInt) : String;
 Function Copy(A : DynArrayType; Index,Count : SizeInt) : DynArray;
 Procedure SetLength(Var S : AStringType; Len : SizeInt);
diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
index 7f6fd6ff99..5f4a45447a 100644
--- a/rtl/inc/system.inc
+++ b/rtl/inc/system.inc
@@ -1215,7 +1215,7 @@ Begin
      End;
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
    except
-     { prevent endless dump if an exception occured }
+     { prevent endless dump if an exception occurred }
    end;
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 End;
diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc
index 4714e35a96..20c8224a5b 100644
--- a/rtl/inc/text.inc
+++ b/rtl/inc/text.inc
@@ -210,7 +210,7 @@ Begin
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 {$endif FPC_HAS_CPSTRING}
   FileFunc(TextRec(t).OpenFunc)(TextRec(t));
-  { reset the mode to closed when an error has occured }
+  { reset the mode to closed when an error has occurred }
   if InOutRes<>0 then
    TextRec(t).mode:=fmClosed;
 End;
diff --git a/rtl/java/jsystem.inc b/rtl/java/jsystem.inc
index ec7df434fa..c04ba0356c 100644
--- a/rtl/java/jsystem.inc
+++ b/rtl/java/jsystem.inc
@@ -527,8 +527,8 @@ function aligntoptr(p : pointer) : pointer;inline;
    See the GNU Library General Public License for more details.
    You should have received a copy of the GNU Library General
    Public License along with this library; if not, write to the
-   Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307  USA
+   Free Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301  USA
 
    Copyright (C) 1997, 1999 Makoto Matsumoto and Takuji Nishimura.
    When you use this, send an email to: matumoto@math.keio.ac.jp
@@ -1239,7 +1239,7 @@ Begin
      End;
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
    except
-     { prevent endless dump if an exception occured }
+     { prevent endless dump if an exception occurred }
    end;
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 End;
diff --git a/rtl/linux/Makefile b/rtl/linux/Makefile
index 6c8303cd92..da2f345d44 100644
--- a/rtl/linux/Makefile
+++ b/rtl/linux/Makefile
@@ -3713,9 +3713,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(INC)/getopts.pp
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lineinfo.pp
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lnfodwrf.pp
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 	$(COMPILER) $(INC)/charset.pp
diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc
index 1a0aced78d..0ff549cc57 100644
--- a/rtl/linux/Makefile.fpc
+++ b/rtl/linux/Makefile.fpc
@@ -364,10 +364,10 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lineinfo.pp
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) $(INC)/exeinfo.pp lineinfo$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lnfodwrf.pp
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
diff --git a/rtl/linux/arm/ucprt0.as b/rtl/linux/arm/ucprt0.as
index f630d06fc7..0777096ada 100644
--- a/rtl/linux/arm/ucprt0.as
+++ b/rtl/linux/arm/ucprt0.as
@@ -31,8 +31,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 
 /* This is the canonical entry point, usually the first thing in the text
    segment.
diff --git a/rtl/linux/mips/cprt0.as b/rtl/linux/mips/cprt0.as
index 750090c7aa..c6a0cddf9d 100644
--- a/rtl/linux/mips/cprt0.as
+++ b/rtl/linux/mips/cprt0.as
@@ -32,8 +32,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 
 /* This is the canonical entry point, usually the first thing in the text
    segment.  The SVR4/Mips ABI (pages 3-31, 3-32) says that when the entry
diff --git a/rtl/linux/ossysc.inc b/rtl/linux/ossysc.inc
index fb5dcbf325..52f80bea81 100644
--- a/rtl/linux/ossysc.inc
+++ b/rtl/linux/ossysc.inc
@@ -166,7 +166,7 @@ end;
 function Fpopendir(dirname : pchar): pdir;  [public, alias : 'FPC_SYSC_OPENDIR'];
 
 var
-  fd:integer;
+  fd:cint;
   st:stat;
   ptr:pdir;
 
diff --git a/rtl/linux/ostypes.inc b/rtl/linux/ostypes.inc
index 907f12a34a..61242b756d 100644
--- a/rtl/linux/ostypes.inc
+++ b/rtl/linux/ostypes.inc
@@ -121,9 +121,9 @@ type
            { Still old one. This is a userland struct}
 
    Dir       = record
-                dd_fd     : integer;
+                dd_fd     : longint;
                 dd_loc    : longint;
-                dd_size   : integer;
+                dd_size   : longint;
                 dd_buf    : pdirent;
                 {The following are used in libc, but NOT in the linux kernel sources ??}
                 dd_nextoff: cardinal;
diff --git a/rtl/linux/powerpc/cprt0.as b/rtl/linux/powerpc/cprt0.as
index e237d8d1bc..d4637923c8 100644
--- a/rtl/linux/powerpc/cprt0.as
+++ b/rtl/linux/powerpc/cprt0.as
@@ -25,8 +25,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.
 */
 
 /* These are the various addresses we require.  */
diff --git a/rtl/linux/powerpc64/cprt0.as b/rtl/linux/powerpc64/cprt0.as
index 3e46ccdff0..2b8309d4bf 100644
--- a/rtl/linux/powerpc64/cprt0.as
+++ b/rtl/linux/powerpc64/cprt0.as
@@ -25,8 +25,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 
 /* some macros which simplify the startup code */
 
diff --git a/rtl/linux/powerpc64/gprt0.as b/rtl/linux/powerpc64/gprt0.as
index 6880cdfbbb..de31b6b08d 100644
--- a/rtl/linux/powerpc64/gprt0.as
+++ b/rtl/linux/powerpc64/gprt0.as
@@ -25,8 +25,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 
 /* some macros which simplify the startup code */
 
diff --git a/rtl/linux/sysos.inc b/rtl/linux/sysos.inc
index 47c8e4124d..1a130c57bf 100644
--- a/rtl/linux/sysos.inc
+++ b/rtl/linux/sysos.inc
@@ -78,7 +78,7 @@ end;
 
 {
   The lowlevel file functions should take care of setting the InOutRes to the
-  correct value if an error has occured, else leave it untouched
+  correct value if an error has occurred, else leave it untouched
 }
 
 function PosixToRunError  (PosixErrno : longint):word;
diff --git a/rtl/nds/rtl.cfg b/rtl/nds/rtl.cfg
index df4fd90cbb..65cb732ac7 100644
--- a/rtl/nds/rtl.cfg
+++ b/rtl/nds/rtl.cfg
@@ -1,4 +1,3 @@
- -Sf-
  -SfHEAP
  -SfINITFINAL
  -SfCLASSES
diff --git a/rtl/netbsd/Makefile b/rtl/netbsd/Makefile
index adf5e03270..7b5a5b3835 100644
--- a/rtl/netbsd/Makefile
+++ b/rtl/netbsd/Makefile
@@ -3069,7 +3069,8 @@ dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
 	$(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
-uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
+uuchar$(PPUEXT):  $(INC)/uuchar.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
@@ -3110,6 +3111,8 @@ character$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/character.pas objpas$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/character.pas
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(INC)/iso7185.pp
 ifeq ($(ARCH),x86_64)
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 else
@@ -3119,8 +3122,8 @@ mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
 	$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
diff --git a/rtl/netbsd/Makefile.fpc b/rtl/netbsd/Makefile.fpc
index a0988efe00..64bb16364a 100644
--- a/rtl/netbsd/Makefile.fpc
+++ b/rtl/netbsd/Makefile.fpc
@@ -133,7 +133,8 @@ dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(BSDINC)/$(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
         $(COMPILER) -Us -Sg $(BSDINC)/$(SYSTEMUNIT).pp
 
-uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
+uuchar$(PPUEXT):  $(INC)/uuchar.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $<
 
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
@@ -219,6 +220,13 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
         $(COMPILER) $(INC)/macpas.pp $(REDIR)
 
 #
+# ISO-Pascal Model
+#
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
+
+#
 # Other system-independent RTL Units
 #
 
@@ -235,9 +243,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 
diff --git a/rtl/netware/nwcalls.pp b/rtl/netware/nwcalls.pp
index 60a15b48fa..28d7c736de 100644
--- a/rtl/netware/nwcalls.pp
+++ b/rtl/netware/nwcalls.pp
@@ -2314,7 +2314,7 @@ const
   TABLE_FULL = $8851; { 81 - Attempted to add a name into the name table after it was full }
   SOCKET_NOT_OPEN = $8852; { 82 - Listen was posted on unopened socket }
   MEM_MGR_ERROR = $8853; { 83 - Attempted enhanced memory operation failed }
-  SFT3_ERROR = $8854; { 84 - An SFT3 switch occured mid-transfer }
+  SFT3_ERROR = $8854; { 84 - An SFT3 switch occurred mid-transfer }
   PREFERRED_NOT_FOUND = $8855; { 85 - the preferred directory server was not established but another directory server was returned }
   DEVICE_NOT_RECOGNIZED = $8856; { 86 - used to determine if the device is not used by VISE so pass it on to the next redirector, if any. }
   BAD_NET_TYPE = $8857; { 87 - the network type (Bind/NDS) does not match the server version }
@@ -2621,7 +2621,7 @@ const
   NWE_NAME_TABLE_FULL = $8851; { 81 - Attempted to add a name into the name table after it was full }
   NWE_SOCKET_NOT_OPEN = $8852; { 82 - Listen was posted on unopened socket }
   NWE_MEMORY_MGR_ERROR = $8853; { 83 - Attempted enhanced memory operation failed }
-  NWE_SFT3_ERROR = $8854; { 84 - An SFT3 switch occured mid-transfer }
+  NWE_SFT3_ERROR = $8854; { 84 - An SFT3 switch occurred mid-transfer }
   NWE_DS_PREFERRED_NOT_FOUND = $8855; { 85 - the preferred directory server was not established but another directory server was returned }
   NWE_DEVICE_NOT_RECOGNIZED = $8856; { 86 - used to determine if the device is not used by VISE so pass it on to the next redirector, if any. }
   NWE_NET_INVALID_TYPE = $8857; { 87 - the network type (Bind/NDS) does not match the server version }
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 580a8e7217..746817e3b5 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -2009,9 +2009,12 @@ type
   private
     FDPos: TPoint;
     FDSize: TPoint;
+    FDPPI: Integer;
     FOnCreate: TNotifyEvent;
     FOnDestroy: TNotifyEvent;
     FOldOrder : Boolean;
+    Procedure ReadP(Reader: TReader);
+    Procedure WriteP(Writer: TWriter);
     Procedure ReadT(Reader: TReader);
     Procedure WriteT(Writer: TWriter);
     Procedure ReadL(Reader: TReader);
@@ -2036,6 +2039,7 @@ type
     Procedure BeforeDestruction; override;
     property DesignOffset: TPoint read FDPos write FDPos;
     property DesignSize: TPoint read FDSize write FDSize;
+    property DesignPPI: Integer read FDPPI write FDPPI;
   published
     property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
     property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
diff --git a/rtl/objpas/classes/compon.inc b/rtl/objpas/classes/compon.inc
index 4a4b1d7416..4c8fbba218 100644
--- a/rtl/objpas/classes/compon.inc
+++ b/rtl/objpas/classes/compon.inc
@@ -291,21 +291,22 @@ end;
 Procedure TComponent.Notification(AComponent: TComponent;
   Operation: TOperation);
 
-Var Runner : Longint;
+Var 
+  C : Longint;
 
 begin
-  If (Operation=opRemove) and Assigned(FFreeNotifies) then
+  If (Operation=opRemove) then
+    RemoveFreeNotification(AComponent);
+  If Not assigned(FComponents) then
+    exit;
+  C:=FComponents.Count-1;
+  While (C>=0) do
     begin
-    FFreeNotifies.Remove(AComponent);
-            If FFreeNotifies.Count=0 then
-      begin
-      FFreeNotifies.Free;
-      FFreenotifies:=Nil;
-      end;
-    end;
-  If assigned(FComponents) then
-    For Runner:=0 To FComponents.Count-1 do
-      TComponent(FComponents.Items[Runner]).Notification(AComponent,Operation);
+    TComponent(FComponents.Items[C]).Notification(AComponent,Operation);
+    Dec(C);
+    if C>=FComponents.Count then
+      C:=FComponents.Count-1;
+    end;  
 end;
 
 
@@ -542,16 +543,16 @@ end;
 Function  TComponent.FindComponent(const AName: string): TComponent;
 
 Var I : longint;
-
+    C : TComponent;
 begin
   Result:=Nil;
   If (AName='') or Not assigned(FComponents) then exit;
   For i:=0 to FComponents.Count-1 do
-    if (CompareText(TComponent(FComponents[I]).Name,AName)=0) then
-      begin
-      Result:=TComponent(FComponents.Items[I]);
-      exit;
-      end;
+    Begin
+      c:=TComponent(FComponents[I]);
+      If (CompareText(C.Name,AName)=0) then
+        Exit(C);
+    End;
 end;
 
 
diff --git a/rtl/objpas/classes/dm.inc b/rtl/objpas/classes/dm.inc
index d890d76daf..583ee77f0a 100644
--- a/rtl/objpas/classes/dm.inc
+++ b/rtl/objpas/classes/dm.inc
@@ -35,6 +35,7 @@ end;
 constructor TDataModule.CreateNew(AOwner: TComponent; CreateMode: Integer);
 begin
   inherited Create(AOwner);
+  FDPPI := 96;
   if Assigned(AddDataModule) and (CreateMode>=0) then
     AddDataModule(Self);
 end;
@@ -97,11 +98,13 @@ begin
             (FDSize.X<>Ancestor.FDSize.X) or
             (FDSize.Y<>Ancestor.FDSize.Y) or
             (FDPos.Y<>Ancestor.FDPos.Y) or
-            (FDPos.X<>Ancestor.FDPos.X);
+            (FDPos.X<>Ancestor.FDPos.X) or
+            (FDPPI<>Ancestor.FDPPI);
   Filer.DefineProperty('Height', @ReadH, @WriteH, HaveData);
   Filer.DefineProperty('HorizontalOffset', @ReadL, @WriteL, HaveData);
   Filer.DefineProperty('VerticalOffset', @ReadT,@WriteT, HaveData);
   Filer.DefineProperty('Width', @ReadW, @WriteW, HaveData);
+  Filer.DefineProperty('PPI', @ReadP, @WriteP, HaveData);
 end;
 
 procedure TDataModule.GetChildren(Proc: TGetChildProc; Root: TComponent);
@@ -125,6 +128,11 @@ begin
     ApplicationHandleException(Self);
 end;
 
+Procedure TDataModule.ReadP(Reader: TReader);
+begin
+  FDPPI := Reader.ReadInteger;
+end;
+
 Procedure TDataModule.ReadState(Reader: TReader);
 begin
   FOldOrder := false;
@@ -156,6 +164,11 @@ begin
   FDSIze.X := Reader.ReadInteger;
 end;
 
+Procedure TDataModule.WriteP(Writer: TWriter);
+begin
+  Writer.WriteInteger(FDPPI);
+end;
+
 Procedure TDataModule.WriteW(Writer: TWriter);
 begin
   Writer.WriteInteger(FDSIze.X);
diff --git a/rtl/objpas/classes/lists.inc b/rtl/objpas/classes/lists.inc
index 42cace6f46..556969d32f 100644
--- a/rtl/objpas/classes/lists.inc
+++ b/rtl/objpas/classes/lists.inc
@@ -144,10 +144,12 @@ begin
     Error (SListIndexError, Index);
   FCount := FCount-1;
   System.Move (FList^[Index+1], FList^[Index], (FCount - Index) * SizeOf(Pointer));
-  // Shrink the list if appropriate
+  // Shrink the list if appropriate:
+  // If capacity>256 and the list is less than a quarter filled,  shrink to 1/2 the size.
+  // Shr is used because it is faster than div.
   if (FCapacity > 256) and (FCount < FCapacity shr 2) then
   begin
-    FCapacity := FCapacity shr 1;
+    FCapacity := FCapacity shr 1; 
     ReallocMem(FList, SizeOf(Pointer) * FCapacity);
   end;
 end;
@@ -175,10 +177,17 @@ var
   IncSize : Longint;
 begin
   if FCount < FCapacity then exit(self);
-  IncSize := 4;
-  if FCapacity > 3 then IncSize := IncSize + 4;
-  if FCapacity > 8 then IncSize := IncSize+8;
-  if FCapacity > 127 then Inc(IncSize, FCapacity shr 2);
+  {
+    For really big lists, (128Mb elements), increase with fixed amount: 16Mb elements (=1/8th of 128Mb).
+    For big lists (8mb elements), increase with 1/8th of the size
+    For moderate lists (128 or more, increase with 1/4th the size
+    For smaller sizes, increase with 16 or 4  
+  }
+  if FCapacity > 128*1024*1024 then IncSize := 16*1024*1024
+  else if FCapacity > 8*1024*1024 then IncSize := FCapacity shr 3
+  else if FCapacity > 128 then IncSize := FCapacity shr 2
+  else if FCapacity > 8 then IncSize := 16
+  else IncSize := 4; 
   SetCapacity(FCapacity + IncSize);
   Result := Self;
 end;
diff --git a/rtl/objpas/classes/reader.inc b/rtl/objpas/classes/reader.inc
index d90ee5f003..8765cdded7 100644
--- a/rtl/objpas/classes/reader.inc
+++ b/rtl/objpas/classes/reader.inc
@@ -906,7 +906,7 @@ begin
 
             { Don't set Result earlier because else we would come in trouble
               with the exception recover mechanism! (Result should be NIL if
-              an error occured) }
+              an error occurred) }
             Result := NewComponent;
           end;
           Include(Result.FComponentState, csLoading);
diff --git a/rtl/objpas/fgl.pp b/rtl/objpas/fgl.pp
index 5c17f804fb..a33b2ca078 100644
--- a/rtl/objpas/fgl.pp
+++ b/rtl/objpas/fgl.pp
@@ -15,9 +15,12 @@
  **********************************************************************}
 {$mode objfpc}
 
-{.$define CLASSESINLINE}
+{$define FGLINLINE}
+
+{$ifdef FGLINLINE}
+{$inline on}
+{$endif FGLINLINE}
 
-{ be aware, this unit is a prototype and subject to be changed heavily }
 unit fgl;
 
 interface
@@ -49,7 +52,7 @@ type
     procedure Deref(FromIndex, ToIndex: Integer); overload;
     function Get(Index: Integer): Pointer;
     procedure InternalExchange(Index1, Index2: Integer);
-    function  InternalGet(Index: Integer): Pointer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function  InternalGet(Index: Integer): Pointer; {$ifdef FGLINLINE} inline; {$endif}
     procedure InternalPut(Index: Integer; NewItem: Pointer);
     procedure Put(Index: Integer; Item: Pointer);
     procedure QuickSort(L, R: Integer; Compare: TFPSListCompareFunc);
@@ -61,6 +64,7 @@ type
     procedure SetLast(const Value: Pointer);
     function GetFirst: Pointer;
     procedure SetFirst(const Value: Pointer);
+    Procedure CheckIndex(AIndex : Integer); inline;
   public
     constructor Create(AItemSize: Integer = sizeof(Pointer));
     destructor Destroy; override;
@@ -114,32 +118,33 @@ type
       TTypeList = array[0..MaxGListSize] of T;
       PTypeList = ^TTypeList;
       PT = ^T;
-      TFPGListEnumeratorSpec = specialize TFPGListEnumerator<T>;
   {$ifndef OldSyntax}protected var{$else}var protected{$endif}
       FOnCompare: TCompareFunc;
     procedure CopyItem(Src, Dest: Pointer); override;
     procedure Deref(Item: Pointer); override;
-    function  Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
-    function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
+    function  Get(Index: Integer): T; {$ifdef FGLINLINE} inline; {$endif}
+    function  GetList: PTypeList; {$ifdef FGLINLINE} inline; {$endif}
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
-    procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Put(Index: Integer; const Item: T); {$ifdef FGLINLINE} inline; {$endif}
+    function GetLast: T; {$ifdef FGLINLINE} inline; {$endif}
+    procedure SetLast(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
+    function GetFirst: T; {$ifdef FGLINLINE} inline; {$endif}
+    procedure SetFirst(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
   public
+    Type
+      TFPGListEnumeratorSpec = specialize TFPGListEnumerator<T>;
     constructor Create;
-    function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const Item: T): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Extract(const Item: T): T; {$ifdef FGLINLINE} inline; {$endif}
     property First: T read GetFirst write SetFirst;
-    function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef FGLINLINE} inline; {$endif}
     function IndexOf(const Item: T): Integer;
-    procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Insert(Index: Integer; const Item: T); {$ifdef FGLINLINE} inline; {$endif}
     property Last: T read GetLast write SetLast;
 {$ifndef VER2_4}
     procedure Assign(Source: TFPGList);
 {$endif VER2_4}
-    function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Remove(const Item: T): Integer; {$ifdef FGLINLINE} inline; {$endif}
     procedure Sort(Compare: TCompareFunc);
     property Items[Index: Integer]: T read Get write Put; default;
     property List: PTypeList read GetList;
@@ -158,27 +163,27 @@ type
       FFreeObjects: Boolean;
     procedure CopyItem(Src, Dest: Pointer); override;
     procedure Deref(Item: Pointer); override;
-    function  Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
-    function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
+    function  Get(Index: Integer): T; {$ifdef FGLINLINE} inline; {$endif}
+    function  GetList: PTypeList; {$ifdef FGLINLINE} inline; {$endif}
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
-    procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Put(Index: Integer; const Item: T); {$ifdef FGLINLINE} inline; {$endif}
+    function GetLast: T; {$ifdef FGLINLINE} inline; {$endif}
+    procedure SetLast(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
+    function GetFirst: T; {$ifdef FGLINLINE} inline; {$endif}
+    procedure SetFirst(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
   public
     constructor Create(FreeObjects: Boolean = True);
-    function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const Item: T): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Extract(const Item: T): T; {$ifdef FGLINLINE} inline; {$endif}
     property First: T read GetFirst write SetFirst;
-    function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef FGLINLINE} inline; {$endif}
     function IndexOf(const Item: T): Integer;
-    procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Insert(Index: Integer; const Item: T); {$ifdef FGLINLINE} inline; {$endif}
     property Last: T read GetLast write SetLast;
 {$ifndef VER2_4}
     procedure Assign(Source: TFPGObjectList);
 {$endif VER2_4}
-    function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Remove(const Item: T): Integer; {$ifdef FGLINLINE} inline; {$endif}
     procedure Sort(Compare: TCompareFunc);
     property Items[Index: Integer]: T read Get write Put; default;
     property List: PTypeList read GetList;
@@ -197,27 +202,27 @@ type
       FOnCompare: TCompareFunc;
     procedure CopyItem(Src, Dest: Pointer); override;
     procedure Deref(Item: Pointer); override;
-    function  Get(Index: Integer): T; {$ifdef CLASSESINLINE} inline; {$endif}
-    function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
+    function  Get(Index: Integer): T; {$ifdef FGLINLINE} inline; {$endif}
+    function  GetList: PTypeList; {$ifdef FGLINLINE} inline; {$endif}
     function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
-    procedure Put(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetLast: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure SetLast(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetFirst: T; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure SetFirst(const Value: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Put(Index: Integer; const Item: T); {$ifdef FGLINLINE} inline; {$endif}
+    function GetLast: T; {$ifdef FGLINLINE} inline; {$endif}
+    procedure SetLast(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
+    function GetFirst: T; {$ifdef FGLINLINE} inline; {$endif}
+    procedure SetFirst(const Value: T); {$ifdef FGLINLINE} inline; {$endif}
   public
     constructor Create;
-    function Add(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Extract(const Item: T): T; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const Item: T): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Extract(const Item: T): T; {$ifdef FGLINLINE} inline; {$endif}
     property First: T read GetFirst write SetFirst;
-    function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef FGLINLINE} inline; {$endif}
     function IndexOf(const Item: T): Integer;
-    procedure Insert(Index: Integer; const Item: T); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Insert(Index: Integer; const Item: T); {$ifdef FGLINLINE} inline; {$endif}
     property Last: T read GetLast write SetLast;
 {$ifndef VER2_4}
     procedure Assign(Source: TFPGInterfacedObjectList);
 {$endif VER2_4}
-    function Remove(const Item: T): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Remove(const Item: T): Integer; {$ifdef FGLINLINE} inline; {$endif}
     procedure Sort(Compare: TCompareFunc);
     property Items[Index: Integer]: T read Get write Put; default;
     property List: PTypeList read GetList;
@@ -288,26 +293,26 @@ type
     procedure CopyData(Src, Dest: Pointer); override;
     procedure Deref(Item: Pointer); override;
     procedure InitOnPtrCompare; override;
-    function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetKey(Index: Integer): TKey; {$ifdef FGLINLINE} inline; {$endif}
+    function GetKeyData(const AKey: TKey): TData; {$ifdef FGLINLINE} inline; {$endif}
+    function GetData(Index: Integer): TData; {$ifdef FGLINLINE} inline; {$endif}
     function KeyCompare(Key1, Key2: Pointer): Integer;
     function KeyCustomCompare(Key1, Key2: Pointer): Integer;
     //function DataCompare(Data1, Data2: Pointer): Integer;
     function DataCustomCompare(Data1, Data2: Pointer): Integer;
-    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure PutData(Index: Integer; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef FGLINLINE} inline; {$endif}
+    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef FGLINLINE} inline; {$endif}
+    procedure PutData(Index: Integer; const NewData: TData); {$ifdef FGLINLINE} inline; {$endif}
     procedure SetOnKeyCompare(NewCompare: TKeyCompareFunc);
     procedure SetOnDataCompare(NewCompare: TDataCompareFunc);
   public
     constructor Create;
-    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
-    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
-    function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Add(const AKey: TKey): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef FGLINLINE} inline; {$endif}
+    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef FGLINLINE} inline; {$endif}
+    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef FGLINLINE} inline; {$endif}
+    function IndexOf(const AKey: TKey): Integer; {$ifdef FGLINLINE} inline; {$endif}
     function IndexOfData(const AData: TData): Integer;
     procedure InsertKey(Index: Integer; const AKey: TKey);
     procedure InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData);
@@ -336,27 +341,27 @@ type
     procedure CopyData(Src, Dest: Pointer); override;
     procedure Deref(Item: Pointer); override;
     procedure InitOnPtrCompare; override;
-    function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetKey(Index: Integer): TKey; {$ifdef FGLINLINE} inline; {$endif}
+    function GetKeyData(const AKey: TKey): TData; {$ifdef FGLINLINE} inline; {$endif}
+    function GetData(Index: Integer): TData; {$ifdef FGLINLINE} inline; {$endif}
     function KeyCompare(Key1, Key2: Pointer): Integer;
     function KeyCustomCompare(Key1, Key2: Pointer): Integer;
     //function DataCompare(Data1, Data2: Pointer): Integer;
     function DataCustomCompare(Data1, Data2: Pointer): Integer;
-    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure PutData(Index: Integer; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef FGLINLINE} inline; {$endif}
+    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef FGLINLINE} inline; {$endif}
+    procedure PutData(Index: Integer; const NewData: TData); {$ifdef FGLINLINE} inline; {$endif}
     procedure SetOnKeyCompare(NewCompare: TKeyCompareFunc);
     procedure SetOnDataCompare(NewCompare: TDataCompareFunc);
   public
     constructor Create(AFreeObjects: Boolean);
     constructor Create;
-    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
-    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
-    function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Add(const AKey: TKey): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef FGLINLINE} inline; {$endif}
+    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef FGLINLINE} inline; {$endif}
+    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef FGLINLINE} inline; {$endif}
+    function IndexOf(const AKey: TKey): Integer; {$ifdef FGLINLINE} inline; {$endif}
     function IndexOfData(const AData: TData): Integer;
     procedure InsertKey(Index: Integer; const AKey: TKey);
     procedure InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData);
@@ -384,26 +389,26 @@ type
     procedure CopyData(Src, Dest: Pointer); override;
     procedure Deref(Item: Pointer); override;
     procedure InitOnPtrCompare; override;
-    function GetKey(Index: Integer): TKey; {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetKeyData(const AKey: TKey): TData; {$ifdef CLASSESINLINE} inline; {$endif}
-    function GetData(Index: Integer): TData; {$ifdef CLASSESINLINE} inline; {$endif}
+    function GetKey(Index: Integer): TKey; {$ifdef FGLINLINE} inline; {$endif}
+    function GetKeyData(const AKey: TKey): TData; {$ifdef FGLINLINE} inline; {$endif}
+    function GetData(Index: Integer): TData; {$ifdef FGLINLINE} inline; {$endif}
     function KeyCompare(Key1, Key2: Pointer): Integer;
     function KeyCustomCompare(Key1, Key2: Pointer): Integer;
     //function DataCompare(Data1, Data2: Pointer): Integer;
     function DataCustomCompare(Data1, Data2: Pointer): Integer;
-    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure PutData(Index: Integer; const NewData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure PutKey(Index: Integer; const NewKey: TKey); {$ifdef FGLINLINE} inline; {$endif}
+    procedure PutKeyData(const AKey: TKey; const NewData: TData); {$ifdef FGLINLINE} inline; {$endif}
+    procedure PutData(Index: Integer; const NewData: TData); {$ifdef FGLINLINE} inline; {$endif}
     procedure SetOnKeyCompare(NewCompare: TKeyCompareFunc);
     procedure SetOnDataCompare(NewCompare: TDataCompareFunc);
   public
     constructor Create;
-    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Add(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
-    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
-    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef CLASSESINLINE} inline; {$endif}
-    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef CLASSESINLINE} inline; {$endif}
-    function IndexOf(const AKey: TKey): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    function Add(const AKey: TKey; const AData: TData): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Add(const AKey: TKey): Integer; {$ifdef FGLINLINE} inline; {$endif}
+    function Find(const AKey: TKey; out Index: Integer): Boolean; {$ifdef FGLINLINE} inline; {$endif}
+    function TryGetData(const AKey: TKey; out AData: TData): Boolean; {$ifdef FGLINLINE} inline; {$endif}
+    procedure AddOrSetData(const AKey: TKey; const AData: TData); {$ifdef FGLINLINE} inline; {$endif}
+    function IndexOf(const AKey: TKey): Integer; {$ifdef FGLINLINE} inline; {$endif}
     function IndexOfData(const AData: TData): Integer;
     procedure InsertKey(Index: Integer; const AKey: TKey);
     procedure InsertKeyData(Index: Integer; const AKey: TKey; const AData: TData);
@@ -465,16 +470,14 @@ end;
 
 function TFPSList.Get(Index: Integer): Pointer;
 begin
-  if (Index < 0) or (Index >= FCount) then
-    RaiseIndexError(Index);
+  CheckIndex(Index);
   Result := InternalItems[Index];
 end;
 
 procedure TFPSList.Put(Index: Integer; Item: Pointer);
 var p : Pointer;
 begin
-  if (Index < 0) or (Index >= FCount) then
-    RaiseIndexError(Index);
+  CheckIndex(Index);
   p:=InternalItems[Index];
   if assigned(p) then
     DeRef(p);	
@@ -532,6 +535,14 @@ begin
   Inc(FCount);
 end;
 
+procedure TFPSList.CheckIndex(AIndex : Integer);
+
+begin
+  if (AIndex < 0) or (AIndex >= FCount) then
+    Error(SListIndexError, AIndex);
+end;
+
+
 procedure TFPSList.Clear;
 begin
   if Assigned(FList) then
@@ -545,8 +556,7 @@ procedure TFPSList.Delete(Index: Integer);
 var
   ListItem: Pointer;
 begin
-  if (Index < 0) or (Index >= FCount) then
-    Error(SListIndexError, Index);
+  CheckIndex(Index);
   Dec(FCount);
   ListItem := InternalItems[Index];
   Deref(ListItem);
@@ -588,10 +598,8 @@ end;
 
 procedure TFPSList.Exchange(Index1, Index2: Integer);
 begin
-  if ((Index1 >= FCount) or (Index1 < 0)) then
-    Error(SListIndexError, Index1);
-  if ((Index2 >= FCount) or (Index2 < 0)) then
-    Error(SListIndexError, Index2);
+  CheckIndex(Index1);
+  CheckIndex(Index2);
   InternalExchange(Index1, Index2);
 end;
 
@@ -680,10 +688,8 @@ var
   CurItem, NewItem, TmpItem, Src, Dest: Pointer;
   MoveCount: Integer;
 begin
-  if (CurIndex < 0) or (CurIndex >= Count) then
-    Error(SListIndexError, CurIndex);
-  if (NewIndex < 0) or (NewIndex >= Count) then
-    Error(SListIndexError, NewIndex);
+  CheckIndex(CurIndex);
+  CheckIndex(NewIndex);
   if CurIndex = NewIndex then
     exit;
   CurItem := InternalItems[CurIndex];
@@ -1311,6 +1317,9 @@ var
   I,L,R,Dir: Integer;
 begin
   Result := false;
+  Index := -1;
+  if not Sorted then
+    raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := FCount-1;
@@ -1544,7 +1553,8 @@ function TFPGMap.TryGetData(const AKey: TKey; out AData: TData): Boolean;
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
@@ -1729,7 +1739,8 @@ function TFPGMapObject.TryGetData(const AKey: TKey; out AData: TData): Boolean;
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
@@ -1910,7 +1921,8 @@ function TFPGMapInterfacedObjectData.TryGetData(const AKey: TKey; out AData: TDa
 var
   I: Integer;
 begin
-  Result := inherited Find(@AKey, I);
+  I := IndexOf(AKey);
+  Result := (I >= 0);
   if Result then
     AData := TData(inherited GetData(I)^)
   else
diff --git a/rtl/objpas/fpwidestring.pp b/rtl/objpas/fpwidestring.pp
index 8ba01a2119..644de3c516 100644
--- a/rtl/objpas/fpwidestring.pp
+++ b/rtl/objpas/fpwidestring.pp
@@ -248,7 +248,7 @@ begin
   if (cp=CP_UTF8) then
     begin
       destLen:=UnicodeToUtf8(nil,High(SizeUInt),source,len);
-      SetLength(dest,destLen);
+      SetLength(dest,destLen-1);
       UnicodeToUtf8(@dest[1],destLen,source,len);
       SetCodePage(dest,cp,False);
       exit;
@@ -680,6 +680,8 @@ end;
 
 function StrLCompAnsiString(S1, S2: PAnsiChar; MaxLen: PtrUInt): PtrInt;
 begin
+  if (current_Collation=nil) then
+    exit(OldManager.StrLCompAnsiStringProc(s1,s2,MaxLen));
   if (MaxLen=0) then
     exit(0);
   Result := InternalCompareStrAnsiString(S1,S2,MaxLen,MaxLen);
@@ -689,6 +691,8 @@ function CompareStrAnsiString(const S1, S2: ansistring): PtrInt;
 var
   l1, l2 : PtrInt;
 begin
+  if (current_Collation=nil) then
+    exit(OldManager.CompareStrAnsiStringProc(s1,s2));
   if (Pointer(S1)=Pointer(S2)) then
     exit(0);
   l1:=Length(S1);
@@ -716,6 +720,8 @@ function StrCompAnsiString(S1, S2: PChar): PtrInt;
 var
   l1,l2 : PtrInt;
 begin
+  if (current_Collation=nil) then
+    exit(OldManager.StrCompAnsiStringProc(s1,s2));
   l1:=strlen(S1);
   l2:=strlen(S2);
   Result := InternalCompareStrAnsiString(S1,S2,l1,l2);
diff --git a/rtl/objpas/sysutils/filutil.inc b/rtl/objpas/sysutils/filutil.inc
index fe3c5522c8..13e132bdf0 100644
--- a/rtl/objpas/sysutils/filutil.inc
+++ b/rtl/objpas/sysutils/filutil.inc
@@ -542,3 +542,9 @@ begin
   InternalFindClose(f.FindHandle{$ifdef USEFINDDATA},f.FindData{$endif});
 end;
 
+{$ifndef SYSUTILS_HAS_FILEFLUSH_IMPL}
+function FileFlush(Handle: THandle): Boolean;
+begin
+  Result:= False;
+end;
+{$endif}
diff --git a/rtl/objpas/sysutils/filutilh.inc b/rtl/objpas/sysutils/filutilh.inc
index 9910371510..87e63a0484 100644
--- a/rtl/objpas/sysutils/filutilh.inc
+++ b/rtl/objpas/sysutils/filutilh.inc
@@ -168,6 +168,7 @@ Function FileRead (Handle : THandle; out Buffer; Count : longint) : Longint;
 Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
 Function FileSeek (Handle : THandle; FOffset, Origin: Longint) : Longint;
 Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
+function FileFlush(Handle: THandle): Boolean; 
 Procedure FileClose (Handle : THandle);
 Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
 Function FindNext (Var Rslt : TRawByteSearchRec) : Longint;
diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc
index 1e63437400..8f6ce90647 100644
--- a/rtl/objpas/sysutils/sysstr.inc
+++ b/rtl/objpas/sysutils/sysstr.inc
@@ -1134,6 +1134,7 @@ Begin
   P:=Pos(FormatSettings.DecimalSeparator,S);
   If (P<>0) Then
     S[P] := '.';
+  s:=Trim(s);
   try
     case ValueType of
       fvCurrency:
diff --git a/rtl/openbsd/Makefile b/rtl/openbsd/Makefile
index 97f3e62283..e5f1c1fbf1 100644
--- a/rtl/openbsd/Makefile
+++ b/rtl/openbsd/Makefile
@@ -3118,6 +3118,14 @@ character$(PPUEXT): sysutils$(PPUEXT) $(OBJPASDIR)/character.pas objpas$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/character.pas
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(INC)/iso7185.pp
+extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT)
+	$(COMPILER) $(INC)/extpas.pp
+x86$(PPUEXT) : $(UNIXINC)/x86.pp $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+ports$(PPUEXT) : $(UNIXINC)/ports.pp x86$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
 ifeq ($(ARCH),x86_64)
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 else
@@ -3127,8 +3135,8 @@ mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
 	$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
diff --git a/rtl/openbsd/Makefile.fpc b/rtl/openbsd/Makefile.fpc
index eb07ad99fd..7543f20581 100644
--- a/rtl/openbsd/Makefile.fpc
+++ b/rtl/openbsd/Makefile.fpc
@@ -226,6 +226,13 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
         $(COMPILER) $(INC)/macpas.pp $(REDIR)
 
 #
+# ISO-Pascal Model
+#
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
+
+#
 # Other system-independent RTL Units
 #
 
@@ -242,9 +249,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 
diff --git a/rtl/openbsd/ptypes.inc b/rtl/openbsd/ptypes.inc
index 044c8bd93f..d7be599cce 100644
--- a/rtl/openbsd/ptypes.inc
+++ b/rtl/openbsd/ptypes.inc
@@ -33,7 +33,7 @@ type
     pGid     = ^gid_t;
     TIOCtlRequest = cuLong;
 
-    ino_t    = cuint32;         { used for file serial numbers }
+    ino_t    = cuint64;         { used for file serial numbers }
     TIno     = ino_t;
     pIno     = ^ino_t;
 
@@ -73,11 +73,11 @@ type
     wchar_t  = cint32;
     pwchar_t = ^wchar_t;
 
-    clock_t  = culong;
+    clock_t  = cint64;
     TClock   = clock_t;
     pClock   = ^clock_t;
 
-    time_t   = clong;           { used for returning the time  }
+    time_t   = cint64;           { used for returning the time  }
     // TTime    = time_t;    // Not allowed in system unit, -> unixtype
     pTime    = ^time_t;
     ptime_t  = ^time_t;
@@ -87,7 +87,7 @@ type
     pSocklen = ^socklen_t;
 
     timeval = packed record
-                tv_sec,
+                tv_sec : time_t;
                 tv_usec : clong;
                 end;
     ptimeval= ^timeval;
diff --git a/rtl/os2/Makefile b/rtl/os2/Makefile
index e6c074ce74..c2e16e5a01 100644
--- a/rtl/os2/Makefile
+++ b/rtl/os2/Makefile
@@ -3108,8 +3108,8 @@ mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 unicodenumtable$(PPUEXT) : $(OBJPASDIR)/unicodenumtable.pas $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/unicodenumtable.pas
diff --git a/rtl/os2/Makefile.fpc b/rtl/os2/Makefile.fpc
index 766caa31c8..2167b42b20 100644
--- a/rtl/os2/Makefile.fpc
+++ b/rtl/os2/Makefile.fpc
@@ -207,9 +207,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT)
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 
 charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
 
diff --git a/rtl/os2/kbdcalls.pas b/rtl/os2/kbdcalls.pas
index 91866cdc79..ea45741997 100644
--- a/rtl/os2/kbdcalls.pas
+++ b/rtl/os2/kbdcalls.pas
@@ -28,8 +28,8 @@
 
  You should have received a copy of the Library GNU General Public License
  along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
+ the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA.
 
 ****************************************************************************}
 
diff --git a/rtl/os2/moncalls.pas b/rtl/os2/moncalls.pas
index a68f900332..7541752a6e 100644
--- a/rtl/os2/moncalls.pas
+++ b/rtl/os2/moncalls.pas
@@ -28,8 +28,8 @@
 
  You should have received a copy of the Library GNU General Public License
  along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
+ the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA.
 
 ****************************************************************************}
 
diff --git a/rtl/os2/moucalls.pas b/rtl/os2/moucalls.pas
index 38388a0161..8c8c8a3b7b 100644
--- a/rtl/os2/moucalls.pas
+++ b/rtl/os2/moucalls.pas
@@ -28,8 +28,8 @@
 
  You should have received a copy of the Library GNU General Public License
  along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
+ the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA.
 
 ****************************************************************************}
 
diff --git a/rtl/os2/pmgpi.pas b/rtl/os2/pmgpi.pas
index 0c7a9a06d3..796cbaf929 100644
--- a/rtl/os2/pmgpi.pas
+++ b/rtl/os2/pmgpi.pas
@@ -26,8 +26,8 @@
 
  You should have received a copy of the Library GNU General Public License
  along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
+ the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA.
 
  ****************************************************************************}
 
diff --git a/rtl/os2/viocalls.pas b/rtl/os2/viocalls.pas
index 785e76edeb..cd12b50973 100644
--- a/rtl/os2/viocalls.pas
+++ b/rtl/os2/viocalls.pas
@@ -28,8 +28,8 @@
 
  You should have received a copy of the Library GNU General Public License
  along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
+ the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+ Boston, MA 02110-1301, USA.
 
 ****************************************************************************}
 
diff --git a/rtl/solaris/Makefile b/rtl/solaris/Makefile
index 5ad44b71ce..06cd8bdda3 100644
--- a/rtl/solaris/Makefile
+++ b/rtl/solaris/Makefile
@@ -2848,9 +2848,9 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(INC)/getopts.pp
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lineinfo.pp
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 	$(COMPILER) $(INC)/lnfodwrf.pp
 charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
 	$(COMPILER) $(INC)/charset.pp
diff --git a/rtl/solaris/Makefile.fpc b/rtl/solaris/Makefile.fpc
index bbbc19216a..e5be8cbe5b 100644
--- a/rtl/solaris/Makefile.fpc
+++ b/rtl/solaris/Makefile.fpc
@@ -232,10 +232,10 @@ getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT) sysutils$(PPUEXT)
 	$(COMPILER) $(INC)/lineinfo.pp
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) lineinfo$(PPUEXT)
 	$(COMPILER) $(INC)/lnfodwrf.pp
 
 charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
diff --git a/rtl/solaris/signal.inc b/rtl/solaris/signal.inc
index 9b083eade2..e69e621cd5 100644
--- a/rtl/solaris/signal.inc
+++ b/rtl/solaris/signal.inc
@@ -50,7 +50,7 @@ const
   SIGPWR     = 19;      { power-fail restart }
   SIGWINCH   = 20;      { window size change }
   SIGURG     = 21;      { urgent socket condition }
-  SIGPOLL    = 22;      { pollable event occured }
+  SIGPOLL    = 22;      { pollable event occurred }
   SIGIO      = SIGPOLL;{ socket I/O possible (SIGPOLL alias) }
   SIGVTALRM  = 28;      { virtual timer expired }
   SIGPROF    = 29;      { profiling timer expired }
diff --git a/rtl/sparc/setjumph.inc b/rtl/sparc/setjumph.inc
index 1cfc063a27..769e74c2ca 100644
--- a/rtl/sparc/setjumph.inc
+++ b/rtl/sparc/setjumph.inc
@@ -26,8 +26,8 @@ Guardian:/usr/local/src/glibc-2.2.3/sysdeps/sparc/sparc32# more __longjmp.S
 
     You should have received a copy of the GNU Library General Public
     License along with the GNU C Library; see the file COPYING.LIB.  If not,
-    write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-    Boston, MA 02111-1307, USA.
+    write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+    Boston, MA 02110-1301, USA.
 
     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/rtl/unix/oscdeclh.inc b/rtl/unix/oscdeclh.inc
index bde5200517..6fb0f8b3af 100644
--- a/rtl/unix/oscdeclh.inc
+++ b/rtl/unix/oscdeclh.inc
@@ -83,7 +83,7 @@ const
     function  FpExecve  (path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external clib name 'execve';
     function  FpExecv  (path : pchar; argv : ppchar): cint; cdecl; external clib name 'execv';
     function  FpWaitpid (pid : TPid; stat_loc : pcint; options: cint): TPid; cdecl; external clib name 'waitpid';
-    Function  FpWait       (var stat_loc : cInt): TPid; cdecl; external clib name 'waitpid';
+    Function  FpWait       (var stat_loc : cInt): TPid; cdecl; external clib name 'wait';
     procedure FpExit    (status : cint); cdecl; external clib name '_exit';
     Function  FpKill       (pid : TPid; sig: cInt): cInt; cdecl; external clib name 'kill';
     function  FpUname   (var name: utsname): cint; cdecl; external clib name 'uname';
diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp
index 0250daab92..1f2843454f 100644
--- a/rtl/unix/sysutils.pp
+++ b/rtl/unix/sysutils.pp
@@ -38,6 +38,9 @@ interface
 {$DEFINE HAS_LOCALTIMEZONEOFFSET}
 {$DEFINE HAS_GETTICKCOUNT64}
 
+// this target has an fileflush implementation, don't include dummy
+{$DEFINE SYSUTILS_HAS_FILEFLUSH_IMPL}
+
 { used OS file system APIs use ansistring }
 {$define SYSUTILS_HAS_ANSISTR_FILEUTIL_IMPL}
 { OS has an ansistring/single byte environment variable API }
@@ -458,6 +461,10 @@ begin
   FileOpen:=DoFileLocking(FileOpen, Mode);
 end;
 
+function FileFlush(Handle: THandle): Boolean;
+begin
+  Result:= fpfsync(handle)=0;
+end;
 
 Function FileCreate (Const FileName : RawByteString) : Longint;
 
diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc
index c34025337a..2d04068074 100644
--- a/rtl/win/systhrd.inc
+++ b/rtl/win/systhrd.inc
@@ -409,10 +409,15 @@ type Tbasiceventstate=record
 
 function intBasicEventCreate(EventAttributes : Pointer;
 AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
-
+var
+  n : PChar;
 begin
   new(plocaleventrec(result));
-  plocaleventrec(result)^.FHandle := CreateEvent(EventAttributes, AManualReset, InitialState,PChar(Name));
+  if Length(Name) = 0 then
+    n := Nil
+  else
+    n := PChar(Name);
+  plocaleventrec(result)^.FHandle := CreateEvent(EventAttributes, AManualReset, InitialState,n);
 end;
 
 procedure intbasiceventdestroy(state:peventstate);
diff --git a/rtl/win/sysutils.pp b/rtl/win/sysutils.pp
index 10c3973a09..4c3987dec9 100644
--- a/rtl/win/sysutils.pp
+++ b/rtl/win/sysutils.pp
@@ -1,4 +1,4 @@
-{
+         {
 
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by Florian Klaempfl
@@ -37,6 +37,9 @@ uses
 {$DEFINE HAS_GETTICKCOUNT64}
 {$DEFINE OS_FILESETDATEBYNAME}
 
+// this target has an fileflush implementation, don't include dummy
+{$DEFINE SYSUTILS_HAS_FILEFLUSH_IMPL}
+
 { used OS file system APIs use unicodestring }
 {$define SYSUTILS_HAS_UNICODESTR_FILEUTIL_IMPL}
 { OS has an ansistring/single byte environment variable API }
@@ -283,6 +286,11 @@ const
                FILE_SHARE_READ or FILE_SHARE_WRITE);
 
 
+function FileFlush(Handle: THandle): Boolean;
+begin
+  Result:= FlushFileBuffers(Handle);
+end;
+
 Function FileOpen (Const FileName : unicodestring; Mode : Integer) : THandle;
 begin
   result := CreateFileW(PWideChar(FileName), dword(AccessMode[Mode and 3]),
@@ -444,6 +452,14 @@ begin
   Result:=0;
 end;
 
+Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
+begin
+   if Handle <> INVALID_HANDLE_VALUE then
+    begin
+    Windows.FindClose(Handle);
+    Handle:=INVALID_HANDLE_VALUE;
+    end;
+end;
 
 Function InternalFindFirst (Const Path : UnicodeString; Attr : Longint; out Rslt : TAbstractSearchRec; var Name : UnicodeString) : Longint;
 begin
@@ -460,6 +476,8 @@ begin
    end;
   { Find file with correct attribute }
   Result:=FindMatch(Rslt,Name);
+  if (Result<>0) then
+    InternalFindClose(Rslt.FindHandle,Rslt.FindData);
 end;
 
 Function InternalFindNext (Var Rslt : TAbstractSearchRec; var Name: UnicodeString) : Longint;
@@ -471,11 +489,6 @@ begin
 end;
 
 
-Procedure InternalFindClose (var Handle: THandle; var FindData: TFindData);
-begin
-   if Handle <> INVALID_HANDLE_VALUE then
-    Windows.FindClose(Handle);
-end;
 
 
 Function FileGetDate (Handle : THandle) : Longint;
@@ -974,23 +987,27 @@ end;
                            Target Dependent
 ****************************************************************************}
 
+
 function SysErrorMessage(ErrorCode: Integer): String;
 const
   MaxMsgSize = Format_Message_Max_Width_Mask;
 var
-  MsgBuffer: pChar;
-begin
-  GetMem(MsgBuffer, MaxMsgSize);
-  FillChar(MsgBuffer^, MaxMsgSize, #0);
-  FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
-                 nil,
-                 ErrorCode,
-                 MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
-                 MsgBuffer,                 { This function allocs the memory }
-                 MaxMsgSize,                           { Maximum message size }
-                 nil);
-  SysErrorMessage := MsgBuffer;
-  FreeMem(MsgBuffer, MaxMsgSize*2);
+  MsgBuffer: unicodestring;
+  len: longint;
+begin
+  SetLength(MsgBuffer, MaxMsgSize);
+  len := FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM,
+                        nil,
+                        ErrorCode,
+                        MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
+                        PUnicodeChar(MsgBuffer),
+                        MaxMsgSize,
+                        nil);
+  // Remove trailing #13#10
+  if (len > 1) and (MsgBuffer[len - 1] = #13) and (MsgBuffer[len] = #10) then
+    Dec(len, 2);
+  SetLength(MsgBuffer, len);
+  Result := MsgBuffer;
 end;
 
 {****************************************************************************
diff --git a/rtl/win/wininc/ascdef.inc b/rtl/win/wininc/ascdef.inc
index cd60d7ac3b..4dd01c0dbf 100644
--- a/rtl/win/wininc/ascdef.inc
+++ b/rtl/win/wininc/ascdef.inc
@@ -40,7 +40,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -475,10 +475,10 @@ function DdeQueryString(_para1:DWORD; _para2:HSZ; _para3:pchar;_para4:DWORD; _pa
 function LogonUser(_para1:LPSTR; _para2:LPSTR; _para3:LPSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserA';
 function CreateProcessAsUser(_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCTSTR;
   _para10:LPSTARTUPINFO; _para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserA';
-function FindFirstFileEx(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExA';
+function FindFirstFileEx(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external 'kernel32' name 'FindFirstFileExA';
 // winver>$0600
 function FindFirstFileTransacted(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall;
-    external name 'FindFirstFileTransactedA';
+    external 'kernel32' name 'FindFirstFileTransactedA';
 {$endif read_interface}
 
 
diff --git a/rtl/win/wininc/ascfun.inc b/rtl/win/wininc/ascfun.inc
index c76e07506e..6d8c0b2b1e 100644
--- a/rtl/win/wininc/ascfun.inc
+++ b/rtl/win/wininc/ascfun.inc
@@ -39,7 +39,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -482,7 +482,17 @@ function OpenWaitableTimerA(dwDesiredAccess:DWORD;bInheritHandle:BOOL;lpTimerNam
 function FindFirstFileExA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external 'kernel32' name 'FindFirstFileExA';
 // winver>$0600
 function FindFirstFileTransactedA(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external 'kernel32' name 'FindFirstFileTransactedA';
-
+// Wincon.h
+function WriteConsoleInputA(hConsoleInput:HANDLE; var lpBuffer:INPUT_RECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):BOOL;stdcall;external 'kernel32' name 'WriteConsoleInputA';
+function ScrollConsoleScreenBufferA(hConsoleOutput:HANDLE; var lpScrollRectangle:SMALL_RECT; var lpClipRectangle:SMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):BOOL;stdcall;external 'kernel32' name 'ScrollConsoleScreenBufferA';
+function GetConsoleOriginalTitleA(lpConsoleTitle:LPSTR; nSize:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleOriginalTitleA';
+function AddConsoleAliasA(Source:LPSTR; Target:LPSTR; ExeName:LPSTR):BOOL;stdcall;external 'kernel32' name 'AddConsoleAliasA';
+function GetConsoleAliasA(Source:LPSTR; TargetBuffer:LPSTR; TargetBufferLength:DWORD; ExeName:LPSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasA';
+function GetConsoleAliasesLengthA(ExeName:LPSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesLengthA';
+function GetConsoleAliasExesLengthA:DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesLengthA';
+function GetConsoleAliasesA(AliasBuffer:LPSTR; AliasBufferLength:DWORD; ExeName:LPSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesA';
+function GetConsoleAliasExesA(ExeNameBuffer:LPSTR; ExeNameBufferLength:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesA';
+  
 {$endif read_interface}
 
 
diff --git a/rtl/win/wininc/base.inc b/rtl/win/wininc/base.inc
index 82b0453bc0..446ea3ecda 100644
--- a/rtl/win/wininc/base.inc
+++ b/rtl/win/wininc/base.inc
@@ -40,7 +40,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -83,7 +83,9 @@
 
 
      INT_PTR = PtrInt;
+     PINT_PTR = ^INT_PTR;
      UINT_PTR = PtrUInt;
+     PUINT_PTR = ^UINT_PTR;
      LONG_PTR = PtrInt;
      ULONG_PTR = PtrUInt;
      DWORD_PTR   = ULONG_PTR;
diff --git a/rtl/win/wininc/defines.inc b/rtl/win/wininc/defines.inc
index 2a69458c9d..76c1a272c2 100644
--- a/rtl/win/wininc/defines.inc
+++ b/rtl/win/wininc/defines.inc
@@ -39,7 +39,7 @@
 
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -2309,6 +2309,7 @@
      SC_MANAGER_MODIFY_BOOT_CONFIG = 32;
   { PostMessage  }
      HWND_BROADCAST = HWND($FFFF);
+     WND_MESSAGE = HWND(-3);
 
   { PrepareTape  }
 
@@ -6209,6 +6210,71 @@ const
   GIDC_ARRIVAL             = 1;
   GIDC_REMOVAL             = 2;
 //#endif /* _WIN32_WINNT >= 0x0501 */
+
+
+//
+// map types for the MapVirtualKey and MapVirtualKeyEx functions
+//
+  MAPVK_VK_TO_VSC     = 0;
+  MAPVK_VSC_TO_VK     = 1;
+  MAPVK_VK_TO_CHAR    = 2;
+  MAPVK_VSC_TO_VK_EX  = 3;
+//#if(WINVER >= 0x0600)
+  MAPVK_VK_TO_VSC_EX  = 4;
+//#endif /* WINVER >= 0x0600 */
+
+//
+// Wincon.h
+//
+    NLS_DBCSCHAR = $00010000;    { DBCS for JPN: SBCS/DBCS mode. }
+    NLS_ALPHANUMERIC = $00000000;    { DBCS for JPN: Alphanumeric mode. }
+    NLS_KATAKANA = $00020000;    { DBCS for JPN: Katakana mode. }
+    NLS_HIRAGANA = $00040000;    { DBCS for JPN: Hiragana mode. }
+    NLS_ROMAN = $00400000;    { DBCS for JPN: Roman/Noroman mode. }
+    NLS_IME_CONVERSION = $00800000;    { DBCS for JPN: IME conversion. }
+    NLS_IME_DISABLE = $20000000;    { DBCS for JPN: IME enable/disable. }
+
+  
+    MOUSE_WHEELED = $0004;    
+    MOUSE_HWHEELED = $0008;    
+
+  
+    COMMON_LVB_LEADING_BYTE = $0100;    { Leading Byte of DBCS }
+    COMMON_LVB_TRAILING_BYTE = $0200;    { Trailing Byte of DBCS }
+    COMMON_LVB_GRID_HORIZONTAL = $0400;    { DBCS: Grid attribute: top horizontal. }
+    COMMON_LVB_GRID_LVERTICAL = $0800;    { DBCS: Grid attribute: left vertical. }
+    COMMON_LVB_GRID_RVERTICAL = $1000;    { DBCS: Grid attribute: right vertical. }
+    COMMON_LVB_REVERSE_VIDEO = $4000;    { DBCS: Reverse fore/back ground attribute. }
+    COMMON_LVB_UNDERSCORE = $8000;    { DBCS: Underscore. }
+    COMMON_LVB_SBCSDBCS = $0300;    { SBCS or DBCS flag. }
+  
+    HISTORY_NO_DUP_FLAG = $1;    
+
+  
+    CONSOLE_NO_SELECTION = $0000;    
+    CONSOLE_SELECTION_IN_PROGRESS = $0001;    { selection has begun }
+    CONSOLE_SELECTION_NOT_EMPTY = $0002;    { non-null select rectangle }
+    CONSOLE_MOUSE_SELECTION = $0004;    { selecting with mouse }
+    CONSOLE_MOUSE_DOWN = $0008;    { mouse is down }
+  
+    ENABLE_INSERT_MODE = $0020;    
+    ENABLE_QUICK_EDIT_MODE = $0040;    
+    ENABLE_EXTENDED_FLAGS = $0080;    
+    ENABLE_AUTO_POSITION = $0100;    
+    ENABLE_VIRTUAL_TERMINAL_INPUT = $0200;    
+  
+    ENABLE_VIRTUAL_TERMINAL_PROCESSING = $0004;    
+    DISABLE_NEWLINE_AUTO_RETURN = $0008;    
+    ENABLE_LVB_GRID_WORLDWIDE = $0010;    
+    
+    CONSOLE_FULLSCREEN = 1;    { fullscreen console }
+    CONSOLE_FULLSCREEN_HARDWARE = 2;    { console owns the hardware }
+
+
+    CONSOLE_FULLSCREEN_MODE = 1;    
+    CONSOLE_WINDOWED_MODE = 2;    
+
+
 {$endif read_interface}
 
 {$ifdef read_implementation}
diff --git a/rtl/win/wininc/errors.inc b/rtl/win/wininc/errors.inc
index 139c4135c2..d7896e39c7 100644
--- a/rtl/win/wininc/errors.inc
+++ b/rtl/win/wininc/errors.inc
@@ -51,7 +51,7 @@
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
 
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
diff --git a/rtl/win/wininc/func.inc b/rtl/win/wininc/func.inc
index 243e8e8813..0de11a4b02 100644
--- a/rtl/win/wininc/func.inc
+++ b/rtl/win/wininc/func.inc
@@ -41,7 +41,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -53,7 +53,7 @@ function FreeResource(hResData:HGLOBAL):WINBOOL; external 'kernel32' name 'FreeR
 function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockResource';
 {$ifdef Unknown_functions}
 { WARNING: function not found !!}
-function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:longint):longint; external External_library name 'WinMain';
+function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:longint):longint; external 'kernel32' name 'WinMain';
 {$endif Unknown_functions}
 function FreeLibrary(hLibModule:HINST):WINBOOL; external 'kernel32' name 'FreeLibrary';
 procedure FreeLibraryAndExitThread(hLibModule:HMODULE; dwExitCode:DWORD); external 'kernel32' name 'FreeLibraryAndExitThread';
@@ -1292,6 +1292,28 @@ function GET_DEVICE_CHANGE_WPARAM(wParam: WPARAM): WORD; inline;
 function GET_DEVICE_CHANGE_LPARAM(lParam: LPARAM): WORD; inline;
 //#endif /* (_WIN32_WINNT >= 0x0601) */
 
+function CONSOLE_REAL_OUTPUT_HANDLE : HANDLE; 
+  function CONSOLE_REAL_INPUT_HANDLE : HANDLE; 
+  function GetConsoleScreenBufferInfoEx(hConsoleOutput:HANDLE; lpConsoleScreenBufferInfoEx:PCONSOLE_SCREEN_BUFFER_INFOEX):BOOL;stdcall;external 'kernel32' name 'GetConsoleScreenBufferInfoEx';
+  function SetConsoleScreenBufferInfoEx(hConsoleOutput:HANDLE; lpConsoleScreenBufferInfoEx:PCONSOLE_SCREEN_BUFFER_INFOEX):BOOL;stdcall;external 'kernel32' name 'SetConsoleScreenBufferInfoEx';
+ // function GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):COORD;stdcall;external 'kernel32' name 'GetLargestConsoleWindowSize';
+  function GetCurrentConsoleFont(hConsoleOutput:HANDLE; bMaximumWindow:BOOL; lpConsoleCurrentFont:PCONSOLE_FONT_INFO):BOOL;stdcall;external 'kernel32' name 'GetCurrentConsoleFont';
+  function GetCurrentConsoleFontEx(hConsoleOutput:HANDLE; bMaximumWindow:BOOL; lpConsoleCurrentFontEx:PCONSOLE_FONT_INFOEX):BOOL;stdcall;external 'kernel32' name 'GetCurrentConsoleFontEx';
+  function SetCurrentConsoleFontEx(hConsoleOutput:HANDLE; bMaximumWindow:BOOL; lpConsoleCurrentFontEx:PCONSOLE_FONT_INFOEX):BOOL;stdcall;external 'kernel32' name 'SetCurrentConsoleFontEx';
+  function GetConsoleHistoryInfo(lpConsoleHistoryInfo:PCONSOLE_HISTORY_INFO):BOOL;stdcall;external 'kernel32' name 'GetConsoleHistoryInfo';
+  function SetConsoleHistoryInfo(lpConsoleHistoryInfo:PCONSOLE_HISTORY_INFO):BOOL;stdcall;external 'kernel32' name 'SetConsoleHistoryInfo';
+  function GetConsoleFontSize(hConsoleOutput:HANDLE; nFont:DWORD):COORD;stdcall;external 'kernel32' name 'GetConsoleFontSize';
+  function GetConsoleSelectionInfo(lpConsoleSelectionInfo:PCONSOLE_SELECTION_INFO):BOOL;stdcall;external 'kernel32' name 'GetConsoleSelectionInfo';
+  function AttachConsole(dwProcessId:DWORD):BOOL;stdcall;external 'kernel32' name 'AttachConsole';
+  function ATTACH_PARENT_PROCESS : DWORD;    
+
+
+  function GetConsoleDisplayMode(lpModeFlags:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetConsoleDisplayMode';
+  function SetConsoleDisplayMode(hConsoleOutput:HANDLE; dwFlags:DWORD; lpNewScreenBufferDimensions:PCOORD):BOOL;stdcall;external 'kernel32' name 'SetConsoleDisplayMode';
+  function GetConsoleWindow:HWND;stdcall;external 'kernel32' name 'GetConsoleWindow';
+  function GetConsoleProcessList(lpdwProcessList:LPDWORD; dwProcessCount:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleProcessList';
+  
+
 {$endif read_interface}
 
 
@@ -2435,5 +2457,20 @@ begin
   GET_DEVICE_CHANGE_LPARAM:=LOWORD(lParam);
 end;
 
+function CONSOLE_REAL_OUTPUT_HANDLE : HANDLE; 
+begin
+  CONSOLE_REAL_OUTPUT_HANDLE:=HANDLE(-(2));
+end;
+
+function CONSOLE_REAL_INPUT_HANDLE : HANDLE;
+begin
+  CONSOLE_REAL_INPUT_HANDLE:=HANDLE(-(3));
+end;
+
+function ATTACH_PARENT_PROCESS : DWORD;
+begin
+  ATTACH_PARENT_PROCESS:=DWORD(-(1));
+end;
+
 {$endif read_implementation}
 
diff --git a/rtl/win/wininc/messages.inc b/rtl/win/wininc/messages.inc
index 7b40bb2d6e..01a9ac9a42 100644
--- a/rtl/win/wininc/messages.inc
+++ b/rtl/win/wininc/messages.inc
@@ -41,7 +41,7 @@
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
 
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -1195,6 +1195,7 @@
      WM_WTSSESSION_CHANGE = $02B1;
      WM_TABLET_FIRST      = $02c0;
      WM_TABLET_LAST       = $02df;
+     WM_DPICHANGED        = $02E0;
      WM_DWMCOMPOSITIONCHANGED        = $031E;
      WM_DWMNCRENDERINGCHANGED        = $031F;
      WM_DWMCOLORIZATIONCOLORCHANGED  = $0320;
diff --git a/rtl/win/wininc/redef.inc b/rtl/win/wininc/redef.inc
index ddce7fc66e..bb28d04a36 100644
--- a/rtl/win/wininc/redef.inc
+++ b/rtl/win/wininc/redef.inc
@@ -823,9 +823,9 @@ function ScrollWindowEx(hWnd:HWND; dx:longint; dy:longint; prcScroll:lpRECT; prc
 //function SearchPathA(lpPath, lpFileName, lpExtension: LPCSTR; nBufferLength: DWORD; lpBuffer: LPCSTR; var lpFilePart: LPCSTR): DWORD; external 'kernel32' name 'SearchPathA';
 //function SearchPathW(lpPath, lpFileName, lpExtension: LPWSTR; nBufferLength: DWORD; lpBuffer: LPWSTR; var lpFilePart: LPWSTR): DWORD; external 'kernel32' name 'SearchPathW';
 //function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT;external 'user32' name 'SendInput';
-function SendMessageTimeout(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT;external 'user32' name 'SendMessageTimeoutA';
-function SendMessageTimeoutA(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT; external 'user32' name 'SendMessageTimeoutA';
-function SendMessageTimeoutW(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT; external 'user32' name 'SendMessageTimeoutW';
+function SendMessageTimeout(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD_PTR): LRESULT;external 'user32' name 'SendMessageTimeoutA';
+function SendMessageTimeoutA(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD_PTR): LRESULT; external 'user32' name 'SendMessageTimeoutA';
+function SendMessageTimeoutW(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD_PTR): LRESULT; external 'user32' name 'SendMessageTimeoutW';
 //function SetAclInformation(var pAcl: TACL; pAclInformation: Pointer; nAclInformationLength: DWORD; dwAclInformationClass: TAclInformationClass): BOOL; external 'advapi32' name 'SetAclInformation';
 //function SetColorAdjustment(DC: HDC; const p2: TColorAdjustment): BOOL; external 'gdi32' name 'SetColorAdjustment';
 function SetCommConfig(hCommDev: THandle; const lpCC: TCommConfig; dwSize: DWORD): BOOL; external 'kernel32' name 'SetCommConfig';
diff --git a/rtl/win/wininc/struct.inc b/rtl/win/wininc/struct.inc
index 9a88d26698..d5487d183d 100644
--- a/rtl/win/wininc/struct.inc
+++ b/rtl/win/wininc/struct.inc
@@ -41,7 +41,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -9090,7 +9090,7 @@ type
 
 // Menubar information
 type
-     tagMENUBARINFO = packed record
+     tagMENUBARINFO = record
        cbSize:DWORD;
        rcBar:Windows.RECT; // rect of bar, popup, item
        _hmenu:HMENU;       // real menu handle of bar, popup
@@ -9308,6 +9308,70 @@ type
     RAWINPUTDEVICELIST = tagRAWINPUTDEVICELIST;
     PRAWINPUTDEVICELIST = ^tagRAWINPUTDEVICELIST;
 //#endif /* _WIN32_WINNT >= 0x0501 */
+
+// Wincon.h  
+
+    _CONSOLE_SCREEN_BUFFER_INFOEX = record
+        cbSize : ULONG;
+        dwSize : COORD;
+        dwCursorPosition : COORD;
+        wAttributes : WORD;
+        srWindow : SMALL_RECT;
+        dwMaximumWindowSize : COORD;
+        wPopupAttributes : WORD;
+        bFullscreenSupported : BOOL;
+        ColorTable : array[0..15] of COLORREF;
+      end;
+    CONSOLE_SCREEN_BUFFER_INFOEX = _CONSOLE_SCREEN_BUFFER_INFOEX;
+    PCONSOLE_SCREEN_BUFFER_INFOEX = ^_CONSOLE_SCREEN_BUFFER_INFOEX;
+
+    
+    _CONSOLE_FONT_INFO = record
+        nFont : DWORD;
+        dwFontSize : COORD;
+      end;
+    CONSOLE_FONT_INFO = _CONSOLE_FONT_INFO;
+    PCONSOLE_FONT_INFO = ^_CONSOLE_FONT_INFO;
+
+    _CONSOLE_FONT_INFOEX = record
+        cbSize : ULONG;
+        nFont : DWORD;
+        dwFontSize : COORD;
+        FontFamily : UINT;
+        FontWeight : UINT;
+        FaceName : array[0..(LF_FACESIZE)-1] of WCHAR;
+      end;
+    CONSOLE_FONT_INFOEX = _CONSOLE_FONT_INFOEX;
+    PCONSOLE_FONT_INFOEX = ^_CONSOLE_FONT_INFOEX;
+
+
+
+    _CONSOLE_HISTORY_INFO = record
+        cbSize : UINT;
+        HistoryBufferSize : UINT;
+        NumberOfHistoryBuffers : UINT;
+        dwFlags : DWORD;
+      end;
+    CONSOLE_HISTORY_INFO = _CONSOLE_HISTORY_INFO;
+    PCONSOLE_HISTORY_INFO = ^_CONSOLE_HISTORY_INFO;
+
+    _CONSOLE_SELECTION_INFO = record
+        dwFlags : DWORD;
+        dwSelectionAnchor : COORD;
+        srSelection : SMALL_RECT;
+      end;
+    CONSOLE_SELECTION_INFO = _CONSOLE_SELECTION_INFO;
+    PCONSOLE_SELECTION_INFO = ^_CONSOLE_SELECTION_INFO;
+
+    _CONSOLE_READCONSOLE_CONTROL = record
+        nLength : ULONG;
+        nInitialChars : ULONG;
+        dwCtrlWakeupMask : ULONG;
+        dwControlKeyState : ULONG;
+      end;
+    CONSOLE_READCONSOLE_CONTROL = _CONSOLE_READCONSOLE_CONTROL;
+    PCONSOLE_READCONSOLE_CONTROL = ^_CONSOLE_READCONSOLE_CONTROL;
+
 {$pop}
 {$endif read_interface}
 
diff --git a/rtl/win/wininc/unidef.inc b/rtl/win/wininc/unidef.inc
index 9cff27077a..19aec75966 100644
--- a/rtl/win/wininc/unidef.inc
+++ b/rtl/win/wininc/unidef.inc
@@ -41,7 +41,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -469,9 +469,9 @@ function LogonUser(_para1:LPWSTR; _para2:LPWSTR; _para3:LPWSTR; _para4:DWORD; _p
 function CreateProcessAsUser(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCWSTR;
   _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
 
-function FindFirstFileEx(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external name 'FindFirstFileExW';
+function FindFirstFileEx(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword):Handle; stdcall; external 'kernel32' name 'FindFirstFileExW';
 // winver>$0600 
-function FindFirstFileTransacted(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external name 'FindFirstFileTransactedW';
+function FindFirstFileTransacted(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external 'kernel32' name 'FindFirstFileTransactedW';
 
 {$endif read_interface}
 
diff --git a/rtl/win/wininc/unifun.inc b/rtl/win/wininc/unifun.inc
index 9875d6c911..a723d5c0a9 100644
--- a/rtl/win/wininc/unifun.inc
+++ b/rtl/win/wininc/unifun.inc
@@ -41,7 +41,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 }
 
 {$ifdef read_interface}
@@ -484,6 +484,18 @@ function FindFirstFileExW(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;
 function FindFirstFileTransactedW(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external 'kernel32' name 'FindFirstFileTransactedW';
 function CopyFileExW(lpExistingFileName,lpNewFileName : LPCWSTR;lpProgressRoutine:LPPROGRESS_ROUTINE;lpdata:Pointer;pbcancel:LPBOOL;dwCopyFlags:DWord):DWord; stdcall; external 'kernel32' name 'CopyFileExW';
 
+
+function PeekConsoleInputW(hConsoleInput:HANDLE; lpBuffer:PINPUT_RECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):BOOL;stdcall;external 'kernel32' name 'PeekConsoleInputW';
+function WriteConsoleInputW(hConsoleInput:HANDLE; var lpBuffer:INPUT_RECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):BOOL;stdcall;external 'kernel32' name 'WriteConsoleInputW';
+function ScrollConsoleScreenBufferW(hConsoleOutput:HANDLE; var lpScrollRectangle:SMALL_RECT; var lpClipRectangle:SMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):BOOL;stdcall;external 'kernel32' name 'ScrollConsoleScreenBufferW';
+function GetConsoleOriginalTitleW(lpConsoleTitle:LPWSTR; nSize:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleOriginalTitleW';
+function AddConsoleAliasW(Source:LPWSTR; Target:LPWSTR; ExeName:LPWSTR):BOOL;stdcall;external 'kernel32' name 'AddConsoleAliasW';
+function GetConsoleAliasW(Source:LPWSTR; TargetBuffer:LPWSTR; TargetBufferLength:DWORD; ExeName:LPWSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasW';
+function GetConsoleAliasesLengthW(ExeName:LPWSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesLengthW';
+function GetConsoleAliasExesLengthW:DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesLengthW';
+function GetConsoleAliasesW(AliasBuffer:LPWSTR; AliasBufferLength:DWORD; ExeName:LPWSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesW';
+function GetConsoleAliasExesW(ExeNameBuffer:LPWSTR; ExeNameBufferLength:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesW';
+
 {$endif read_interface}
 
 
diff --git a/rtl/wince/wininc/base.inc b/rtl/wince/wininc/base.inc
index fa3486d877..7333dd2da8 100644
--- a/rtl/wince/wininc/base.inc
+++ b/rtl/wince/wininc/base.inc
@@ -41,7 +41,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   Changes :
 
diff --git a/rtl/wince/wininc/defines.inc b/rtl/wince/wininc/defines.inc
index c3e9ea337e..15203e2ca9 100644
--- a/rtl/wince/wininc/defines.inc
+++ b/rtl/wince/wininc/defines.inc
@@ -39,7 +39,7 @@
 
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
 
 }
diff --git a/rtl/wince/wininc/errors.inc b/rtl/wince/wininc/errors.inc
index 098ff88ec1..7aaba1775b 100644
--- a/rtl/wince/wininc/errors.inc
+++ b/rtl/wince/wininc/errors.inc
@@ -51,7 +51,7 @@
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
 
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   Changes :
 
diff --git a/rtl/wince/wininc/messages.inc b/rtl/wince/wininc/messages.inc
index 1cb1cd8703..e464c30353 100644
--- a/rtl/wince/wininc/messages.inc
+++ b/rtl/wince/wininc/messages.inc
@@ -41,7 +41,7 @@
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
 
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   Changes :
 
diff --git a/rtl/wince/wininc/struct.inc b/rtl/wince/wininc/struct.inc
index 6062df3715..885166fde7 100644
--- a/rtl/wince/wininc/struct.inc
+++ b/rtl/wince/wininc/struct.inc
@@ -41,7 +41,7 @@
   You should have received a copy of the GNU Library General Public
   License along with this library; see the file COPYING.LIB.
   If not, write to the Free Software Foundation,
-  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
 
   Changes :
@@ -2329,7 +2329,7 @@
      // routine when a floating point exception is detected
      _EXCEPTION = record  //+stdlib
        type_  : Integer;  //identifier type replaced by Type_ for compilation
-       Name   : PChar;    // name of function where error occured
+       Name   : PChar;    // name of function where error occurred
        arg1   : double;   // first argument to function
        arg2   : double;   // second argument (if any) to function
        retval : double;   // value to be returned by function
diff --git a/tests/tbs/tb0621.pp b/tests/tbs/tb0621.pp
new file mode 100644
index 0000000000..476d6af001
--- /dev/null
+++ b/tests/tbs/tb0621.pp
@@ -0,0 +1,27 @@
+PROGRAM compbug300;
+
+VAR x1, x2 : comp;
+
+(* Dividing 8 / 2 doesn't work with fpc 3.0.0
+   but works for example with fpc 2.6.4
+   Markus Greim / 29.jun.2016 *)
+
+BEGIN
+
+x1 := 8;
+writeln('x1 : ',x1);
+x2 := x1 / 2;
+writeln('x2 = x1/2 should be 4 but is : ', x2);
+if x2<>4 then
+  halt(1);
+x2 := x1 / 4;
+writeln('x2 = x1/4 should be 2 but is : ', x2);
+if x2<>2 then
+  halt(2);
+x2 := x1 / 8.0;
+writeln('x2 = x1/8.0 should be 1 and is : ', x2);
+if x2<>1 then
+  halt(3);
+
+
+END. 
diff --git a/tests/test/units/sysutils/tastrcmp.pp b/tests/test/units/sysutils/tastrcmp.pp
index 131eb1ecea..810c3096ae 100644
--- a/tests/test/units/sysutils/tastrcmp.pp
+++ b/tests/test/units/sysutils/tastrcmp.pp
@@ -16,8 +16,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 }
 
 {$ifdef fpc}
diff --git a/tests/test/units/sysutils/tstrcmp.pp b/tests/test/units/sysutils/tstrcmp.pp
index 99dccc728a..6b9ce018d0 100644
--- a/tests/test/units/sysutils/tstrcmp.pp
+++ b/tests/test/units/sysutils/tstrcmp.pp
@@ -16,8 +16,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 }
 
 {$ifdef fpc}
diff --git a/tests/test/units/sysutils/twstrcmp.pp b/tests/test/units/sysutils/twstrcmp.pp
index 7112837c97..d76b532fe4 100644
--- a/tests/test/units/sysutils/twstrcmp.pp
+++ b/tests/test/units/sysutils/twstrcmp.pp
@@ -16,8 +16,8 @@
 
    You should have received a copy of the GNU Lesser General Public
    License along with the GNU C Library; if not, write to the Free
-   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-   02111-1307 USA.  */
+   Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA.  */
 }
 
 {$ifdef fpc}
diff --git a/tests/utils/Makefile b/tests/utils/Makefile
index 3a0767154e..39525fd5ad 100644
--- a/tests/utils/Makefile
+++ b/tests/utils/Makefile
@@ -2026,5 +2026,7 @@ include fpcmake.loc
 endif
 .NOTPARALLEL:
 utils: all
+dosbox_wrapper$(SRCEXEEXT): dosbox/dosbox_wrapper.pas  
+	$(COMPILER) -FE./dosbox $<
 utilsdb:
 	$(MAKE) utils DBDIGEST="dbdigest dbconfig"
diff --git a/tests/utils/Makefile.fpc b/tests/utils/Makefile.fpc
index a82290afc5..89d39c7523 100644
--- a/tests/utils/Makefile.fpc
+++ b/tests/utils/Makefile.fpc
@@ -13,7 +13,7 @@ fpcdir=../..
 nortl=y
 
 [target]
-programs=dotest fptime fail testfail digest concat $(DBDIGEST)
+programs=dotest fptime fail testfail digest concat $(DBDIGEST) $(MSDOSPROG)
 programs_win32=prepup
 programs_win64=prepup
 programs_go32v2=prepup
@@ -21,10 +21,21 @@ programs_go32v2=prepup
 [clean]
 programs=dbdigest dbconfig
 
+[prerules]
+
+ifneq ($(findstring dosbox_wrapper,$(EMULATOR)),)
+  MSDOSPROG=dosbox/dosbox_wrapper$(SRCEXEEXT)
+else
+  MSDOSPROG=
+endif
+
 [rules]
 .NOTPARALLEL:
 
 utils: all
 
+dosbox/dosbox_wrapper$(SRCEXEEXT): dosbox/dosbox_wrapper.pas  
+	$(COMPILER) -FE./dosbox $<
+
 utilsdb:
         $(MAKE) utils DBDIGEST="dbdigest dbconfig"
diff --git a/tests/utils/avx/asmtestgenerator.pas b/tests/utils/avx/asmtestgenerator.pas
index b642c0f712..f1cddc39ed 100644
--- a/tests/utils/avx/asmtestgenerator.pas
+++ b/tests/utils/avx/asmtestgenerator.pas
@@ -14,8 +14,8 @@
 
   A copy of the GNU General Public License is available on the World Wide Web
   at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
-  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-  MA 02111-1307, USA.
+  to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+  MA 02110-1301, USA.
 }
 
 {$mode objfpc}
diff --git a/tests/utils/avx/avxtestgenerator.pp b/tests/utils/avx/avxtestgenerator.pp
index 02914ba7c4..3c246e54e2 100644
--- a/tests/utils/avx/avxtestgenerator.pp
+++ b/tests/utils/avx/avxtestgenerator.pp
@@ -14,8 +14,8 @@
 
   A copy of the GNU General Public License is available on the World Wide Web
   at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
-  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-  MA 02111-1307, USA.
+  to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+  MA 02110-1301, USA.
 }
 
 {$mode objfpc}
diff --git a/tests/utils/avx/baselist.pas b/tests/utils/avx/baselist.pas
index c9e54207ef..93a4023275 100644
--- a/tests/utils/avx/baselist.pas
+++ b/tests/utils/avx/baselist.pas
@@ -14,8 +14,8 @@
 
   A copy of the GNU General Public License is available on the World Wide Web
   at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
-  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-  MA 02111-1307, USA.
+  to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+  MA 02110-1301, USA.
 }
 
 {$mode objfpc}
diff --git a/tests/utils/avx/options.pas b/tests/utils/avx/options.pas
index d9e5a6088a..8f5efafa54 100644
--- a/tests/utils/avx/options.pas
+++ b/tests/utils/avx/options.pas
@@ -14,8 +14,8 @@
 
   A copy of the GNU General Public License is available on the World Wide Web
   at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
-  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-  MA 02111-1307, USA.
+  to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+  MA 02110-1301, USA.
 }
 
 {$mode objfpc}
diff --git a/tests/utils/gparmake.pp b/tests/utils/gparmake.pp
index bb116512cd..b4ce34e3e0 100644
--- a/tests/utils/gparmake.pp
+++ b/tests/utils/gparmake.pp
@@ -131,7 +131,11 @@ Function ProcessArgs: longint;
             while not(eof(responsefile)) do
               begin
                 readln(responsefile,s);
-                AddFile(s);
+                { Avoid problem with GNU make version 4
+                  which adds lines containing
+                  make[X] Entering/leaving ... }
+                if not (copy(s,1,5)='make[') then
+                  AddFile(s);
               end;
             close(responsefile);
           end
diff --git a/tests/webtbs/tw28713.pp b/tests/webtbs/tw28713.pp
new file mode 100644
index 0000000000..e0879f1cc3
--- /dev/null
+++ b/tests/webtbs/tw28713.pp
@@ -0,0 +1,30 @@
+{ %OPT=-O3 }
+// Compiled with option -O3 for Win32-I386
+
+type
+  PWordArray = ^TWordArray;
+  TWordArray = array [0..1023]of Word;
+
+  WordRec = packed record
+    LoByte,HiByte:Byte
+  end;
+
+var
+  Buffer:TWordArray;
+  OldMousePos:LongInt = 0;
+  ScreenBuffer:Pointer = @Buffer;
+
+procedure Show(ScreenBuffer:Pointer);
+begin
+  WordRec(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte:=(not
+  WordRec(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte)and $7F
+  // he forgets to write the result into the array
+end;
+
+begin
+  Buffer[0]:=$0000;
+  Show(ScreenBuffer);
+  if Buffer[0]<>$7F00 then
+    halt(1);
+  writeln('ok');
+end.
diff --git a/tests/webtbs/tw28713b.pp b/tests/webtbs/tw28713b.pp
new file mode 100644
index 0000000000..e3acb0f5ca
--- /dev/null
+++ b/tests/webtbs/tw28713b.pp
@@ -0,0 +1,31 @@
+{ %OPT=-O3 }
+{$mode objfpc}
+// Compiled with option -O3 for Win32-I386
+
+type
+  PWordArray = ^TWordArray;
+  TWordArray = array [0..1023] of PtrUInt;
+
+  TMyclass = class
+    LoByte,HiByte:Byte
+  end;
+
+var
+  Buffer:TWordArray;
+  OldMousePos:LongInt = 0;
+  ScreenBuffer:Pointer = @Buffer;
+
+procedure Show(ScreenBuffer:Pointer);
+begin
+  TMyClass(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte:=(not
+  TMyClass(PWordArray(ScreenBuffer)^[OldMousePos]).HiByte)and $7F
+  // he forgets to write the result into the array
+end;
+
+begin
+  TMyClass(Buffer[0]):=TMyClass.Create;
+  Show(ScreenBuffer);
+  if TMyClass(Buffer[0]).HiByte<>$7F then
+    halt(1);
+  writeln('ok');
+end.
diff --git a/tests/webtbs/tw30240.pp b/tests/webtbs/tw30240.pp
new file mode 100644
index 0000000000..c7b3ae5762
--- /dev/null
+++ b/tests/webtbs/tw30240.pp
@@ -0,0 +1,84 @@
+type
+  TTestCase = record
+    group: char;
+    dividend, divider: int64;   // source
+    quotient, remainder: int64; // expected result
+  end;
+
+const
+  test_cases: array [0..40] of TTestCase =(
+    // #30240
+    ( group:'-'; dividend: 2000000000000; divider: 2000000000001; quotient: 0; remainder: 2000000000000 ),
+    //.Lbig_divisor (with carry at the end)
+    ( group:'a'; dividend: 8375316585208858139; divider:-7333902439715991;    quotient:-1141;      remainder: 7333901492912408 ),
+    ( group:'a'; dividend: 7056323922322693051; divider:-2740063521509;       quotient:-2575240;   remainder: 2739191855891 ),
+    ( group:'a'; dividend: 8271196811549967915; divider: 25285028838;         quotient: 327118345; remainder: 24786134805 ),
+    ( group:'a'; dividend: 3431221233848454052; divider:-3431221234088342633; quotient: 0;         remainder: 3431221233848454052 ),
+    ( group:'a'; dividend:-8585295120939781742; divider:-23751612046;         quotient: 361461575; remainder:-22003649292 ),
+    ( group:'a'; dividend:-6683243686137656212; divider: 40354827467772;      quotient:-165611;    remainder:-40354372467520 ),
+    ( group:'a'; dividend:-6963003432881308676; divider:-1740750858595018939; quotient: 3;         remainder:-1740750857096251859 ),
+    ( group:'a'; dividend: 3589102502730131736; divider: 2718092484398;       quotient: 1320448;   remainder: 2717891761432 ),
+    ( group:'a'; dividend:-9069664486668623813; divider:-177626955280;        quotient: 51060180;  remainder:-177219873413 ),
+    ( group:'a'; dividend:-8708789282907437996; divider:-280928686587236007;  quotient: 30;        remainder:-280928685290357786 ),
+    //.Lbig_divisor (without carry)
+    ( group:'b'; dividend:-5478163896315828857; divider:-9281215814;          quotient: 590242055; remainder:-1361971087 ),
+    ( group:'b'; dividend: 7101201960831283575; divider: 9474016311;          quotient: 749545042; remainder: 7094103513 ),
+    ( group:'b'; dividend: 3960011864586540874; divider:-2123266079007095486; quotient:-1;         remainder: 1836745785579445388 ),
+    ( group:'b'; dividend: 6707823169352057382; divider:-7764081918;          quotient:-863955743; remainder: 7173502308 ),
+    ( group:'b'; dividend: 5698168712416449358; divider: 4542747269964;       quotient: 1254344;   remainder: 930820725742 ),
+    ( group:'b'; dividend: 3759351913822964708; divider:-56344208198167;      quotient:-66721;     remainder: 9998633064301 ),
+    ( group:'b'; dividend:-7764588773457981677; divider: 27146308080993374;   quotient:-286;       remainder:-744662293876713 ),
+    ( group:'b'; dividend:-5098584499810065147; divider:-1033450244405508;    quotient: 4933;      remainder:-574444157694183 ),
+    ( group:'b'; dividend: 7767592121360637078; divider:-2706907408679000905; quotient:-2;         remainder: 2353777304002635268 ),
+    ( group:'b'; dividend: 3900260326859439920; divider:-4529352981664096387; quotient: 0;         remainder: 3900260326859439920 ),
+    //.Ltwo_divs
+    ( group:'c'; dividend:-3189721586398362144; divider:-477575983;  quotient: 6678982402;    remainder:-323510978 ),
+    ( group:'c'; dividend:-6272627659376899240; divider:-365611917;  quotient: 17156518613;   remainder:-231788119 ),
+    ( group:'c'; dividend: 8347107135342446860; divider: 1114829022; quotient: 7487342875;    remainder: 627528610 ),
+    ( group:'c'; dividend: 7002068931434460610; divider: 404820846;  quotient: 17296710385;   remainder: 361774900 ),
+    ( group:'c'; dividend: 8293431318282107842; divider:-718398042;  quotient:-11544340092;   remainder: 7207978 ),
+    ( group:'c'; dividend:-6808260689000200821; divider:-1501534265; quotient: 4534202680;    remainder:-525370621 ),
+    ( group:'c'; dividend: 7674745939185655069; divider:-1699384892; quotient:-4516190520;    remainder: 104031229 ),
+    ( group:'c'; dividend: 6431190513421618316; divider: 3333080;    quotient: 1929503796315; remainder: 18116 ),
+    ( group:'c'; dividend: 2124140687535160173; divider: 37711397;   quotient: 56326226459;   remainder: 27906950 ),
+    ( group:'c'; dividend:-3811970536696094994; divider:-43355849;   quotient: 87922866801;   remainder:-24825945 ),
+    // one division
+    ( group:'d'; dividend:-569298819287740717;  divider: 623930358;  quotient:-912439684;  remainder:-596213845 ),
+    ( group:'d'; dividend: 990400595808799715;  divider:-1625588531; quotient:-609256633;  remainder: 768323592 ),
+    ( group:'d'; dividend:-580252789917085737;  divider:-354226044;  quotient: 1638086187; remainder:-165031509 ),
+    ( group:'d'; dividend: 1933675428811294466; divider: 1189844258; quotient: 1625150027; remainder: 796799500 ),
+    ( group:'d'; dividend: 548675153951135484;  divider:-335038546;  quotient:-1637647848; remainder: 97186476 ),
+    ( group:'d'; dividend:-844891682720642266;  divider: 1058118666; quotient:-798484810;  remainder:-742178806 ),
+    ( group:'d'; dividend:-759434744728515761;  divider:-733407613;  quotient: 1035487948; remainder:-495567637 ),
+    ( group:'d'; dividend: 13655828961120164;   divider: 15582697;   quotient: 876345664;  remainder: 11744356 ),
+    ( group:'d'; dividend: 14609195521567996;   divider:-38440672;   quotient:-380045268;  remainder: 29227900 ),
+    ( group:'d'; dividend:-402022804788005296;  divider:-254071284;  quotient: 1582322875; remainder:-234183796 )
+  );
+
+var
+  i, errors: integer;
+  vq, vr: int64;
+
+begin
+  errors := 0;
+  for i := low(test_cases) to high(test_cases) do
+    begin
+      vq := test_cases[i].dividend div test_cases[i].divider;
+      vr := test_cases[i].dividend mod test_cases[i].divider;
+      if vq*test_cases[i].divider+vr=test_cases[i].dividend then
+        if vq=test_cases[i].quotient then
+          if vr=test_cases[i].remainder then
+            continue;
+      inc(errors);
+      writeln('Error [',test_cases[i].group,']: ',test_cases[i].dividend,'/',test_cases[i].divider);
+      writeln('  q=',vq,' r=',vr);
+      writeln('  expected q=',test_cases[i].quotient,' r=',test_cases[i].remainder);
+    end;
+  if errors=0 then
+    writeln('Pass')
+  else
+    begin
+      writeln('Fail (',errors,' errors)');
+      halt(1);
+    end;
+end.
diff --git a/tests/webtbs/tw30357.pp b/tests/webtbs/tw30357.pp
new file mode 100644
index 0000000000..1099ad3dc0
--- /dev/null
+++ b/tests/webtbs/tw30357.pp
@@ -0,0 +1,38 @@
+program tw30357;
+
+{$mode delphi}
+
+type
+  TMyRecord = record
+  private
+    class function GetEmpty: TMyRecord; static;
+  public
+    class property Empty: TMyRecord read GetEmpty;
+  private
+    FData: IInterface;
+  end;
+
+class function TMyRecord.GetEmpty: TMyRecord; static;
+begin
+end;
+
+procedure Main2(Sender: TObject);
+var
+  v1: PtrUInt;
+begin
+  v1 := 42;
+end;
+
+procedure Main(Sender: TObject);
+var
+  v1: TMyRecord;
+begin
+  if v1.FData <> nil then
+    Halt(1);
+end;
+
+begin
+  { with Main2 we ensure that the stack area is not 0 }
+  Main2(nil);
+  Main(nil);
+end.
diff --git a/tests/webtbs/tw9419.pp b/tests/webtbs/tw9419.pp
index b0c708e88a..ee3e1eb1f8 100644
--- a/tests/webtbs/tw9419.pp
+++ b/tests/webtbs/tw9419.pp
@@ -13,7 +13,7 @@ var
 
 begin
   map := TMymap.Create();
-
+  map.sorted:=true;
   map.Add('Hello', ta);
 
   map.Find('Hello', i);
diff --git a/utils/creumap.pp b/utils/creumap.pp
index 7c607ec3e1..f487875a62 100644
--- a/utils/creumap.pp
+++ b/utils/creumap.pp
@@ -63,6 +63,7 @@ const
        BlockWrite(nef,AMap^.reversemap^,h.reverseMapLength);
        Close(nef);
 
+       FillChar(th,SizeOf(th),0);
        th.cpName := h.cpName;
        th.cp := SwapEndian(h.cp);
        th.mapLength := SwapEndian(h.mapLength);
@@ -72,6 +73,7 @@ const
        Rewrite(oef);
        BlockWrite(oef,th,SizeOf(th));
        pum := AMap^.map;
+       FillChar(um,SizeOf(um),0);
        for k := 0 to AMap^.lastchar do begin
           um.flag := pum^.flag;
           um.reserved := pum^.reserved;
@@ -80,6 +82,7 @@ const
           Inc(pum);
        end;
        prm := AMap^.reversemap;
+       FillChar(rm,SizeOf(rm),0);
        for k := 0 to AMap^.reversemaplength - 1 do begin
          rm.unicode := SwapEndian(prm^.unicode);
          rm.char1 := prm^.char1;
diff --git a/utils/fpcmkcfg/fppkg.cfg b/utils/fpcmkcfg/fppkg.cfg
index 517f0fc7ad..6adc9e97c0 100644
--- a/utils/fpcmkcfg/fppkg.cfg
+++ b/utils/fpcmkcfg/fppkg.cfg
@@ -4,8 +4,8 @@ LocalRepository=%LocalRepository%
 BuildDir={LocalRepository}build/
 ArchivesDir={LocalRepository}archives/
 CompilerConfigDir=%CompilerConfigDir%
-RemoteMirrors=http://www.freepascal.org/repository/mirrors.xml
+RemoteMirrors=https://www.freepascal.org/repository/mirrors.xml
 RemoteRepository=auto
 CompilerConfig=default
 FPMakeCompilerConfig=default
-Downloader=lnet
+Downloader=FPC
diff --git a/utils/fpcmkcfg/fppkg.inc b/utils/fpcmkcfg/fppkg.inc
index ebda2123bf..1d58124fc5 100644
--- a/utils/fpcmkcfg/fppkg.inc
+++ b/utils/fpcmkcfg/fppkg.inc
@@ -9,9 +9,9 @@ const fppkg : array[0..1,1..240] of char=(
   'BuildDir={LocalRepository}build/'#010+
   'ArchivesDir={LocalRepository}archives/'#010+
   'CompilerConfigDir=%CompilerConfigDir%'#010+
-  'RemoteMirrors=http://www.freepascal.org/repository/mirrors.xml'#010+
-  'Remote','Repository=auto'#010+
+  'RemoteMirrors=https://www.freepascal.org/repository/mirrors.xml'#010+
+  'Remot','eRepository=auto'#010+
   'CompilerConfig=default'#010+
   'FPMakeCompilerConfig=default'#010+
-  'Downloader=lnet'#010
+  'Downloader=FPC'#010
 );
diff --git a/utils/fpdoc/COPYING.txt b/utils/fpdoc/COPYING.txt
index 60549be514..ebb24a85e9 100644
--- a/utils/fpdoc/COPYING.txt
+++ b/utils/fpdoc/COPYING.txt
@@ -2,7 +2,7 @@
 		       Version 2, June 1991
 
  Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+                       51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  Everyone is permitted to copy and distribute verbatim copies
  of this license document, but changing it is not allowed.
 
@@ -305,7 +305,7 @@ the "copyright" line and a pointer to where the full notice is found.
 
     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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 
 Also add information on how to contact you by electronic and paper mail.
diff --git a/utils/fpdoc/README.txt b/utils/fpdoc/README.txt
index 7a59a8eec5..d1432d0efb 100644
--- a/utils/fpdoc/README.txt
+++ b/utils/fpdoc/README.txt
@@ -14,7 +14,7 @@ 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 
 (the file COPYING contains the whole GNU General Public License)
diff --git a/utils/fpdoc/css.inc b/utils/fpdoc/css.inc
index d0252e893c..c79971f330 100644
--- a/utils/fpdoc/css.inc
+++ b/utils/fpdoc/css.inc
@@ -1,6 +1,6 @@
 
 Const
-  DefaultCSS : Array[0..2254] of byte = (
+  DefaultCSS : Array[0..2649] of byte = (
       47, 42, 10, 32, 32, 36, 73,100, 58, 32,102,112,100,111, 99, 46, 99,
      115,115, 44,118, 32, 49, 46, 49, 32, 50, 48, 48, 51, 47, 48, 51, 47,
       49, 55, 32, 50, 51, 58, 48, 51, 58, 50, 48, 32,109,105, 99,104, 97,
@@ -100,37 +100,60 @@ Const
      111,108,111,114, 58, 32, 35,102,102,102,102, 99, 48, 59, 10,125, 10,
       10,116, 97, 98,108,101, 46, 98, 97,114, 32,123, 10, 32, 32, 98, 97,
       99,107,103,114,111,117,110,100, 45, 99,111,108,111,114, 58, 32, 35,
-      97, 48, 99, 48,102,102, 59, 10,125, 10, 10,115,112, 97,110, 46, 98,
-      97,114,116,105,116,108,101, 32,123, 10, 32, 32,102,111,110,116, 45,
-     119,101,105,103,104,116, 58, 32, 98,111,108,100, 59, 10, 32, 32,102,
-     111,110,116, 45,115,116,121,108,101, 58, 32,105,116, 97,108,105, 99,
-      59, 10, 32, 32, 99,111,108,111,114, 58, 32,100, 97,114,107, 98,108,
-     117,101, 10,125, 10, 10,115,112, 97,110, 46,102,111,111,116,101,114,
-      32,123, 10, 32, 32,102,111,110,116, 45,115,116,121,108,101, 58, 32,
-     105,116, 97,108,105, 99, 59, 10, 32, 32, 99,111,108,111,114, 58, 32,
-     100, 97,114,107, 98,108,117,101, 10,125, 10, 10, 47, 42, 32,100,101,
-     102,105,110,105,116,105,111,110, 32,108,105,115,116, 32, 42, 47, 10,
-     100,108, 32,123, 10, 32, 98,111,114,100,101,114, 58, 32, 51,112,120,
-      32,100,111,117, 98,108,101, 32, 35, 99, 99, 99, 59, 10, 32,112, 97,
-     100,100,105,110,103, 58, 32, 48, 46, 53,101,109, 59, 10,125, 10, 10,
+      97, 48, 99, 48,102,102, 59, 10,125, 10, 10,116,100, 32,112, 32,123,
+      10, 32,109, 97,114,103,105,110, 58, 32, 48, 59, 10,125, 10, 10,115,
+     112, 97,110, 46, 98, 97,114,116,105,116,108,101, 32,123, 10, 32, 32,
+     102,111,110,116, 45,119,101,105,103,104,116, 58, 32, 98,111,108,100,
+      59, 10, 32, 32,102,111,110,116, 45,115,116,121,108,101, 58, 32,105,
+     116, 97,108,105, 99, 59, 10, 32, 32, 99,111,108,111,114, 58, 32,100,
+      97,114,107, 98,108,117,101, 10,125, 10, 10,115,112, 97,110, 46,102,
+     111,111,116,101,114, 32,123, 10, 32, 32,102,111,110,116, 45,115,116,
+     121,108,101, 58, 32,105,116, 97,108,105, 99, 59, 10, 32, 32, 99,111,
+     108,111,114, 58, 32,100, 97,114,107, 98,108,117,101, 10,125, 10, 10,
       47, 42, 32,100,101,102,105,110,105,116,105,111,110, 32,108,105,115,
-     116, 58, 32,116,101,114,109, 32, 42, 47, 10,100,116, 32,123, 10, 32,
-     102,108,111, 97,116, 58, 32,108,101,102,116, 59, 10, 32, 99,108,101,
-      97,114, 58, 32,108,101,102,116, 59, 10, 32,119,105,100,116,104, 58,
-      32, 97,117,116,111, 59, 32, 47, 42, 32,110,111,114,109, 97,108,108,
-     121, 32, 98,114,111,119,115,101,114,115, 32,100,101,102, 97,117,108,
-     116, 32,119,105,100,116,104, 32,111,102, 32,108, 97,114,103,101,115,
-     116, 32,105,116,101,109, 32, 42, 47, 10, 32,112, 97,100,100,105,110,
-     103, 45,114,105,103,104,116, 58, 32, 50, 48,112,120, 59, 10, 32,102,
-     111,110,116, 45,119,101,105,103,104,116, 58, 32, 98,111,108,100, 59,
-      10, 32, 99,111,108,111,114, 58, 32,100, 97,114,107,103,114,101,101,
-     110, 59, 10,125, 10, 10, 47, 42, 32,100,101,102,105,110,105,116,105,
-     111,110, 32,108,105,115,116, 58, 32,100,101,115, 99,114,105,112,116,
-     105,111,110, 32, 42, 47, 10,100,100, 32,123, 10, 32,109, 97,114,103,
-     105,110, 58, 32, 48, 32, 48, 32, 48, 32, 49, 49, 48,112,120, 59, 10,
-      32,112, 97,100,100,105,110,103, 58, 32, 48, 32, 48, 32, 48, 46, 53,
-     101,109, 32, 48, 59, 10,125, 10, 10, 47, 42, 32,102,111,114, 32, 98,
-     114,111,119,115,101,114,115, 32,105,110, 32,115,116, 97,110,100, 97,
-     114,100,115, 32, 99,111,109,112,108,105, 97,110, 99,101, 32,109,111,
-     100,101, 32, 42, 47, 10,116,100, 32,112, 32,123, 10, 32, 32,109, 97,
-     114,103,105,110, 58, 32, 48, 59, 10,125, 10);
+     116, 32, 42, 47, 10,100,108, 32,123, 10, 32, 98,111,114,100,101,114,
+      58, 32, 51,112,120, 32,100,111,117, 98,108,101, 32, 35, 99, 99, 99,
+      59, 10, 32,112, 97,100,100,105,110,103, 58, 32, 48, 46, 53,101,109,
+      59, 10,125, 10, 10, 47, 42, 32,100,101,102,105,110,105,116,105,111,
+     110, 32,108,105,115,116, 58, 32,116,101,114,109, 32, 42, 47, 10,100,
+     116, 32,123, 10, 32,102,108,111, 97,116, 58, 32,108,101,102,116, 59,
+      10, 32, 99,108,101, 97,114, 58, 32,108,101,102,116, 59, 10, 32,119,
+     105,100,116,104, 58, 32, 97,117,116,111, 59, 32, 47, 42, 32,110,111,
+     114,109, 97,108,108,121, 32, 98,114,111,119,115,101,114,115, 32,100,
+     101,102, 97,117,108,116, 32,119,105,100,116,104, 32,111,102, 32,108,
+      97,114,103,101,115,116, 32,105,116,101,109, 32, 42, 47, 10, 32,112,
+      97,100,100,105,110,103, 45,114,105,103,104,116, 58, 32, 50, 48,112,
+     120, 59, 10, 32,102,111,110,116, 45,119,101,105,103,104,116, 58, 32,
+      98,111,108,100, 59, 10, 32, 99,111,108,111,114, 58, 32,100, 97,114,
+     107,103,114,101,101,110, 59, 10,125, 10, 10, 47, 42, 32,100,101,102,
+     105,110,105,116,105,111,110, 32,108,105,115,116, 58, 32,100,101,115,
+      99,114,105,112,116,105,111,110, 32, 42, 47, 10,100,100, 32,123, 10,
+      32,109, 97,114,103,105,110, 58, 32, 48, 32, 48, 32, 48, 32, 49, 49,
+      48,112,120, 59, 10, 32,112, 97,100,100,105,110,103, 58, 32, 48, 32,
+      48, 32, 48, 46, 53,101,109, 32, 48, 59, 10,125, 10, 10, 47, 42, 32,
+     102,111,114, 32, 98,114,111,119,115,101,114,115, 32,105,110, 32,115,
+     116, 97,110,100, 97,114,100,115, 32, 99,111,109,112,108,105, 97,110,
+      99,101, 32,109,111,100,101, 32, 42, 47, 10,116,100, 32,112, 32,123,
+      10, 32, 32,109, 97,114,103,105,110, 58, 32, 48, 59, 10,125, 10, 10,
+     115,112, 97,110, 46,116,111,103,103,108,101,116,114,101,101, 99,108,
+     111,115,101, 32,123, 10, 32, 32, 32, 32, 98, 97, 99,107,103,114,111,
+     117,110,100, 58, 32,117,114,108, 40,109,105,110,117,115, 46,112,110,
+     103, 41, 32, 99,101,110,116,101,114, 32,108,101,102,116, 32,110,111,
+      45,114,101,112,101, 97,116, 59, 10, 32, 32, 32, 32,112, 97,100,100,
+     105,110,103, 45,108,101,102,116, 58, 32, 50, 48,112,120, 59, 10,125,
+      10,115,112, 97,110, 46,116,111,103,103,108,101,116,114,101,101,111,
+     112,101,110, 32,123, 10, 32, 32, 32, 32, 98, 97, 99,107,103,114,111,
+     117,110,100, 58, 32,117,114,108, 40,112,108,117,115, 46,112,110,103,
+      41, 32, 99,101,110,116,101,114, 32,108,101,102,116, 32,110,111, 45,
+     114,101,112,101, 97,116, 59, 10, 32, 32, 32, 32,112, 97,100,100,105,
+     110,103, 45,108,101,102,116, 58, 32, 50, 48,112,120, 59, 10,125, 10,
+      10,117,108, 46, 99,108, 97,115,115,116,114,101,101,108,105,115,116,
+      32,108,105, 32,123, 32,112, 97,100,100,105,110,103, 45,108,101,102,
+     116, 58, 32, 48,112,120, 59, 32,125, 10, 10,117,108, 46, 99,108, 97,
+     115,115,116,114,101,101,108,105,115,116, 32,123, 32,108,105,115,116,
+      45,115,116,121,108,101, 45,116,121,112,101, 58,110,111,110,101, 59,
+      32,125, 10, 10,108,105, 46, 99,108, 97,115,115,116,114,101,101, 32,
+     117,108, 32,123, 32,100,105,115,112,108, 97,121, 58, 32, 98,108,111,
+      99,107, 59, 32,125, 10, 32, 10,108,105, 46, 99,108, 97,115,115,116,
+     114,101,101, 99,108,111,115,101,100, 32,117,108, 32,123, 32,100,105,
+     115,112,108, 97,121, 58, 32,110,111,110,101, 59, 32,125, 10);
diff --git a/utils/fpdoc/dglobals.pp b/utils/fpdoc/dglobals.pp
index f4e4e2fdaf..1d43a97562 100644
--- a/utils/fpdoc/dglobals.pp
+++ b/utils/fpdoc/dglobals.pp
@@ -144,6 +144,8 @@ resourcestring
   SCopyright2      = '(c) 2005 - 2012 various FPC contributors';
 
   SCmdLineHelp     = 'Usage: %s [options]';
+  SUsageOption008  = '--base-descr-dir=DIR prefix all description files with this directory';
+  SUsageOption009  = '--base-input-dir=DIR prefix all input files with this directory';
   SUsageOption010  = '--content         Create content file for package cross-references';
   SUsageOption020  = '--cputarget=value Set the target CPU for the scanner.';
   SUsageOption030  = '--descr=file      use file as description file, e.g.: ';
@@ -159,6 +161,7 @@ resourcestring
   SUsageOption120  = '                  At least one input option is required.';
   SUsageOption130  = '--input-dir=Dir   Add All *.pp and *.pas files in Dir to list of input files';
   SUsageOption140  = '--lang=lng        Select output language.';
+  SUsageOption145  = '--macro=name=value Define a macro to preprocess the project file with.';
   SUsageOption150  = '--ostarget=value  Set the target OS for the scanner.';
   SUsageOption160  = '--output=name     use name as the output name.';
   SUsageOption170  = '                  Each backend interprets this as needed.';
@@ -181,6 +184,7 @@ resourcestring
   SUsageFormats        = 'The following output formats are supported by this fpdoc:';
   SUsageBackendHelp    = 'Specify an output format, combined with --help to get more help for this backend.';
   SUsageFormatSpecific = 'Output format "%s" supports the following options:';
+  SCmdLineErrInvalidMacro     = 'Macro needs to be in the form name=value';
 
   SCmdLineInvalidOption       = 'Ignoring unknown option "%s"';
   SCmdLineInvalidFormat       = 'Invalid format "%s" specified';
@@ -633,6 +637,7 @@ begin
   FreeAndNil(DescrDocNames);
   FreeAndNil(DescrDocs);
   FreeAndNil(FAlwaysVisible);
+  FreeAndNil(FPackages);
   inherited Destroy;
 end;
 
@@ -710,9 +715,9 @@ var
     end;
   end;
 
-  function ResolvePackageModule(AName:String;var pkg:TPasPackage;var module:TPasModule;createnew:boolean):String;
+  function ResolvePackageModule(AName:String;out pkg:TPasPackage;out module:TPasModule;createnew:boolean):String;
     var
-      DotPos, DotPos2, i,j: Integer;
+      DotPos, DotPos2, i: Integer;
       s: String;
       HPackage: TPasPackage;
 
@@ -808,7 +813,6 @@ var
 
     function CreateClass(const AName: String;InheritanceStr:String): TPasClassType;
     var
-      DotPos, DotPos2, i,j: Integer;
       s: String;
       HPackage: TPasPackage;
       Module: TPasModule;
@@ -1445,9 +1449,7 @@ Var
   end;
 
 var
-  i: Integer;
   Node, Subnode, Subsubnode: TDOMNode;
-  Element: TDOMElement;
   Doc: TXMLDocument;
   PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
 
@@ -1600,9 +1602,6 @@ end;
 
 function TFPDocEngine.FindLinkedNode(ANode : TDocNode) : TDocNode;
 
-Var
-  S: String;
-
 begin
   If (ANode.Link='') then
     Result:=Nil
diff --git a/utils/fpdoc/dw_html.pp b/utils/fpdoc/dw_html.pp
index f41fe543da..8395148790 100644
--- a/utils/fpdoc/dw_html.pp
+++ b/utils/fpdoc/dw_html.pp
@@ -1938,6 +1938,8 @@ var
   TREl, TDEl: TDOMElement;
   CurVariant: TPasVariant;
   isExtended : Boolean;
+  VariantEl: TPasElement;
+  VariantType: TPasType;
 
 begin
   if not (Element.Parent is TPasVariant) then
@@ -1972,18 +1974,21 @@ begin
       AppendSym(CodeEl, ';');
     end;
 
-  if Assigned(Element.VariantType) then
+  if Assigned(Element.VariantEl) then
   begin
     TREl := CreateTR(TableEl);
     CodeEl := CreateCode(CreatePara(CreateTD_vtop(TREl)));
     AppendNbSp(CodeEl, NestingLevel * 2 + 2);
     AppendKw(CodeEl, 'case ');
-    if TPasRecordType(Element).VariantName <> '' then
+    VariantEl:=TPasRecordType(Element).VariantEl;
+    if VariantEl is TPasVariable then
     begin
-      AppendText(CodeEl, TPasRecordType(Element).VariantName);
+      AppendText(CodeEl, TPasVariable(VariantEl).Name);
       AppendSym(CodeEl, ': ');
-    end;
-    CodeEl := AppendType(CodeEl, TableEl, TPasRecordType(Element).VariantType, True);
+      VariantType:=TPasVariable(VariantEl).VarType;
+    end else
+      VariantType:=VariantEl as TPasType;
+    CodeEl := AppendType(CodeEl, TableEl, VariantType, True);
     AppendKw(CodeEl, ' of');
     for i := 0 to TPasRecordType(Element).Variants.Count - 1 do
     begin
@@ -2471,7 +2476,7 @@ begin
     try
       B.BuildTree(AList);
       // Classes
-      WriteXMLFile(B.ClassTree,'tree.xml');
+      // WriteXMLFile(B.ClassTree,'tree.xml');
       // Dummy TObject
       E:=B.ClassTree.DocumentElement;
       PushClassList;
diff --git a/utils/fpdoc/dw_ipflin.pas b/utils/fpdoc/dw_ipflin.pas
index 0c8a282b25..7df128caeb 100644
--- a/utils/fpdoc/dw_ipflin.pas
+++ b/utils/fpdoc/dw_ipflin.pas
@@ -72,8 +72,8 @@ type
     Procedure StartAccess; override;
     Procedure StartErrors; override;
     Procedure StartVersion; override;
-    Procedure StartSeealso; override;
-    Procedure EndSeealso; override;
+    Procedure StartSeeAlso; override;
+    Procedure EndSeeAlso; override;
     procedure StartUnitOverview(AModuleName,AModuleLabel : String);override;
     procedure WriteUnitEntry(UnitRef : TPasType); override;
     Procedure EndUnitOverview; override;
@@ -1068,7 +1068,7 @@ begin
   WriteLn(Format(':pd. %s', [ADescr]));
 end;
 
-procedure TIPFNewWriter.StartSeealso;
+procedure TIPFNewWriter.StartSeeAlso;
 begin
   writeln('');
   writeln(':p.');
@@ -1078,7 +1078,7 @@ begin
   writeln('.br');
 end;
 
-procedure TIPFNewWriter.EndSeealso;
+procedure TIPFNewWriter.EndSeeAlso;
 begin
   writeln('');
 end;
diff --git a/utils/fpdoc/dw_man.pp b/utils/fpdoc/dw_man.pp
index 0ddc8c5e2c..4d8f2e4856 100644
--- a/utils/fpdoc/dw_man.pp
+++ b/utils/fpdoc/dw_man.pp
@@ -1001,7 +1001,7 @@ var
 
 begin
   DocNode:=Engine.FindDocNode(Package);
-  If (PackageDescr='') then
+  If (PackageDescr='') and assigned(DocNode) then
     PackageDescr:=GetDescrString(Package,DocNode.ShortDescr);
   StartManPage(Package,DocNode);
   Try
@@ -1025,7 +1025,10 @@ begin
         WriteB(L[i]);
         M:=TPasModule(L.Objects[i]);
         D:=Engine.FindDocNode(M);
-        WriteLn(GetDescrString(M,D.ShortDescr))
+        if Assigned(D) then
+          WriteLn(GetDescrString(M,D.ShortDescr))
+        else
+          WriteLn(GetDescrString(M,Nil))
         end;
       StartSection(SDocSeeAlso);
       WriteSeeAlso(DocNode,True);
@@ -1151,14 +1154,17 @@ procedure TManWriter.WriteUnitPage(AModule : TPasModule);
 
 Var
   DocNode : TDocNode;
-
+  S : String;
 begin
   DocNode:=Engine.FindDocNode(AModule);
   StartManPage(AModule,DocNode);
   Try
     PageTitle(AModule.Name,ManSection,PackageName,PackageDescr);
     StartSection(SManDocName);
-    Writeln(DocNode.Name+' \- '+GetDescrString(AModule,DocNode.ShortDescr));
+    if Assigned(DocNode) then
+      S:=GetDescrString(AModule,DocNode.ShortDescr);
+
+    Writeln(AModule.Name+' \- '+S);
     if Assigned(DocNode) and not IsDescrNodeEmpty(DocNode.Descr) then
       begin
       StartSection(SManDocDescription);
diff --git a/utils/fpdoc/dw_xml.pp b/utils/fpdoc/dw_xml.pp
index b9e435e834..6925c45ac0 100644
--- a/utils/fpdoc/dw_xml.pp
+++ b/utils/fpdoc/dw_xml.pp
@@ -100,7 +100,7 @@ var
       Node['virtual'] := 'true';
     if pmAbstract in ADecl.Modifiers then
       Node['abstract'] := 'true';
-    if pmStatic in ADecl.Modifiers then
+    if assigned(ADecl.ProcType) and (ptmStatic in ADecl.ProcType.Modifiers) then
       Node['static'] := 'true';
     if pmReintroduce in ADecl.Modifiers then
       Node['reintroduce'] := 'true';
diff --git a/utils/fpdoc/dwlinear.pp b/utils/fpdoc/dwlinear.pp
index 8835c58171..ef485e64ad 100644
--- a/utils/fpdoc/dwlinear.pp
+++ b/utils/fpdoc/dwlinear.pp
@@ -396,10 +396,12 @@ var
   Member: TPasElement;
   i: Integer;
 begin
+  DocNode := Engine.FindDocNode(ClassDecl);
+  if Assigned(DocNode) and DocNode.IsSkipped then
+    Exit;
   StartSection(ClassDecl.Name);
   WriteLabel(ClassDecl);
   WriteIndex(ClassDecl);
-  DocNode := Engine.FindDocNode(ClassDecl);
   if Assigned(DocNode) and ((not IsDescrNodeEmpty(DocNode.Descr)) or
     (not IsDescrNodeEmpty(DocNode.ShortDescr))) then
   begin
@@ -482,6 +484,8 @@ begin
         L:=StripText(GetLabel(Member));
         N:=EscapeText(Member.Name);
         DocNode := Engine.FindDocNode(Member);
+        if Assigned(DocNode) and DocNode.IsSkipped then
+          Continue;
         if Assigned(DocNode) then
         begin
           if FDupLinkedDoc and (DocNode.Link <> '') then
@@ -544,6 +548,8 @@ begin
         L := StripText(GetLabel(lInterface));
         N := EscapeText(lInterface.Name);
         DocNode := Engine.FindDocNode(lInterface);
+        if Assigned(DocNode) and DocNode.IsSkipped then
+          Continue;
         if Assigned(DocNode) then
         begin
           if FDupLinkedDoc and (DocNode.Link <> '') then
@@ -595,7 +601,7 @@ begin
   If (Engine.OutPut='') then
     Engine.Output:=PackageName+FileNameExtension
   else if (ExtractFileExt(Engine.output)='') and (FileNameExtension<>'') then
-    Engine.Output:=ChangeFileExt(Engine.output,FileNameExtension);  
+    Engine.Output:=ChangeFileExt(Engine.output,FileNameExtension);
   FStream:=TFileStream.Create(Engine.Output,fmCreate);
   try
     WriteBeginDocument;
@@ -875,12 +881,14 @@ begin
     for i := 0 to ASection.Types.Count - 1 do
       begin
       TypeDecl := TPasType(ASection.Types[i]);
+      DocNode := Engine.FindDocNode(TypeDecl);
+      if Assigned(DocNode) and DocNode.IsSkipped then
+        Continue;
       if not ((TypeDecl is TPasRecordType) and TPasRecordType(TypeDecl).IsAdvancedRecord) then
         begin
         DescrBeginParagraph;
         WriteTypeDecl(TypeDecl);
         StartListing(False,'');
-        DocNode := Engine.FindDocNode(TypeDecl);
         If Assigned(DocNode) and
            Assigned(DocNode.Node) and
            (Docnode.Node['opaque']='1') then
@@ -953,6 +961,9 @@ var
 begin
   With ProcDecl do
     begin
+    DocNode := Engine.FindDocNode(ProcDecl);
+    if Assigned(DocNode) and DocNode.IsSkipped then
+      Exit;
     if Not (Assigned(Parent) and ((Parent.InheritsFrom(TPasClassType)) or Parent.InheritsFrom(TPasRecordType))) then
       begin
       StartSubSection(Name);
@@ -966,7 +977,6 @@ begin
       WriteIndex(Parent.Name+'.'+Name);
       end;
     StartProcedure;
-    DocNode := Engine.FindDocNode(ProcDecl);
     if Assigned(DocNode) and Assigned(DocNode.ShortDescr) then
       begin
       StartSynopsis;
@@ -1065,11 +1075,13 @@ var
 begin
   With PropDecl do
     begin
+    DocNode := Engine.FindDocNode(PropDecl);
+    if Assigned(DocNode) and DocNode.IsSkipped then
+      Exit;
     StartSubSection(Parent.Name+'.'+Name);
     WriteLabel(PropDecl);
     WriteIndex(Parent.Name+'.'+Name);
     StartProperty;
-    DocNode := Engine.FindDocNode(PropDecl);
     if Assigned(DocNode) then
     begin
       if FDupLinkedDoc and (DocNode.Link <> '') then
@@ -1288,6 +1300,8 @@ begin
         L:=StripText(GetLabel(Member));
         N:=EscapeText(Member.Name);
         DocNode := Engine.FindDocNode(Member);
+        if Assigned(DocNode) and DocNode.IsSkipped then
+          Continue;
         If Assigned(DocNode) then
           S:=GetDescrString(Member, DocNode.ShortDescr)
         else
diff --git a/utils/fpdoc/examples/basedir/readme.txt b/utils/fpdoc/examples/basedir/readme.txt
new file mode 100644
index 0000000000..57f5fddd22
--- /dev/null
+++ b/utils/fpdoc/examples/basedir/readme.txt
@@ -0,0 +1,11 @@
+This directory demonstrates the use of a fpdoc project file.
+It uses the files in the examples/simple directory.
+
+The project file contains the names of the files without paths.
+That means that fpdoc must be executed from this directory, 
+supplying the paths to the input and description files
+
+fpdoc --project=sample-project.xml --base-input-dir=../simple --base-descr-dir=../simple
+
+The docs will be written to a subdirectory doc. 
+This directory can be deleted if it is no longer necessary.
diff --git a/utils/fpdoc/examples/basedir/sample-project.xml b/utils/fpdoc/examples/basedir/sample-project.xml
new file mode 100644
index 0000000000..a9d32738d9
--- /dev/null
+++ b/utils/fpdoc/examples/basedir/sample-project.xml
@@ -0,0 +1,29 @@
+<docproject>
+  <packages>
+    <!-- Multiple packages can be entered. 
+         If only one is specified, it is selected. 
+         "name" is a mandatory attribute
+         a "units" tag is required, and a "descriptions" tag as well
+    -->
+    <package name="fpdocsample" output="doc" contentfile="fpdocsample.cnt">
+      <!-- All input files, one "unit" tag per unit -->
+      <units>
+        <!-- "file" is a mandatory attribute, "options" is not mandatory -->
+        <unit file="testunit.pp" options="-S2"/>
+      </units>
+      <descriptions>
+        <!-- Description files here. One "description" tag per file.
+            "file" is the only mandatory attribute -->
+        <description file="testunit.xml"/>
+      </descriptions>
+    </package>
+  </packages>
+  <options>
+    <!-- All command-line options can be specified here with the same name
+         and value as on the actual command-line. Boolean options must have
+         a value of 'true', '1' or 'yes' -->
+    <option name="format" value="html"/>
+    <option name="hide-protected" value="true"/>
+    <option name="footer-date" value="yyyy-mm-dd"/>
+  </options>
+</docproject>
\ No newline at end of file
diff --git a/utils/fpdoc/gentest.sh b/utils/fpdoc/examples/gentest.sh
index aff9eababf..aff9eababf 100644
--- a/utils/fpdoc/gentest.sh
+++ b/utils/fpdoc/examples/gentest.sh
diff --git a/utils/fpdoc/examples/project/readme.txt b/utils/fpdoc/examples/project/readme.txt
new file mode 100644
index 0000000000..5915c5a95e
--- /dev/null
+++ b/utils/fpdoc/examples/project/readme.txt
@@ -0,0 +1,10 @@
+This directory demonstrates the use of a fpdoc project file.
+It uses the files in the examples/simple directory.
+
+The project file contains the names of the files with relative paths.
+That means that fpdoc must be executed from this directory:
+
+fpdoc --project=sample-project.xml
+
+The docs will be written to a subdirectory doc. 
+This directory can be deleted if it is no longer necessary.
diff --git a/utils/fpdoc/examples/project/sample-project.xml b/utils/fpdoc/examples/project/sample-project.xml
new file mode 100644
index 0000000000..677bfa24c8
--- /dev/null
+++ b/utils/fpdoc/examples/project/sample-project.xml
@@ -0,0 +1,29 @@
+<docproject>
+  <packages>
+    <!-- Multiple packages can be entered. 
+         If only one is specified, it is selected. 
+         "name" is a mandatory attribute
+         a "units" tag is required, and a "descriptions" tag as well
+    -->
+    <package name="fpdocsample" output="doc" contentfile="fpdocsample.cnt">
+      <!-- All input files, one "unit" tag per unit -->
+      <units>
+        <!-- "file" is a mandatory attribute, "options" is not mandatory -->
+        <unit file="../simple/testunit.pp" options="-S2"/>
+      </units>
+      <descriptions>
+        <!-- Description files here. One "description" tag per file.
+            "file" is the only mandatory attribute -->
+        <description file="../simple/testunit.xml"/>
+      </descriptions>
+    </package>
+  </packages>
+  <options>
+    <!-- All command-line options can be specified here with the same name
+         and value as on the actual command-line. Boolean options must have
+         a value of 'true', '1' or 'yes' -->
+    <option name="format" value="html"/>
+    <option name="hide-protected" value="true"/>
+    <option name="footer-date" value="yyyy-mm-dd"/>
+  </options>
+</docproject>
\ No newline at end of file
diff --git a/utils/fpdoc/examples/simple/html.bat b/utils/fpdoc/examples/simple/html.bat
new file mode 100644
index 0000000000..f2d7401104
--- /dev/null
+++ b/utils/fpdoc/examples/simple/html.bat
@@ -0,0 +1,2 @@
+rem Command line to create html docs.
+fpdoc --package=fpdocsample --output=doc --format=html --input="-S2 testunit.pp" --descr=testunit.xml
diff --git a/utils/fpdoc/examples/simple/html.sh b/utils/fpdoc/examples/simple/html.sh
new file mode 100644
index 0000000000..de9e772e9c
--- /dev/null
+++ b/utils/fpdoc/examples/simple/html.sh
@@ -0,0 +1,2 @@
+#!/bin/sh
+fpdoc --package=fpdocsample --output=doc --format=html --input='-S2 testunit.pp' --descr=testunit.xml
diff --git a/utils/fpdoc/examples/simple/readme.txt b/utils/fpdoc/examples/simple/readme.txt
new file mode 100644
index 0000000000..a1f2de4109
--- /dev/null
+++ b/utils/fpdoc/examples/simple/readme.txt
@@ -0,0 +1,9 @@
+This directory contains the files for the projects.
+
+You can create HTML documentation using just the command-line by executing the
+following command in this directory:
+
+(on 1 line)
+fpdoc --package=fpdocsample --output=doc --format=html --input='-S2 testunit.pp' --descr=testunit.xml
+
+Sample command-lines can be found in html.sh and html.bat
diff --git a/utils/fpdoc/testunit.pp b/utils/fpdoc/examples/simple/testunit.pp
index 615b8ac28a..615b8ac28a 100644
--- a/utils/fpdoc/testunit.pp
+++ b/utils/fpdoc/examples/simple/testunit.pp
diff --git a/utils/fpdoc/testunit.xml b/utils/fpdoc/examples/simple/testunit.xml
index 794022e81c..794022e81c 100644
--- a/utils/fpdoc/testunit.xml
+++ b/utils/fpdoc/examples/simple/testunit.xml
diff --git a/utils/fpdoc/fpclasschart.pp b/utils/fpdoc/fpclasschart.pp
index a3a68f64e9..b70ebb4d37 100644
--- a/utils/fpdoc/fpclasschart.pp
+++ b/utils/fpdoc/fpclasschart.pp
@@ -25,7 +25,6 @@ resourcestring
   STitle = 'fpClassTree - Create class tree from pascal sources';
   SVersion = 'Version %s [%s]';
   SCopyright = '(c) 2008 - Michael Van Canneyt, michael@freepascal.org';
-  SCmdLineHelp = 'See documentation for usage.';
   SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
   SDone = 'Done.';
   SSkipMerge = 'Cannot merge %s into %s tree.';
@@ -91,9 +90,6 @@ type
 
 { TClassTreeBuilder }
 
-
-
-
 { TChartFormatter }
 
 constructor TClassChartFormatter.Create(AXML: TXMLDocument);
@@ -216,7 +212,6 @@ end;
 procedure TClassChartFormatter.EmitClass(E : TDomElement; HasSiblings: Boolean);
 
 Var
-  DidSub : Boolean;
   N : TDomNode;
   I : Integer;
   L : TFPList;
@@ -238,7 +233,6 @@ begin
       end;
     DoEmitClass(E);
     N:=E.FirstChild;
-    DidSub:=False;
     L:=TFPList.Create;
     try
       While (N<>Nil) do
@@ -435,8 +429,6 @@ function TClassTreeEngine.CreateElement(AClass: TPTreeElement; const AName: Stri
   AParent: TPasElement; AVisibility : TPasMemberVisibility;
   const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
 
-Var
-  DN : TDocNode;
 
 begin
   Result := AClass.Create(AName, AParent);
@@ -444,7 +436,10 @@ begin
   if AClass.InheritsFrom(TPasModule) then
     CurModule := TPasModule(Result);
   If AClass.InheritsFrom(TPasClassType) then
+    begin
     FObjects.AddObject(AName,Result);
+   // Writeln('Added : ',AName);
+    end;
 end;
 
 Constructor TClassTreeEngine.Create(AClassTree : TXMLDocument; AObjectKind : TPasObjKind);
@@ -459,6 +454,8 @@ end;
 
 destructor TClassTreeEngine.Destroy;
 begin
+  FreeAndNil(FTree);
+  FreeAndNil(FPackage);
   FreeAndNil(FObjects);
   inherited Destroy;
 end;
@@ -476,6 +473,7 @@ Var
 
 
 begin
+  Result:=0;
   N:=Source.FirstChild;
   While (N<>Nil) do
     begin
@@ -501,7 +499,6 @@ Function MergeTrees (Dest,Source : TXMLDocument) : Integer;
 
 Var
   S,D : TDomElement;
-  Count : Integer;
 
 begin
   Result:=0;
@@ -522,30 +519,32 @@ Var
   Engine: TClassTreeEngine;
 
 begin
+  Result:='';
+  ACount:=0;
   XML:=TXMLDocument.Create;
   Try
     //XML.
-    XML.AppendChild(XML.CreateElement(ObjKindNames[AObjectKind]));
+    XML.AppendChild(XML.CreateElement('TObject'));
     For I:=0 to MergeFiles.Count-1 do
       begin
       XMl2:=TXMLDocument.Create;
       ReadXMLFile(XML2,MergeFiles[i]);
       try
-        ACount:=MergeTrees(XML,XML2);
+        ACount:=ACount+MergeTrees(XML,XML2);
         WriteLn(StdErr,Format(SMergedFile,[ACount,MergeFiles[i]]));
       Finally
         FreeAndNil(XML2);
       end;
       end;
-    ACount:=0;
     For I:=0 to InputFiles.Count-1 do
       begin
       Engine := TClassTreeEngine.Create(XML,AObjectKind);
       Try
         ParseSource(Engine,InputFiles[I],OSTarget,CPUTarget);
-        ACount:=ACount+Engine.Ftree.BuildTree(Engine.FObjects);
+        Engine.Ftree.BuildTree(Engine.FObjects);
+        ACount:=ACount+MergeTrees(XML,Engine.FTree.ClassTree);
       Finally
-        Engine.Free;
+        FreeAndNil(Engine);
       end;
       end;
     Case OutputFormat of
@@ -584,7 +583,6 @@ var
   InputFiles, 
   MergeFiles : TStringList;
   DocLang : String;
-  PackageName, 
   OutputName: String;
 
 procedure InitOptions;
diff --git a/utils/fpdoc/fpdoc.css b/utils/fpdoc/fpdoc.css
index 09218e5384..39eb15dc8d 100644
--- a/utils/fpdoc/fpdoc.css
+++ b/utils/fpdoc/fpdoc.css
@@ -127,6 +127,10 @@ table.bar {
   background-color: #a0c0ff;
 }
 
+td p {
+ margin: 0;
+}
+
 span.bartitle {
   font-weight: bold;
   font-style: italic;
@@ -164,3 +168,20 @@ dd {
 td p {
   margin: 0;
 }
+
+span.toggletreeclose {
+    background: url(minus.png) center left no-repeat;
+    padding-left: 20px;
+}
+span.toggletreeopen {
+    background: url(plus.png) center left no-repeat;
+    padding-left: 20px;
+}
+
+ul.classtreelist li { padding-left: 0px; }
+
+ul.classtreelist { list-style-type:none; }
+
+li.classtree ul { display: block; }
+ 
+li.classtreeclosed ul { display: none; }
diff --git a/utils/fpdoc/fpdoc.pp b/utils/fpdoc/fpdoc.pp
index 39f1c928e9..999e31efb5 100644
--- a/utils/fpdoc/fpdoc.pp
+++ b/utils/fpdoc/fpdoc.pp
@@ -73,6 +73,8 @@ Var
 
 begin
   Writeln(Format(SCmdLineHelp,[ExtractFileName(Paramstr(0))]));
+  Writeln(SUsageOption008);
+  Writeln(SUsageOption009);
   Writeln(SUsageOption010);
   Writeln(SUsageOption020);
   Writeln(SUsageOption030);
@@ -88,6 +90,7 @@ begin
   Writeln(SUsageOption120);
   Writeln(SUsageOption130);
   Writeln(SUsageOption140);
+  Writeln(SUsageOption145);
   Writeln(SUsageOption150);
   Writeln(SUsageOption160);
   Writeln(SUsageOption170);
@@ -179,11 +182,12 @@ procedure TFPDocApplication.ParseCommandLine;
 Const
   SOptProject = '--project=';
   SOptPackage = '--package=';
-  
+  SOptMacro = '--macro=';
+
   Function ProjectOpt(Const s : string) : boolean;
 
   begin
-    Result:=(Copy(s,1,3)='-p=') or (Copy(s,1,Length(SOptProject))=SOptProject);
+    Result:=(Copy(s,1,3)='-p=') or (Copy(s,1,Length(SOptProject))=SOptProject) or (Copy(s,1,Length(SOptMacro))=SOptMacro);
   end;
 
   Function PackageOpt(Const s : string) : boolean;
@@ -284,7 +288,7 @@ procedure TFPDocApplication.ParseOption(Const S : String);
 
 var
   i: Integer;
-  Cmd, Arg: String;
+  ProjectFileName,Cmd, Arg: String;
 
 begin
   if (s = '-h') or (s = '--help') then
@@ -321,6 +325,14 @@ begin
       AddToFileList(SelectedPackage.Descriptions, Arg)
     else if (Cmd = '--descr-dir') then
       AddDirToFileList(SelectedPackage.Descriptions, Arg, '*.xml')
+    else if (Cmd = '--base-descr-dir') then
+      FCreator.BaseDescrDir:=Arg
+    else if (Cmd = '--macro') then
+      begin
+      If Pos('=',Arg)=0 then
+        WriteLn(StdErr, Format(SCmdLineErrInvalidMacro, [Arg]));
+      FCreator.ProjectMacros.Add(Arg);
+      end
     else if (Cmd = '-f') or (Cmd = '--format') then
       begin
       Arg:=UpperCase(Arg);
@@ -333,6 +345,8 @@ begin
       FCreator.Options.Language := Arg
     else if (Cmd = '-i') or (Cmd = '--input') then
       AddToFileList(SelectedPackage.Inputs, Arg)
+    else if (Cmd = '--base-input-dir') then
+      FCreator.BaseInputDir:=Arg
     else if (Cmd = '--input-dir') then
       begin
       AddDirToFileList(SelectedPackage.Inputs, Arg,'*.pp');
@@ -378,23 +392,28 @@ end;
 Procedure TFPDocApplication.DoRun;
 
 begin
-{$IFDEF Unix}
-  gettext.TranslateResourceStrings('/usr/local/share/locale/%s/LC_MESSAGES/fpdoc.mo');
-{$ELSE}
-  gettext.TranslateResourceStrings('intl/fpdoc.%s.mo');
-{$ENDIF}
-  WriteLn(STitle);
-  WriteLn(Format(SVersion, [DefFPCVersion, DefFPCDate]));
-  WriteLn(SCopyright1);
-  WriteLn(SCopyright2);
-  WriteLn;
-  ParseCommandLine;
-  if (FWriteProjectFile<>'') then
-    FCreator.CreateProjectFile(FWriteProjectFile)
-  else
-    FCreator.CreateDocumentation(FPackage,FDryRun);
-  WriteLn(SDone);
-  Terminate;
+  try
+  {$IFDEF Unix}
+    gettext.TranslateResourceStrings('/usr/local/share/locale/%s/LC_MESSAGES/fpdoc.mo');
+  {$ELSE}
+    gettext.TranslateResourceStrings('intl/fpdoc.%s.mo');
+  {$ENDIF}
+    WriteLn(STitle);
+    WriteLn(Format(SVersion, [DefFPCVersion, DefFPCDate]));
+    WriteLn(SCopyright1);
+    WriteLn(SCopyright2);
+    WriteLn;
+    ParseCommandLine;
+    if (FWriteProjectFile<>'') then
+      FCreator.CreateProjectFile(FWriteProjectFile)
+    else
+      FCreator.CreateDocumentation(FPackage,FDryRun);
+    WriteLn(SDone);
+    Terminate;
+  except
+    ExitCode:=1;
+    Raise;
+  end;
 end;
 
 constructor TFPDocApplication.Create(AOwner: TComponent);
diff --git a/utils/fpdoc/fpdocclasstree.pp b/utils/fpdoc/fpdocclasstree.pp
index d383a1721f..fd12dbee20 100644
--- a/utils/fpdoc/fpdocclasstree.pp
+++ b/utils/fpdoc/fpdocclasstree.pp
@@ -18,7 +18,7 @@ Type
   Protected
     function LookForElement(PE: TDomElement; AElement: TPasElement; NoPath : Boolean): TDomNode;
     function NodeMatch(N: TDomNode; AElement: TPasElement; NoPath : Boolean): Boolean;
-    Function AddToClassTree(AElement : TPasElement; ACount : Integer) : TDomElement;
+    Function AddToClassTree(AElement : TPasElement; Var ACount : Integer) : TDomElement;
   Public
     Constructor Create(APackage : TPasPackage; AObjectKind : TPasObjKind = okClass);
     Destructor Destroy; override;
@@ -30,8 +30,7 @@ implementation
 
 constructor TClassTreeBuilder.Create(APackage : TPasPackage;
   AObjectKind: TPasObjKind);
-Var
-  N : TDomNode;
+
 begin
   FCLassTree:=TXMLDocument.Create;
   FPackage:=APAckage;
@@ -49,6 +48,7 @@ end;
 
 destructor TClassTreeBuilder.Destroy;
 begin
+  FreeAndNil(FParentObject);
   FreeAndNil(FClassTree);
   Inherited;
 end;
@@ -63,11 +63,9 @@ begin
   AObjects.Sorted:=True;
   For I:=0 to AObjects.Count-1 do
     begin
-    PC:=TPasClassType(AObjects.Objects[i]);
+    PC:=AObjects.Objects[i] as TPasClassType;
     If (PC.ObjKind=FObjectKind) and Not PC.IsForward then
-      begin
-      AddToClassTree(PC as TPasElement,Result)
-      end;
+      AddToClassTree(PC,Result);
     end;
 end;
 
@@ -83,7 +81,7 @@ begin
     S:=N.NodeName;
     if NoPath then
       Begin
-      Result:= (CompareText(S,AElement.Name)=0);
+      Result:=(CompareText(S,AElement.Name)=0);
       end
     else
       begin
@@ -92,7 +90,7 @@ begin
       else
         PN:=FPackage.Name;
       S:=PN+'.'+TDomElement(N)['unit']+'.'+S;
-      Result:= (CompareText(S,AElement.PathName)=0);
+      Result:=(CompareText(S,AElement.PathName)=0);
       end;
    end;
 end;
@@ -103,6 +101,7 @@ Var
   N : TDomNode;
 
 begin
+//  Writeln('Enter TClassTreeBuilderLookForElement');
   Result:=PE;
   While (Result<>Nil) and Not NodeMatch(Result,AElement,NoPath) do
     Result:=Result.NextSibling;
@@ -119,9 +118,10 @@ begin
         N:=N.NextSibling;
         end;
       end;
+//  Writeln('Exit TClassTreeBuilderLookForElement');
 end;
 
-Function TClassTreeBuilder.AddToClassTree(AElement : TPasElement; ACount : Integer) : TDomElement;
+Function TClassTreeBuilder.AddToClassTree(AElement : TPasElement; Var ACount : Integer) : TDomElement;
 // there are several codepaths that use uninitialized variables. (N,PE)
 // I initialized them to nil to at least make failures deterministic.
 Var
@@ -129,11 +129,13 @@ Var
   PE : TDomElement;
   M : TPasModule;
   N : TDomNode;
-  PF : String;
 
 begin
-  PF:=StringOfChar(' ',ACount);
-  Result:=Nil; N:=Nil;PE:=NIL;
+
+//  Writeln('Enter TClassTreeBuilder.AddToClassTree');
+  //if Assigned(AElement) then
+    //Writeln('Addtoclasstree : ',aElement.Name);
+  Result:=Nil; M:=Nil; N:=Nil;PE:=NIL;PC:=Nil;
   If (AElement=Nil) then
     begin
     Result:=FTreeStart;
@@ -143,9 +145,7 @@ begin
     begin
     N:=LookForElement(FTreeStart,AElement,True);
     If (N=Nil) then
-      begin
       PE:=FTreeStart;
-      end
     end
   else If (AElement is TPasClassType) then
     begin
@@ -154,14 +154,16 @@ begin
     else
       begin
       PC:=AElement as TPasClassType;
-      PE:=AddToClassTree(PC.AncestorType,ACount+1);
+      PE:=AddToClassTree(PC.AncestorType,ACount);
       if PE=Nil then
         PE:=FTreeStart;
       N:=LookForElement(PE,PC,False);
       end
     end;
   If (N<>Nil) then
+    begin
     Result:=N as TDomElement
+   end
   else if AElement.Name<>'' then
     begin // N=NIL, PE might be nil.
     Inc(ACount);
@@ -172,9 +174,13 @@ begin
       if Assigned(M) then
         Result['unit']:=M.Name;
       end;
-      if assigned(PE) then  // if not assigned, probably needs to be
-			    // assigned to something else.
-        PE.AppendChild(Result);
+    if PE=Nil then
+      begin
+      PE:=FTreeStart
+      end;
+    // if not assigned, probably needs to be assigned to something else.
+    if assigned(PE) then
+      PE.AppendChild(Result);
     end;
 end;
 
diff --git a/utils/fpdoc/fpdocxmlopts.pas b/utils/fpdoc/fpdocxmlopts.pas
index 203128c682..4a88ebb5d1 100644
--- a/utils/fpdoc/fpdocxmlopts.pas
+++ b/utils/fpdoc/fpdocxmlopts.pas
@@ -13,6 +13,7 @@ Type
   TXMLFPDocOptions = Class(TComponent)
   private
   Protected
+    Function PreProcessFile(const AFileName: String; Macros: TStrings): TStream; virtual;
     Procedure Error(Const Msg : String);
     Procedure Error(Const Fmt : String; Args : Array of Const);
     Procedure LoadPackage(APackage : TFPDocPackage; E : TDOMElement); virtual;
@@ -24,7 +25,7 @@ Type
     procedure SaveInputFile(const AInputFile: String; XML: TXMLDocument; AParent: TDOMElement);virtual;
     Procedure SavePackage(APackage : TFPDocPackage; XML : TXMLDocument; AParent : TDOMElement); virtual;
   Public
-    Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String);
+    Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName : String; Macros : TStrings = Nil);
     Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument); virtual;
     Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName : String);
     procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual;
@@ -65,7 +66,7 @@ begin
 end;
 
 
-procedure TXMLFPDocOptions.Error(Const Msg: String);
+procedure TXMLFPDocOptions.Error(const Msg: String);
 begin
   Raise EXMLFPDoc.Create(Msg);
 end;
@@ -248,7 +249,8 @@ begin
     end;
 end;
 
-Procedure TXMLFPDocOptions.SaveEngineOptions(Options : TEngineOptions; XML : TXMLDocument; AParent : TDOMElement);
+procedure TXMLFPDocOptions.SaveEngineOptions(Options: TEngineOptions;
+  XML: TXMLDocument; AParent: TDOMElement);
 
   procedure AddStr(const n, v: string);
   var
@@ -288,7 +290,8 @@ begin
 end;
 
 
-Procedure TXMLFPDocOptions.SaveInputFile(Const AInputFile : String; XML : TXMLDocument; AParent: TDOMElement);
+procedure TXMLFPDocOptions.SaveInputFile(const AInputFile: String;
+  XML: TXMLDocument; AParent: TDOMElement);
 
 Var
   F,O : String;
@@ -299,7 +302,8 @@ begin
   AParent['options']:=O;
 end;
 
-Procedure TXMLFPDocOptions.SaveDescription(Const ADescription : String; XML : TXMLDocument; AParent: TDOMElement);
+procedure TXMLFPDocOptions.SaveDescription(const ADescription: String;
+  XML: TXMLDocument; AParent: TDOMElement);
 
 begin
   AParent['file']:=ADescription;
@@ -317,7 +321,8 @@ begin
   AParent['prefix']:=Copy(AImportFile,i+1,Length(AImportFile));
 end;
 
-Procedure TXMLFPDocOptions.SavePackage(APackage: TFPDocPackage; XML : TXMLDocument; AParent: TDOMElement);
+procedure TXMLFPDocOptions.SavePackage(APackage: TFPDocPackage;
+  XML: TXMLDocument; AParent: TDOMElement);
 
 
 var
@@ -358,17 +363,55 @@ begin
 end;
 
 
+Function TXMLFPDocOptions.PreprocessFile(const AFileName: String; Macros : TStrings) : TStream;
+
+Var
+  F : TFileStream;
+  P : TTemplateParser;
+  I : Integer;
+  N,V : String;
+
+begin
+  Result:=Nil;
+  P:=Nil;
+  F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    P:=TTemplateParser.Create;
+    P.AllowTagParams:=False;
+    P.StartDelimiter:='{{';
+    P.EndDelimiter:='}}';
+    For I:=0 to Macros.Count-1 do
+      begin
+      Macros.GetNameValue(I,N,V);
+      P.Values[N]:=V;
+      end;
+    Result:=TMemoryStream.Create;
+    P.ParseStream(F,Result);
+    Result.Position:=0;
+  finally
+    FreeAndNil(F);
+    FreeAndNil(P);
+  end;
+end;
 
-procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject; const AFileName: String);
+procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject;
+  const AFileName: String; Macros: TStrings = Nil);
 
 Var
   XML : TXMLDocument;
+  S : TStream;
 
 begin
-  ReadXMLFile(XML,AFileName);
+  XML:=Nil;
+  if Macros=Nil then
+    S:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite)
+  else
+    S:=PreProcessFile(AFileName,Macros);
   try
+    ReadXMLFile(XML,S);
     LoadFromXML(AProject,XML);
   finally
+    FreeAndNil(S);
     FreeAndNil(XML);
   end;
 end;
@@ -393,7 +436,8 @@ begin
     LoadEngineOptions(AProject.Options,N as TDOMElement);
 end;
 
-Procedure TXMLFPDocOptions.SaveOptionsToFile(AProject: TFPDocProject; const AFileName: String);
+procedure TXMLFPDocOptions.SaveOptionsToFile(AProject: TFPDocProject;
+  const AFileName: String);
 
 Var
   XML : TXMLDocument;
diff --git a/utils/fpdoc/intl/dwriter.de.po b/utils/fpdoc/intl/dwriter.de.po
index ebe2f3f3d1..fb34cdd363 100644
--- a/utils/fpdoc/intl/dwriter.de.po
+++ b/utils/fpdoc/intl/dwriter.de.po
@@ -1,5 +1,5 @@
 #: dwriter:serrfilewriting
-msgid "An error occured during writing of file \"%s\": %s"
+msgid "An error occurred during writing of file \"%s\": %s"
 msgstr "Beim Schreiben der Datei \"%s\" ist ein Fehler aufgetrete: %s"
 
 #: dwriter:serrinvalidshortdescr
diff --git a/utils/fpdoc/makeskel.pp b/utils/fpdoc/makeskel.pp
index 3c5a9b7abe..b4b717abd4 100644
--- a/utils/fpdoc/makeskel.pp
+++ b/utils/fpdoc/makeskel.pp
@@ -50,12 +50,15 @@ type
     Property DocNode : TDocNode Read FNode;
   end;
 
+  { TSkelEngine }
+
   TSkelEngine = class(TFPDocEngine)
   Private
     FEmittedList, 
     FNodeList,
     FModules : TStringList;
     Procedure  DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
+    function EffectiveVisibility(El: TPasElement): TPasMemberVisibility;
   public
     Destructor Destroy; override;
     Function MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
@@ -132,43 +135,56 @@ Var
 begin
   If Assigned(FModules) then 
     begin
-    For I:=0 to FModules.Count-1 do
-      FModules.Objects[i].Free;
+   { For I:=0 to FModules.Count-1 do
+      FModules.Objects[i].Release;}
     FreeAndNil(FModules);    
     end;
 end;
 
-Function TSkelEngine.MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
+Function TSkelEngine.EffectiveVisibility (El : TPasElement) :  TPasMemberVisibility;
 
 Var
-  ParentVisible:Boolean;
-  PT,PP : TPasElement;
+  V : TPasMemberVisibility;
+
 begin
-  ParentVisible:=True;
-  If (El is TPasArgument) or (El is TPasResultElement) then
+  Result:=EL.Visibility;
+  El:=el.Parent;
+  While Assigned(El) do
     begin
-    PT:=El.Parent;
-    // Skip ProcedureType or PasFunctionType
-    If (PT<>Nil) then
-      begin
-      if (PT is TPasProcedureType) or (PT is TPasFunctionType) then
-        PT:=PT.Parent;
-      If (PT<>Nil) and ((PT is TPasProcedure) or (PT is TPasProcedure))   then
-        PP:=PT.Parent
-      else
-        PP:=Nil;
-      If (PP<>Nil) and (PP is TPasClassType) then
-        begin
-        ParentVisible:=((not DisablePrivate or (PT.Visibility<>visPrivate)) and
-                       (not DisableProtected or (PT.Visibility<>visProtected)));
-        end;
-      end;
+    V:=EL.Visibility;
+    if V=visStrictPrivate then
+      V:=visPrivate
+    else if V=visStrictProtected then
+      V:=visProtected;
+    if (V<>visDefault) and ((V<Result) or (Result=visDefault)) then
+      Result:=V;
+    EL:=el.Parent;
     end;
-  Result:=Assigned(El.Parent) and (Length(El.Name) > 0) and
-          (ParentVisible and (not DisableArguments or (El.ClassType <> TPasArgument))) and
-          (ParentVisible and (not DisableFunctionResults or (El.ClassType <> TPasResultElement))) and
-          (not DisablePrivate or (el.Visibility<>visPrivate)) and
-          (not DisableProtected or (el.Visibility<>visProtected));
+end;
+
+Function TSkelEngine.MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
+
+Var
+  VisibilityOK : Boolean;
+  V : TPasMemberVisibility;
+
+
+begin
+  V:=EffectiveVisibility(El);
+  Case V of
+    visPrivate,visStrictPrivate:
+      VisibilityOK:= not DisablePrivate;
+    visProtected,visStrictProtected:
+      VisibilityOK:= not DisableProtected;
+  else
+    VisibilityOK:=True;
+  end;
+  Result:= Assigned(el.Parent)
+           and (Length(El.Name) > 0)
+           and VisibilityOK
+           and (Not (El is TPasExpr))
+           and (not DisableArguments or (El.ClassType <> TPasArgument))
+           and (not DisableFunctionResults or (El.ClassType <> TPasResultElement));
   If Result and Full then
     begin
     Result:=(Not Assigned(FEmittedList) or (FEmittedList.IndexOf(El.FullName)=-1));
diff --git a/utils/fpdoc/mkfpdoc.pp b/utils/fpdoc/mkfpdoc.pp
index 5afb6e0c2e..7dc63f0aec 100644
--- a/utils/fpdoc/mkfpdoc.pp
+++ b/utils/fpdoc/mkfpdoc.pp
@@ -19,16 +19,24 @@ Type
 
   TFPDocCreator = Class(TComponent)
   Private
+    FBaseDescrDir: String;
+    FBaseInputDir: String;
     FCurPackage : TFPDocPackage;
     FProcessedUnits : TStrings;
     FOnLog: TPasParserLogHandler;
     FPParserLogEvents: TPParserLogEvents;
     FProject : TFPDocProject;
+    FProjectMacros: TStrings;
     FScannerLogEvents: TPScannerLogEvents;
     FVerbose: Boolean;
     function GetOptions: TEngineOptions;
     function GetPackages: TFPDocPackages;
+    procedure SetBaseDescrDir(AValue: String);
+    procedure SetBaseInputDir(AValue: String);
+    procedure SetProjectMacros(AValue: TStrings);
   Protected
+    Function FixInputFile(Const AFileName : String) : String;
+    Function FixDescrFile(Const AFileName : String) : String;
     Procedure DoBeforeEmitNote(Sender : TObject; Note : TDomElement; Var EmitNote : Boolean); virtual;
     procedure HandleOnParseUnit(Sender: TObject; const AUnitName: String; out AInputFile, OSTarget, CPUTarget: String);
     procedure SetVerbose(AValue: Boolean); virtual;
@@ -49,6 +57,11 @@ Type
     // Easy access
     Property Options : TEngineOptions Read GetOptions;
     Property Packages : TFPDocPackages Read GetPackages;
+    // When set, they will be prepended to non-absolute filenames.
+    Property BaseInputDir : String Read FBaseInputDir Write SetBaseInputDir;
+    Property BaseDescrDir : String Read FBaseDescrDir Write SetBaseDescrDir;
+    // Macros used when loading the project file
+    Property ProjectMacros : TStrings Read FProjectMacros Write SetProjectMacros;
   end;
 
 implementation
@@ -103,7 +116,7 @@ begin
        SplitInputFIleOption(S,UN,Opts);
        if CompareText(ChangeFileExt(ExtractFileName(Un),''),AUnitName)=0 then
          begin
-         AInputFile:=S;
+         AInputFile:=FixInputFile(UN)+' '+Opts;
          OSTarget:=FProject.Options.OSTarget;
          CPUTarget:=FProject.Options.CPUTarget;
          FProcessedUnits.Add(UN);
@@ -123,6 +136,44 @@ begin
   Result:=FProject.Packages;
 end;
 
+function TFPDocCreator.FixInputFile(const AFileName: String): String;
+begin
+  Result:=AFileName;
+  If Result='' then exit;
+  if (ExtractFileDrive(Result)='') and (Result[1]<>PathDelim) then
+    Result:=BaseInputDir+Result;
+end;
+
+function TFPDocCreator.FixDescrFile(const AFileName: String): String;
+begin
+  Result:=AFileName;
+  If Result='' then exit;
+  if (ExtractFileDrive(Result)='') and (Result[1]<>PathDelim) then
+    Result:=BaseDescrDir+Result;
+end;
+
+procedure TFPDocCreator.SetBaseDescrDir(AValue: String);
+begin
+  if FBaseDescrDir=AValue then Exit;
+  FBaseDescrDir:=AValue;
+  If FBaseDescrDir<>'' then
+    FBaseDescrDir:=IncludeTrailingPathDelimiter(FBaseDescrDir);
+end;
+
+procedure TFPDocCreator.SetBaseInputDir(AValue: String);
+begin
+  if FBaseInputDir=AValue then Exit;
+  FBaseInputDir:=AValue;
+  If FBaseInputDir<>'' then
+    FBaseInputDir:=IncludeTrailingPathDelimiter(FBaseInputDir);
+end;
+
+procedure TFPDocCreator.SetProjectMacros(AValue: TStrings);
+begin
+  if FProjectMacros=AValue then Exit;
+  FProjectMacros.Assign(AValue);
+end;
+
 procedure TFPDocCreator.DoBeforeEmitNote(Sender: TObject; Note: TDomElement;
   var EmitNote: Boolean);
 begin
@@ -137,12 +188,14 @@ begin
   FProject.Options.CPUTarget:=DefCPUTarget;
   FProject.Options.OSTarget:=DefOSTarget;
   FProcessedUnits:=TStringList.Create;
+  FProjectMacros:=TStringList.Create;
 end;
 
 destructor TFPDocCreator.Destroy;
 begin
   FreeAndNil(FProcessedUnits);
   FreeAndNil(FProject);
+  FreeAndNil(FProjectMacros);
   inherited Destroy;
 end;
 
@@ -180,7 +233,8 @@ begin
     Engine.WriteContentFile(APackage.ContentFile);
 end;
 
-procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage; ParseOnly : Boolean);
+procedure TFPDocCreator.CreateDocumentation(APackage: TFPDocPackage;
+  ParseOnly: Boolean);
 
 var
   i,j: Integer;
@@ -201,7 +255,7 @@ begin
       Engine.ReadContentFile(Arg, Cmd);
       end;
     for i := 0 to APackage.Descriptions.Count - 1 do
-      Engine.AddDocFile(APackage.Descriptions[i],Options.donttrim);
+      Engine.AddDocFile(FixDescrFile(APackage.Descriptions[i]),Options.donttrim);
     Engine.SetPackageName(APackage.Name);
     Engine.Output:=APackage.Output;
     Engine.OnLog:=Self.OnLog;
@@ -216,10 +270,11 @@ begin
     for i := 0 to APackage.Inputs.Count - 1 do
       try
         SplitInputFileOption(APackage.Inputs[i],Cmd,Arg);
+        Cmd:=FixInputFIle(Cmd);
         if FProcessedUnits.IndexOf(Cmd)=-1 then
           begin
           FProcessedUnits.Add(Cmd);
-          ParseSource(Engine, APackage.Inputs[i], Options.OSTarget, Options.CPUTarget);
+          ParseSource(Engine,Cmd+' '+Arg, Options.OSTarget, Options.CPUTarget);
           end;
       except
         on e: EParserError do
@@ -239,7 +294,7 @@ begin
   end;
 end;
 
-procedure TFPDocCreator.CreateProjectFile(Const AFileName: string);
+procedure TFPDocCreator.CreateProjectFile(const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(Self) do
   try
@@ -253,7 +308,10 @@ procedure TFPDocCreator.LoadProjectFile(const AFileName: string);
 begin
   With TXMLFPDocOptions.Create(self) do
     try
-      LoadOptionsFromFile(FProject,AFileName);
+      if (ProjectMacros.Count>0) then
+        LoadOptionsFromFile(FProject,AFileName,ProjectMacros)
+      else
+        LoadOptionsFromFile(FProject,AFileName,Nil);
     finally
       Free;
     end;
diff --git a/utils/fppkg/fppkg.pp b/utils/fppkg/fppkg.pp
index 9b646a4e6d..9075d58a59 100644
--- a/utils/fppkg/fppkg.pp
+++ b/utils/fppkg/fppkg.pp
@@ -23,6 +23,7 @@ uses
 {$if (defined(unix) and not defined(android)) or defined(windows)}
   ,pkgwget
   ,pkglnet
+  ,pkgfphttp
 {$endif}
   ;
 
diff --git a/utils/fppkg/lnet/LICENSE b/utils/fppkg/lnet/LICENSE
index 92b8903ff3..5797d01da8 100644
--- a/utils/fppkg/lnet/LICENSE
+++ b/utils/fppkg/lnet/LICENSE
@@ -2,7 +2,7 @@
 		       Version 2, June 1991
 
  Copyright (C) 1991 Free Software Foundation, Inc.
-    		    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    		    51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  Everyone is permitted to copy and distribute verbatim copies
  of this license document, but changing it is not allowed.
 
@@ -464,7 +464,7 @@ convey the exclusion of warranty; and each file should have at least the
 
     You should have received a copy of the GNU Library General Public
     License along with this library; if not, write to the Free
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
 Also add information on how to contact you by electronic and paper mail.
 
diff --git a/utils/fppkg/lnet/LICENSE.ADDON b/utils/fppkg/lnet/LICENSE.ADDON
index f134b1e33d..27069223d6 100644
--- a/utils/fppkg/lnet/LICENSE.ADDON
+++ b/utils/fppkg/lnet/LICENSE.ADDON
@@ -13,7 +13,7 @@ I am NOT the author of tomwinsock.pas
 
 If you didn't receive a copy of the file LICENSE, contact:
       Free Software Foundation, Inc.,
-      59 Temple Place - Suite 330
+      51 Franklin Street, Fifth Floor
       Boston, MA 02111
       USA
 
diff --git a/utils/fppkg/lnet/lcommon.pp b/utils/fppkg/lnet/lcommon.pp
index 5c758ad61e..79e91dac38 100644
--- a/utils/fppkg/lnet/lcommon.pp
+++ b/utils/fppkg/lnet/lcommon.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lcontrolstack.pp b/utils/fppkg/lnet/lcontrolstack.pp
index eef0ac8630..2ed9014084 100644
--- a/utils/fppkg/lnet/lcontrolstack.pp
+++ b/utils/fppkg/lnet/lcontrolstack.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE for more inFormation.
   Should you find these sources withOut a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/levents.pp b/utils/fppkg/lnet/levents.pp
index d72161616f..36cd67fac9 100644
--- a/utils/fppkg/lnet/levents.pp
+++ b/utils/fppkg/lnet/levents.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lfastcgi.pp b/utils/fppkg/lnet/lfastcgi.pp
index 0076d0f59e..5875b1ac7d 100644
--- a/utils/fppkg/lnet/lfastcgi.pp
+++ b/utils/fppkg/lnet/lfastcgi.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lftp.pp b/utils/fppkg/lnet/lftp.pp
index 82a04fbdf8..ee16686234 100644
--- a/utils/fppkg/lnet/lftp.pp
+++ b/utils/fppkg/lnet/lftp.pp
@@ -12,7 +12,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE for more inFormation.
   Should you find these sources withOut a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lhttp.pp b/utils/fppkg/lnet/lhttp.pp
index 7ed59eee8d..c3b6751526 100644
--- a/utils/fppkg/lnet/lhttp.pp
+++ b/utils/fppkg/lnet/lhttp.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lhttputil.pp b/utils/fppkg/lnet/lhttputil.pp
index 0058ba4c61..989ce0b8f8 100644
--- a/utils/fppkg/lnet/lhttputil.pp
+++ b/utils/fppkg/lnet/lhttputil.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lmimestreams.pp b/utils/fppkg/lnet/lmimestreams.pp
index a16b1a408d..3477164fe3 100644
--- a/utils/fppkg/lnet/lmimestreams.pp
+++ b/utils/fppkg/lnet/lmimestreams.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lmimetypes.pp b/utils/fppkg/lnet/lmimetypes.pp
index d646c89c96..0a00436be3 100644
--- a/utils/fppkg/lnet/lmimetypes.pp
+++ b/utils/fppkg/lnet/lmimetypes.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lmimewrapper.pp b/utils/fppkg/lnet/lmimewrapper.pp
index 0ca2e6fdb1..505d4474c0 100644
--- a/utils/fppkg/lnet/lmimewrapper.pp
+++ b/utils/fppkg/lnet/lmimewrapper.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lnet.pp b/utils/fppkg/lnet/lnet.pp
index e73da332b1..702b28867a 100644
--- a/utils/fppkg/lnet/lnet.pp
+++ b/utils/fppkg/lnet/lnet.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lprocess.pp b/utils/fppkg/lnet/lprocess.pp
index 4f7dc5242b..08469ffe0d 100644
--- a/utils/fppkg/lnet/lprocess.pp
+++ b/utils/fppkg/lnet/lprocess.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lsmtp.pp b/utils/fppkg/lnet/lsmtp.pp
index d4c51c35db..04b5fbd06b 100644
--- a/utils/fppkg/lnet/lsmtp.pp
+++ b/utils/fppkg/lnet/lsmtp.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lspawnfcgi.pp b/utils/fppkg/lnet/lspawnfcgi.pp
index cf99525220..607e4a08c8 100644
--- a/utils/fppkg/lnet/lspawnfcgi.pp
+++ b/utils/fppkg/lnet/lspawnfcgi.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lstrbuffer.pp b/utils/fppkg/lnet/lstrbuffer.pp
index 47d6e95205..def5e5021d 100644
--- a/utils/fppkg/lnet/lstrbuffer.pp
+++ b/utils/fppkg/lnet/lstrbuffer.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/ltelnet.pp b/utils/fppkg/lnet/ltelnet.pp
index 6ab7881d3a..93055da4bd 100644
--- a/utils/fppkg/lnet/ltelnet.pp
+++ b/utils/fppkg/lnet/ltelnet.pp
@@ -12,7 +12,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE for more inFormation.
   Should you find these sources withOut a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/ltimer.pp b/utils/fppkg/lnet/ltimer.pp
index 507b2ee384..4fce173c6f 100644
--- a/utils/fppkg/lnet/ltimer.pp
+++ b/utils/fppkg/lnet/ltimer.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 
   This license has been modified. See File LICENSE.ADDON for more inFormation.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/fppkg/lnet/lwebserver.pp b/utils/fppkg/lnet/lwebserver.pp
index 3003ee26de..0859879247 100644
--- a/utils/fppkg/lnet/lwebserver.pp
+++ b/utils/fppkg/lnet/lwebserver.pp
@@ -14,7 +14,7 @@
 
   You should have received a Copy of the GNU Library General Public License
   along with This library; if not, Write to the Free Software Foundation,
-  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
   
   This license has been modified. See file LICENSE.ADDON for more information.
   Should you find these sources without a LICENSE File, please contact
diff --git a/utils/h2pas/h2pas.pas b/utils/h2pas/h2pas.pas
index 326c73be7c..5b4600fee3 100644
--- a/utils/h2pas/h2pas.pas
+++ b/utils/h2pas/h2pas.pas
@@ -690,8 +690,10 @@ program h2pas;
                    (* is this a good method ??                       *)
                    if varpara and
                       (p^.p1^.p1^.typ=t_pointerdef) and
-                      (p^.p1^.p1^.p1^.typ=t_id) and
-                      (pos('CHAR',uppercase(p^.p1^.p1^.p1^.str))<>0) then
+                      (((p^.p1^.p1^.p1^.typ=t_id) and
+                        (pos('CHAR',uppercase(p^.p1^.p1^.p1^.str))<>0)) or
+                        ((p^.p1^.p1^.p1^.typ=t_void))
+                      ) then
                      varpara:=false;
                    if varpara then
                      begin
diff --git a/utils/h2pas/h2pas.y b/utils/h2pas/h2pas.y
index d92329f621..e872008217 100644
--- a/utils/h2pas/h2pas.y
+++ b/utils/h2pas/h2pas.y
@@ -686,8 +686,10 @@ program h2pas;
                    (* is this a good method ??                       *)
                    if varpara and
                       (p^.p1^.p1^.typ=t_pointerdef) and
-                      (p^.p1^.p1^.p1^.typ=t_id) and
-                      (pos('CHAR',uppercase(p^.p1^.p1^.p1^.str))<>0) then
+                      (((p^.p1^.p1^.p1^.typ=t_id) and
+                        (pos('CHAR',uppercase(p^.p1^.p1^.p1^.str))<>0)) or
+                        ((p^.p1^.p1^.p1^.typ=t_void))
+                      ) then
                      varpara:=false;
                    if varpara then
                      begin
diff --git a/utils/instantfpc/instantfpc.pas b/utils/instantfpc/instantfpc.pas
index dbd0571ea4..b8dd584601 100644
--- a/utils/instantfpc/instantfpc.pas
+++ b/utils/instantfpc/instantfpc.pas
@@ -14,8 +14,8 @@
 
   A copy of the GNU General Public License is available on the World Wide Web
   at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
-  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-  MA 02111-1307, USA.
+  to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+  MA 02110-1301, USA.
 }
 program instantfpc;
 
diff --git a/utils/pas2jni/def.pas b/utils/pas2jni/def.pas
index 6534df3e42..05d68c3f2f 100644
--- a/utils/pas2jni/def.pas
+++ b/utils/pas2jni/def.pas
@@ -31,7 +31,7 @@ uses
 type
   TDefType = (dtNone, dtUnit, dtClass, dtProc, dtField, dtProp, dtParam, dtVar,
               dtType, dtConst, dtProcType, dtEnum, dtSet, dtPointer, dtArray,
-              dtJniObject, dtJniEnv);
+              dtJniObject, dtJniEnv, dtClassRef);
 
   TDefClass = class of TDef;
   { TDef }
@@ -54,6 +54,7 @@ type
     procedure AddRef;
     procedure DecRef;
     procedure SetExtUsed(ExtDef: TDef; AUsed: boolean; var HasRef: boolean);
+    function ShouldUseChild(d: TDef): boolean; virtual;
   public
     DefType: TDefType;
     DefId: integer;
@@ -71,6 +72,8 @@ type
     function FindDef(ADefId: integer; Recursive: boolean = True): TDef;
     procedure ResolveDefs; virtual;
     procedure SetNotUsed;
+    function GetRefDef: TDef; virtual;
+    function GetRefDef2: TDef; virtual;
     property Items[Index: Integer]: TDef read GetItem write SetItem; default;
     property Count: integer read GetCount;
     property IsUsed: boolean read GetIsUsed write SetIsUsed;
@@ -87,6 +90,7 @@ type
     FHasClassRef: boolean;
   protected
     procedure SetIsUsed(const AValue: boolean); override;
+    function ShouldUseChild(d: TDef): boolean; override;
   public
     CType: TClassType;
     AncestorClass: TClassDef;
@@ -94,7 +98,9 @@ type
     HasReplacedItems: boolean;
     ImplementsReplacedItems: boolean;
     Size: integer;
+    IID: string;
     procedure ResolveDefs; override;
+    function GetRefDef: TDef; override;
   end;
 
   TBasicType = (btVoid, btByte, btShortInt, btWord, btSmallInt, btLongWord, btLongInt, btInt64,
@@ -121,6 +127,7 @@ type
     PtrType: TDef;
     procedure ResolveDefs; override;
     function IsObjPtr: boolean;
+    function GetRefDef: TDef; override;
   end;
 
   { TReplDef }
@@ -155,10 +162,11 @@ type
     procedure ResolveDefs; override;
     function IsReplacedBy(d: TReplDef): boolean; override;
     function CanReplaced: boolean; override;
+    function GetRefDef: TDef; override;
   end;
 
   TProcType = (ptProcedure, ptFunction, ptConstructor, ptDestructor);
-  TProcOption = (poOverride, poOverload, poMethodPtr, poPrivate, poProtected);
+  TProcOption = (poOverride, poOverload, poMethodPtr, poPrivate, poProtected, poClassMethod);
   TProcOptions = set of TProcOption;
 
   { TProcDef }
@@ -168,6 +176,7 @@ type
     FHasRetTypeRef: boolean;
   protected
     procedure SetIsUsed(const AValue: boolean); override;
+    function ShouldUseChild(d: TDef): boolean; override;
   public
     ProcType: TProcType;
     ReturnType: TDef;
@@ -175,6 +184,7 @@ type
     procedure ResolveDefs; override;
     function IsReplacedBy(d: TReplDef): boolean; override;
     function CanReplaced: boolean; override;
+    function GetRefDef: TDef; override;
   end;
 
   TUnitDef = class(TDef)
@@ -185,6 +195,7 @@ type
     PPUVer: integer;
     UsedUnits: array of TUnitDef;
     Processed: boolean;
+    IsUnitUsed: boolean;
   end;
 
   TConstDef = class(TVarDef)
@@ -204,6 +215,7 @@ type
     Base: integer;
     ElMax: integer;
     ElType: TTypeDef;
+    function GetRefDef: TDef; override;
   end;
 
   { TArrayDef }
@@ -218,11 +230,30 @@ type
     ElType: TDef;
     RangeType: TDef;
     RangeLow, RangeHigh: integer;
+    function GetRefDef: TDef; override;
+    function GetRefDef2: TDef; override;
   end;
 
+  { TClassRefDef }
+
+  TClassRefDef = class(TDef)
+  private
+    FHasClassRef: boolean;
+  protected
+    procedure SetIsUsed(const AValue: boolean); override;
+  public
+    ClassRef: TDef;
+    procedure ResolveDefs; override;
+    function GetRefDef: TDef; override;
+  end;
+
+
 const
   ReplDefs  = [dtField, dtProp, dtProc];
 
+var
+  OnCanUseDef: function (def, refdef: TDef): boolean;
+
 implementation
 
 function IsSameType(t1, t2: TDef): boolean;
@@ -237,6 +268,25 @@ begin
   Result:=TTypeDef(t1).BasicType = TTypeDef(t2).BasicType;
 end;
 
+{ TClassRefDef }
+
+procedure TClassRefDef.SetIsUsed(const AValue: boolean);
+begin
+  inherited SetIsUsed(AValue);
+  SetExtUsed(ClassRef, AValue, FHasClassRef);
+end;
+
+procedure TClassRefDef.ResolveDefs;
+begin
+  inherited ResolveDefs;
+  ClassRef:=ResolveDef(ClassRef);
+end;
+
+function TClassRefDef.GetRefDef: TDef;
+begin
+  Result:=ClassRef;
+end;
+
 { TArrayDef }
 
 procedure TArrayDef.SetIsUsed(const AValue: boolean);
@@ -246,6 +296,16 @@ begin
   SetExtUsed(RangeType, AValue, FHasRTypeRef);
 end;
 
+function TArrayDef.GetRefDef: TDef;
+begin
+  Result:=ElType;
+end;
+
+function TArrayDef.GetRefDef2: TDef;
+begin
+  Result:=RangeType;
+end;
+
 { TPointerDef }
 
 procedure TPointerDef.SetIsUsed(const AValue: boolean);
@@ -272,6 +332,11 @@ begin
   Result:=(PtrType <> nil) and (PtrType.DefType in [dtClass]);
 end;
 
+function TPointerDef.GetRefDef: TDef;
+begin
+  Result:=PtrType;
+end;
+
 { TReplDef }
 
 procedure TReplDef.SetIsUsed(const AValue: boolean);
@@ -338,6 +403,11 @@ begin
   SetExtUsed(ElType, AValue, FHasElTypeRef);
 end;
 
+function TSetDef.GetRefDef: TDef;
+begin
+  Result:=ElType;
+end;
+
 { TTypeDef }
 
 procedure TTypeDef.SetIsUsed(const AValue: boolean);
@@ -369,6 +439,11 @@ begin
     SetExtUsed(ReturnType, AValue, FHasRetTypeRef);
 end;
 
+function TProcDef.ShouldUseChild(d: TDef): boolean;
+begin
+  Result:=d.DefType in [dtParam];
+end;
+
 procedure TProcDef.ResolveDefs;
 begin
   inherited ResolveDefs;
@@ -398,6 +473,11 @@ begin
   Result:=inherited CanReplaced and (ProcType = ptFunction);
 end;
 
+function TProcDef.GetRefDef: TDef;
+begin
+  Result:=ReturnType;
+end;
+
 { TClassDef }
 
 procedure TClassDef.SetIsUsed(const AValue: boolean);
@@ -406,19 +486,43 @@ begin
   SetExtUsed(AncestorClass, AValue, FHasClassRef);
 end;
 
+function TClassDef.ShouldUseChild(d: TDef): boolean;
+begin
+  Result:=d.DefType in [dtProc, dtField, dtProp];
+end;
+
 procedure TClassDef.ResolveDefs;
 begin
   inherited ResolveDefs;
   AncestorClass:=TClassDef(ResolveDef(AncestorClass, TClassDef));
 end;
 
+function TClassDef.GetRefDef: TDef;
+begin
+  Result:=AncestorClass;
+end;
+
 { TVarDef }
 
 procedure TVarDef.SetIsUsed(const AValue: boolean);
+var
+  ptr, d: TDef;
 begin
   if IsPrivate then
     exit;
   inherited SetIsUsed(AValue);
+  // Detect circular pointers
+  if (VarType <> nil) and (VarType.DefType = dtPointer) and (VarType.RefCnt > 0) then begin
+    ptr:=TPointerDef(VarType).PtrType;
+    if ptr <> nil then begin
+      d:=Self;
+      while d <> nil do begin
+        if d = ptr then
+          exit;
+        d:=d.Parent;;
+      end;
+    end;
+  end;
   SetExtUsed(VarType, AValue, FHasTypeRef);
 end;
 
@@ -438,6 +542,11 @@ begin
   Result:=(voRead in VarOpt) and inherited CanReplaced;
 end;
 
+function TVarDef.GetRefDef: TDef;
+begin
+  Result:=VarType;
+end;
+
 constructor TVarDef.Create;
 begin
   inherited Create;
@@ -485,10 +594,13 @@ procedure TDef.SetIsUsed(const AValue: boolean);
 var
   i: integer;
   f: boolean;
+  d: TDef;
 begin
   if FInSetUsed or (DefType = dtNone) or IsPrivate then
     exit;
   if AValue then begin
+    if Assigned(OnCanUseDef) and not OnCanUseDef(Self, Parent) then
+      exit;
     AddRef;
     f:=FRefCnt = 1;
   end
@@ -502,8 +614,11 @@ begin
     // Update used mark of children only once
     FInSetUsed:=True;
     try
-      for i:=0 to Count - 1 do
-        Items[i].IsUsed:=AValue;
+      for i:=0 to Count - 1 do begin
+        d:=Items[i];
+        if ShouldUseChild(d) then
+          d.IsUsed:=AValue;
+      end;
     finally
       FInSetUsed:=False;
     end;
@@ -549,6 +664,8 @@ begin
   if AUsed then begin
     if HasRef then
       exit;
+    if Assigned(OnCanUseDef) and not OnCanUseDef(ExtDef, Self) then
+      exit;
     OldRefCnt:=ExtDef.RefCnt;
     ExtDef.IsUsed:=True;
     HasRef:=OldRefCnt <> ExtDef.RefCnt;
@@ -560,6 +677,11 @@ begin
     end;
 end;
 
+function TDef.ShouldUseChild(d: TDef): boolean;
+begin
+  Result:=True;
+end;
+
 procedure TDef.SetItem(Index: Integer; const AValue: TDef);
 begin
   CheckItems;
@@ -648,5 +770,15 @@ begin
   IsUsed:=False;
 end;
 
+function TDef.GetRefDef: TDef;
+begin
+  Result:=nil;
+end;
+
+function TDef.GetRefDef2: TDef;
+begin
+  Result:=nil;
+end;
+
 end.
 
diff --git a/utils/pas2jni/ppuparser.pas b/utils/pas2jni/ppuparser.pas
index af9e21c6f9..e845ef2201 100644
--- a/utils/pas2jni/ppuparser.pas
+++ b/utils/pas2jni/ppuparser.pas
@@ -268,6 +268,8 @@ var
             continue;
           d:=TClassDef.Create(CurDef, dtClass);
           TClassDef(d).CType:=ct;
+          if ct = ctInterface then
+            TClassDef(d).IID:=it.Get('IID', '');
         end
         else
         if jt = 'rec' then begin
@@ -385,6 +387,9 @@ var
         if jt = 'array' then
           d:=TArrayDef.Create(CurDef, dtArray)
         else
+        if jt = 'classref' then
+          d:=TClassRefDef.Create(CurDef, dtClassRef)
+        else
           continue;
 
         if (CurObjName = '') and not (d.DefType in [dtEnum, dtArray]) then begin
@@ -443,7 +448,10 @@ var
                     ProcOpt:=ProcOpt + [poOverload]
                   else
                   if s = 'abstract' then
-                    TClassDef(Parent).HasAbstractMethods:=True;
+                    TClassDef(Parent).HasAbstractMethods:=True
+                  else
+                  if s = 'classmethod' then
+                    ProcOpt:=ProcOpt + [poClassMethod];
                 end;
 
                 ReturnType:=_GetRef(it.Get('RetType', TJSONObject(nil)));
@@ -541,6 +549,10 @@ var
               RangeType:=_GetRef(it.Get('RangeType', TJSONObject(nil)));
               ElType:=_GetRef(it.Get('ElType', TJSONObject(nil)));
             end;
+          dtClassRef:
+            with TClassRefDef(d) do begin
+              ClassRef:=_GetRef(it.Get('Ref', TJSONObject(nil)));;
+            end;
         end;
       end;
   end;
diff --git a/utils/pas2jni/readme.txt b/utils/pas2jni/readme.txt
index 4aee73ba19..6d72514c39 100644
--- a/utils/pas2jni/readme.txt
+++ b/utils/pas2jni/readme.txt
@@ -33,11 +33,12 @@ The following Pascal features are supported by pas2jni:
 - pointer type;
 - string types;
 - all numeric types;
-- method pointer.
+- method pointer;
+- setters/getters for array elements.
 
 USUPPORTED features:
-- array;
-- procedure pointer.
+- Full support for arrays;
+- procedure pointer (Not possible to implement. To workaround this limitation create a procedure handler in your Pascal code and call a method pointer declared in some global Pascal class. Then you can assign this method pointer from a Java code).
 
 Shared libraries, generated by pas2jni were tested with Java on Windows and Android. It should work on other systems as well.
 
@@ -84,9 +85,7 @@ In a Java code you get the following TMyClass instance:
 
 TMyClass myclass = TMyClass.Create();
 
-It is possible set a Java handler in 2 ways:
-
-1) Place the handler inline.
+Then you add the event handler in a usual Java way:
 
 ...
   myclass.setOnChange(
@@ -98,21 +97,6 @@ It is possible set a Java handler in 2 ways:
     );
 ...
 
-2) Define the handler as a method in a class.
-
-public class MyJavaClass {
-  private void DoOnChange(TObject Sender) {
-    // The handler code
-  }
-
-  public void main() {
-    ...
-    // Set the handler to the method with the "DoOnChange" name in the current class (this).
-    myclass.setOnChange( new TNotifyEvent(this, "DoOnChange") );
-    ...
-  }
-}
-
 COMMAND LINE OPTIONS
 
 Usage: pas2jni [options] <unit> [<unit2> <unit3> ...]
diff --git a/utils/pas2jni/writer.pas b/utils/pas2jni/writer.pas
index 4e2bf6b472..95f91b97d2 100644
--- a/utils/pas2jni/writer.pas
+++ b/utils/pas2jni/writer.pas
@@ -54,18 +54,54 @@ type
     property SIndent: string read FIndStr;
   end;
 
+  { TClassInfo }
+
+  TClassInfo = class
+  public
+    Def: TDef;
+    Funcs: TObjectList;
+    IsCommonClass: boolean;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TProcInfo }
+
+  TProcInfo = class
+  public
+    Name: string;
+    JniName: string;
+    JniSignature: string;
+  end;
+
+  { TClassList }
+
+  TClassList = class(TStringList)
+  private
+    function GetFullName(const AName: string; Def: TDef): string;
+  public
+    constructor Create;
+    function Add(const AName: string; Def: TDef; Info: TClassInfo): integer;
+    function IndexOf(const AName: string; Def: TDef): integer; reintroduce;
+    function GetClassName(Index: integer): string;
+    function GetClassInfo(Index: integer): TClassInfo;
+  end;
+
   { TWriter }
 
   TWriter = class
   private
     Fjs, Fps: TTextOutStream;
-    FClasses: TStringList;
+    FClasses: TClassList;
     FPkgDir: string;
     FUniqueCnt: integer;
     FThisUnit: TUnitDef;
     FIntegerType: TDef;
+    FRecords: TObjectList;
+    FRealClasses: TObjectList;
 
     function DoCheckItem(const ItemName: string): TCheckItemResult;
+    procedure WriteClassTable;
 
     procedure WriteFileComment(st: TTextOutStream);
 
@@ -94,6 +130,7 @@ type
     function GetProcSignature(d: TProcDef): string;
     procedure EHandlerStart;
     procedure EHandlerEnd(const EnvVarName: string; const ExtraCode: string = '');
+    procedure UpdateUsedUnits(u: TUnitDef);
 
     procedure WriteClassInfoVar(d: TDef);
     procedure WriteComment(d: TDef; const AType: string);
@@ -105,8 +142,10 @@ type
     procedure WriteProcType(d: TProcDef; PreInfo: boolean);
     procedure WriteSet(d: TSetDef);
     procedure WritePointer(d: TPointerDef; PreInfo: boolean);
+    procedure WriteClassRef(d: TClassRefDef; PreInfo: boolean);
     procedure WriteUnit(u: TUnitDef);
     procedure WriteOnLoad;
+    procedure WriteRecordSizes;
   public
     SearchPath: string;
     LibName: string;
@@ -152,9 +191,9 @@ const
     'system.fma'
   );
 
-  ExcludeDelphi7: array[1..25] of string = (
+  ExcludeDelphi7: array[1..26] of string = (
     'system.TObject.StringMessageTable', 'system.TObject.GetInterfaceEntryByStr', 'system.TObject.UnitName', 'system.TObject.Equals',
-    'system.TObject.GetHashCode', 'system.TObject.ToString','classes.TStream.ReadByte', 'classes.TStream.ReadWord',
+    'system.TObject.GetHashCode', 'system.TObject.ToString','system.TObject.QualifiedClassName','classes.TStream.ReadByte', 'classes.TStream.ReadWord',
     'classes.TStream.ReadDWord', 'classes.TStream.ReadQWord', 'classes.TStream.ReadAnsiString', 'classes.TStream.WriteByte',
     'classes.TStream.WriteWord', 'classes.TStream.WriteDWord', 'classes.TStream.WriteQWord', 'classes.TStream.WriteAnsiString',
     'classes.TCollection.Exchange', 'classes.TStrings.Equals', 'classes.TStrings.GetNameValue', 'classes.TStrings.ExtractName',
@@ -166,7 +205,51 @@ const
 
 function JniCaliing: string;
 begin
-  Result:='{$ifdef windows} stdcall {$else} cdecl {$endif};';
+  Result:='{$ifdef mswindows} stdcall {$else} cdecl {$endif};';
+end;
+
+{ TClassList }
+
+function TClassList.IndexOf(const AName: string; Def: TDef): integer;
+begin
+  Result:=inherited IndexOf(GetFullName(AName, Def));
+end;
+
+function TClassList.GetClassName(Index: integer): string;
+var
+  i: integer;
+begin
+  Result:=Strings[Index];
+  i:=Pos('.', Result);
+  if i > 0 then
+    System.Delete(Result, 1, i);
+end;
+
+function TClassList.GetClassInfo(Index: integer): TClassInfo;
+begin
+  Result:=TClassInfo(Objects[Index]);
+end;
+
+function TClassList.GetFullName(const AName: string; Def: TDef): string;
+begin
+  if (Def = nil) or (Def.DefType = dtUnit) then
+    Result:=AName
+  else begin
+    while (Def.Parent <> nil) and (Def.DefType <> dtUnit) do
+      Def:=Def.Parent;
+    Result:=Def.Name + '.' + AName;
+  end;
+end;
+
+constructor TClassList.Create;
+begin
+  inherited Create;
+  Sorted:=True;
+end;
+
+function TClassList.Add(const AName: string; Def: TDef; Info: TClassInfo): integer;
+begin
+  Result:=AddObject(GetFullName(AName, Def), Info);
 end;
 
 { TTextOutStream }
@@ -210,24 +293,6 @@ begin
     Indent:=Indent - 1;
 end;
 
-type
-  { TClassInfo }
-  TClassInfo = class
-  public
-    Def: TDef;
-    Funcs: TObjectList;
-    IsCommonClass: boolean;
-    constructor Create;
-    destructor Destroy; override;
-  end;
-
-  TProcInfo = class
-  public
-    Name: string;
-    JniName: string;
-    JniSignature: string;
-  end;
-
 { TClassInfo }
 
 constructor TClassInfo.Create;
@@ -258,7 +323,7 @@ begin
       case d.DefType of
         dtType:
           Result:=JNIType[TTypeDef(d).BasicType];
-        dtClass, dtEnum:
+        dtClass, dtEnum, dtClassRef:
           Result:='jobject';
         dtProcType:
           if poMethodPtr in TProcDef(d).ProcOpt then
@@ -350,7 +415,7 @@ begin
     case d.DefType of
       dtType:
         Result:=JNITypeSig[TTypeDef(d).BasicType];
-      dtClass, dtProcType, dtSet, dtEnum:
+      dtClass, dtProcType, dtSet, dtEnum, dtClassRef:
         Result:='L' + GetJavaClassPath(d) + ';';
       dtPointer:
         if TPointerDef(d).IsObjPtr then
@@ -375,7 +440,7 @@ begin
       case d.DefType of
         dtType:
           Result:=JavaType[TTypeDef(d).BasicType];
-        dtClass, dtProcType, dtSet, dtEnum:
+        dtClass, dtProcType, dtSet, dtEnum, dtClassRef:
           Result:=d.Name;
         dtPointer:
           if TPointerDef(d).IsObjPtr then
@@ -453,6 +518,7 @@ var
   procedure WriteConstructors;
   var
     cc: TStringList;
+    i: integer;
   begin
     if not TClassDef(d).HasAbstractMethods then begin
       // Writing all constructors including parent's
@@ -464,6 +530,11 @@ var
         cc.Free;
       end;
     end;
+    if d.CType = ctClass then begin
+      i:=FRealClasses.Add(d);
+      Fjs.WriteLn(Format('public static %s Class() { return new %0:s(system.GetClassRef(%d)); }', [d.AliasName, i]));
+      Fjs.WriteLn(Format('public static system.TClass TClass() { return system.GetTClass(%d); }', [i]));
+    end;
   end;
 
   procedure _WriteReplacedItems(c: TClassDef);
@@ -537,12 +608,20 @@ var
         s:='protected'
       else
         s:='public';
-      if (CType = ctInterface) and (AncestorClass = nil) then
-        ss:=' __Init();'
-      else
-        ss:='';
-      Fjs.WriteLn(Format('%s %s(PascalObject obj) { super(obj);%s }', [s, AName, ss]));
-      Fjs.WriteLn(Format('%s %s(long objptr) { super(objptr);%s }', [s, AName, ss]));
+      if CType = ctInterface then begin
+        Fjs.WriteLn('private native long __AsIntf(long objptr);');
+        ss:=IID;
+        if ss = '' then
+          ss:='null'
+        else
+          ss:='"' + ss + '"';
+        Fjs.WriteLn(Format('%s %s(PascalObject obj) { super(0, true); __TypeCast(obj, %s); }', [s, AName, ss]));
+        Fjs.WriteLn(Format('%s %s(long objptr) { super(objptr, true); }', [s, AName]));
+      end
+      else begin
+        Fjs.WriteLn(Format('%s %s(PascalObject obj) { super(obj); }', [s, AName]));
+        Fjs.WriteLn(Format('%s %s(long objptr) { super(objptr); }', [s, AName]));
+      end;
     end;
   end;
 
@@ -560,7 +639,7 @@ begin
       Fps.WriteLn(Format('var pr: ^%s;', [s]));
       Fps.WriteLn('begin');
       Fps.IncI;
-      Fps.WriteLn('New(pr); pr^:=r;');
+      Fps.WriteLn(Format('pr:=AllocMem(SizeOf(%s)); pr^:=r;', [s]));
       Fps.WriteLn(Format('Result:=_CreateJavaObj(env, pr, %s);', [GetTypeInfoVar(d)]));
       Fps.DecI;
       Fps.WriteLn('end;');
@@ -571,7 +650,7 @@ begin
       Fps.WriteLn(Format('var pr: ^%s;', [s]));
       Fps.WriteLn('begin');
       Fps.WriteLn('pr:=pointer(ptruint(r));', 1);
-      Fps.WriteLn('Dispose(pr);', 1);
+      Fps.WriteLn('system.Dispose(pr);', 1);
       Fps.WriteLn('end;');
 
       AddNativeMethod(d, ss, '__Destroy', '(J)V');
@@ -605,7 +684,7 @@ begin
         s:=s + Format('%s.system.Record', [JavaPackage])
       else
         if d.CType = ctInterface then
-          s:=s + 'PascalObjectEx'
+          s:=s + 'PascalInterface'
         else
           s:=s + 'PascalObject';
   end;
@@ -615,21 +694,22 @@ begin
     ctObject, ctRecord:
       begin
         Fjs.WriteLn('private native void __Destroy(long pasobj);');
-        Fjs.WriteLn(Format('protected %s(long objptr, boolean cleanup) { __Init(objptr, cleanup); }', [d.Name]));
-        Fjs.WriteLn(Format('public %s() { __Init(0, true); }', [d.Name]));
-        Fjs.WriteLn(Format('public void __Release() { __Destroy(_pasobj); _pasobj=0; }', [d.Name]));
-        Fjs.WriteLn(Format('public int __Size() { return %d; }', [d.Size]));
+        if d.AncestorClass = nil then
+          s:='__Init'
+        else
+          s:='super';
+        Fjs.WriteLn(Format('protected %s(long objptr, boolean cleanup) { %s(objptr, cleanup); }', [d.Name, s]));
+        Fjs.WriteLn(Format('public %s() { %s(0, true); }', [d.Name, s]));
+        Fjs.WriteLn(Format('@Override public void __Release() { __Destroy(_pasobj); _pasobj=0; }', [d.Name]));
+        Fjs.WriteLn(Format('@Override public int __Size() { return __Size(%d); }', [FRecords.Add(d)]));
       end;
     ctInterface:
       begin
         if d.AncestorClass = nil then begin
-          Fjs.WriteLn('public void __Release() { if (_pasobj != 0) _Release(); _pasobj = 0; }');
-          Fjs.WriteLn('public void __Init() { _cleanup=true; if (_pasobj != 0) _AddRef(); }');
-          s:='_pasobj=objptr; __Init();';
-        end
-        else
-          s:='super(objptr, cleanup);';
-        Fjs.WriteLn(Format('protected %s(long objptr, boolean cleanup) { %s }', [d.Name, s]));
+          Fjs.WriteLn('@Override public void __Release() { if (_pasobj != 0) _Release(); _pasobj = 0; }');
+          Fjs.WriteLn('@Override protected void __Init() { _cleanup=true; if (_pasobj != 0) _AddRef(); }');
+        end;
+        Fjs.WriteLn(Format('protected %s(long objptr, boolean cleanup) { super(objptr, cleanup); }', [d.Name]));
       end;
   end;
 
@@ -699,15 +779,18 @@ begin
   pi:=TProcInfo.Create;
   with d do
   try
+    IsObj:=(d.Parent.DefType = dtClass) and (TClassDef(d.Parent).CType = ctObject);
+    if not IsObj and (poClassMethod in ProcOpt) and (Name = 'ClassType') then
+      ProcOpt:=ProcOpt - [poClassMethod];
     pi.Name:=Name;
     s:=GetClassPrefix(d.Parent) + pi.Name;
     pi.JniName:=s;
     pi.JniSignature:=GetProcSignature(d);
     if AParent = nil then begin
       // Checking duplicate proc name and duplicate param types
-      ClassIdx:=FClasses.IndexOf(GetJavaClassName(d.Parent, ItemDef));
+      ClassIdx:=FClasses.IndexOf(GetJavaClassName(d.Parent, ItemDef), d.Parent);
       if ClassIdx >= 0 then begin
-        ci:=TClassInfo(FClasses.Objects[ClassIdx]);
+        ci:=FClasses.GetClassInfo(ClassIdx);
         j:=1;
         ss:=Copy(pi.JniSignature, 1, Pos(')', pi.JniSignature));
         repeat
@@ -734,7 +817,6 @@ begin
         s:='procedure';
       s:=s + ' ' + pi.JniName + '(_env: PJNIEnv; _jobj: jobject';
 
-      IsObj:=(d.Parent.DefType = dtClass) and (TClassDef(d.Parent).CType = ctObject);
       if IsObj and (ProcType in [ptConstructor, ptDestructor]) then
         TempRes:='__tempres';
 
@@ -776,6 +858,12 @@ begin
       Fps.WriteLn(s);
       if err then
         exit;
+
+      if (poClassMethod in ProcOpt) and not IsObj then begin
+        Fps.WriteLn(Format('type _classt = %s;', [Parent.Parent.Name + '.' + Parent.Name]));
+        Fps.WriteLn('type _class = class of _classt;');
+      end;
+
       if (tempvars <> nil) or UseTempObjVar or (TempRes <> '') then begin
         s:='';
         Fps.WriteLn('var');
@@ -845,7 +933,10 @@ begin
           if ProcType = ptConstructor then
             s:=Parent.Parent.Name + '.' + Parent.Name + '.'
           else
-            s:=JniToPasType(d.Parent, '_jobj', True) + '.';
+            if (poClassMethod in ProcOpt) and not IsObj then
+              s:='_class(_GetClass(_env, _jobj, ' + GetTypeInfoVar(d.Parent) + '))' + '.'
+            else
+              s:=JniToPasType(d.Parent, '_jobj', True) + '.';
 
       if Variable = nil then begin
         // Regular proc
@@ -915,8 +1006,8 @@ begin
       else
       if IsObj and (ProcType = ptDestructor) then begin
         Fps.WriteLn(TempRes + ':=@' + JniToPasType(d.Parent, '_jobj', True) + ';');
-        s:=Format('system.Dispose(%s, %s);', [TempRes, s]);
-        Fps.WriteLn(s);
+        Fps.WriteLn(Format('%s^.%s;', [TempRes, s]));
+        Fps.WriteLn(Format('_env^^.SetLongField(_env, _jobj, %s.ObjFieldId, -jlong(ptruint(%s)));', [GetTypeInfoVar(d.Parent), TempRes]));
       end
       else begin
         if ProcType in [ptFunction, ptConstructor] then
@@ -939,8 +1030,9 @@ begin
         end;
       end;
 
-      if IsTObject and ( (ProcType = ptDestructor) or (CompareText(Name, 'Free') = 0) ) then
-        Fps.WriteLn(Format('_env^^.SetLongField(_env, _jobj, %s.ObjFieldId, 0);', [GetTypeInfoVar(d.Parent)]));
+      if not IsObj then
+        if IsTObject and ( (ProcType = ptDestructor) or (CompareText(Name, 'Free') = 0) ) then
+          Fps.WriteLn(Format('_env^^.SetLongField(_env, _jobj, %s.ObjFieldId, 0);', [GetTypeInfoVar(d.Parent)]));
 
       if tf then begin
         Fps.WriteLn('finally', -1);
@@ -973,16 +1065,16 @@ begin
       AParent:=d.Parent;
     end
     else
-      ClassIdx:=FClasses.IndexOf(GetJavaClassName(AParent, ItemDef));
+      ClassIdx:=FClasses.IndexOf(GetJavaClassName(AParent, ItemDef), AParent);
 
     if ClassIdx < 0 then begin
       ci:=TClassInfo.Create;
       ci.Def:=AParent;
       s:=GetJavaClassName(AParent, ItemDef);
       ci.IsCommonClass:=s <> AParent.Name;
-      ClassIdx:=FClasses.AddObject(s, ci);
+      ClassIdx:=FClasses.Add(s, AParent, ci);
     end;
-    TClassInfo(FClasses.Objects[ClassIdx]).Funcs.Add(pi);
+    FClasses.GetClassInfo(ClassIdx).Funcs.Add(pi);
     pi:=nil;
 
     // Java part
@@ -1170,19 +1262,30 @@ begin
       s:='double';
   end
   else begin
-    s:=DefToJavaType(d.VarType);
-    if d.VarType.DefType = dtType then
-      case TTypeDef(d.VarType).BasicType of
-        btLongWord, btInt64:
-          v:=v + 'L';
-        btBoolean:
-          if v = '1' then
-            v:='true'
-          else
-            v:='false';
-      end;
+    s:='';
+    case d.VarType.DefType of
+      dtType:
+        case TTypeDef(d.VarType).BasicType of
+          btLongWord, btInt64:
+            v:=v + 'L';
+          btBoolean:
+            if v = '1' then
+              v:='true'
+            else
+              v:='false';
+        end;
+      dtArray:
+        with TArrayDef(d.VarType) do
+          if (ElType.DefType = dtType) and (TTypeDef(ElType).BasicType in [btChar, btWideChar]) then
+            s:='String';
+    end;
+    if s = '' then
+      s:=DefToJavaType(d.VarType);
   end;
-  Fjs.WriteLn(Format('public static final %s %s = %s;', [s, d.Name, v]));
+  v:=Format('public static final %s %s = %s;', [s, d.Name, v]);
+  if s = SUnsupportedType then
+    v:='// ' + v;
+  Fjs.WriteLn(v);
 end;
 
 procedure TWriter.WriteEnum(d: TDef);
@@ -1196,7 +1299,7 @@ begin
   RegisterPseudoClass(d);
 
   WriteComment(d, 'enum');
-  Fjs.WriteLn(Format('public static class %s extends system.Enum {', [d.Name]));
+  Fjs.WriteLn(Format('public static class %s extends %s.system.Enum {', [d.Name, JavaPackage]));
   Fjs.IncI;
   for i:=0 to d.Count - 1 do begin
     s:=Format('public final static int %s = %s;', [d[i].Name, TConstDef(d[i]).Value]);
@@ -1254,6 +1357,7 @@ begin
     Fps.WriteLn('var');
     Fps.IncI;
     Fps.WriteLn('_env: PJNIEnv;');
+    Fps.WriteLn('_new_env: boolean;');
     Fps.WriteLn('_mpi: _TMethodPtrInfo;');
     if d.Count > 0 then begin
       Fps.WriteLn(Format('_args: array[0..%d] of jvalue;', [d.Count - 1]));
@@ -1270,6 +1374,11 @@ begin
     Fps.WriteLn('begin');
     Fps.IncI;
     Fps.WriteLn('CurJavaVM^^.GetEnv(CurJavaVM, @_env, JNI_VERSION_1_6);');
+    Fps.WriteLn('_new_env:=_env = nil;');
+    Fps.WriteLn('if _new_env then CurJavaVM^^.AttachCurrentThread(CurJavaVM, @_env, nil);');
+    Fps.WriteLn('_env^^.PushLocalFrame(_env, 100);');
+    Fps.WriteLn('try');
+    Fps.IncI;
     Fps.WriteLn('_MethodPointersCS.Enter;');
     Fps.WriteLn('try');
     Fps.WriteLn('_mpi:=_TMethodPtrInfo(_MethodPointers[-integer(ptruint(Self)) - 1]);', 1);
@@ -1331,6 +1440,11 @@ begin
     end;
 
     Fps.DecI;
+    Fps.WriteLn('finally');
+    Fps.WriteLn('_env^^.PopLocalFrame(_env, nil);', 1);
+    Fps.WriteLn('if _new_env then CurJavaVM^^.DetachCurrentThread(CurJavaVM);', 1);
+    Fps.WriteLn('end;');
+    Fps.DecI;
     Fps.WriteLn('end;');
 
     // Get handler proc
@@ -1356,7 +1470,7 @@ begin
   Fjs.IncI;
   Fjs.WriteLn(Format('{ mSignature = "%s"; }', [GetProcSignature(d)]));
   Fjs.WriteLn(Format('protected %s(long objptr, boolean cleanup) { _pasobj=objptr; }', [d.Name]));
-  Fjs.WriteLn(Format('public %s(Object Obj, String MethodName) { mObject=Obj; mName=MethodName; }', [d.Name]));
+  Fjs.WriteLn(Format('@Deprecated public %s(Object Obj, String MethodName) { mObject=Obj; mName=MethodName; }', [d.Name]));
   Fjs.WriteLn(Format('public %s() { mObject=this; mName="Execute"; }', [d.Name]));
   Fjs.WriteLn(Format('protected %s throws NoSuchMethodException { throw new NoSuchMethodException(); }', [GetJavaProcDeclaration(d, 'Execute')]));
   Fjs.DecI;
@@ -1382,10 +1496,9 @@ begin
 
   Fjs.WriteLn(Format('public static class %s extends %s.system.Set<%s,%s> {', [d.Name, JavaPackage, d.Name, d.ElType.Name]));
   Fjs.IncI;
-  Fjs.WriteLn(Format('protected byte Size() { return %d; }', [d.Size]));
-  Fjs.WriteLn(Format('protected int Base() { return %d; }', [d.Base]));
-  Fjs.WriteLn(Format('protected int ElMax() { return %d; }', [d.ElMax]));
-  Fjs.WriteLn(Format('protected int Ord(%s Element) { return Element.Ord(); }', [d.ElType.Name]));
+  Fjs.WriteLn(Format('@Override protected byte Size() { return %d; }', [d.Size]));
+  Fjs.WriteLn(Format('@Override protected int Base() { return %d; }', [d.Base]));
+  Fjs.WriteLn(Format('@Override protected int ElMax() { return %d; }', [d.ElMax]));
   Fjs.WriteLn(Format('public %s() { }', [d.Name]));
   Fjs.WriteLn(Format('public %s(%s... Elements) { super(Elements); }', [d.Name, d.ElType.Name]));
   Fjs.WriteLn(Format('public %0:s(%0:s... Elements) { super(Elements); }', [d.Name]));
@@ -1401,12 +1514,12 @@ begin
   if not d.IsUsed or not d.IsObjPtr then
     exit;
   if PreInfo then begin
-    WriteComment(d, 'pointer');
     RegisterPseudoClass(d);
     WriteClassInfoVar(d);
     exit;
   end;
 
+  WriteComment(d, 'pointer');
   Fjs.WriteLn(Format('public static class %s extends %s {', [d.Name, d.PtrType.Name]));
   Fjs.IncI;
   if TClassDef(d.PtrType).CType in [ctObject, ctRecord] then
@@ -1415,6 +1528,26 @@ begin
   Fjs.WriteLn(Format('public %s(long objptr) { super(objptr); }', [d.Name]));
   Fjs.DecI;
   Fjs.WriteLn('}');
+  Fjs.WriteLn;
+end;
+
+procedure TWriter.WriteClassRef(d: TClassRefDef; PreInfo: boolean);
+begin
+  if not d.IsUsed then
+    exit;
+  if PreInfo then begin
+    RegisterPseudoClass(d);
+    WriteClassInfoVar(d);
+    exit;
+  end;
+
+  WriteComment(d, 'class ref');
+  Fjs.WriteLn(Format('public static class %s extends %s {', [d.Name, d.ClassRef.Name]));
+  Fjs.IncI;
+  Fjs.WriteLn(Format('public %s(PascalObject obj) { super(obj); }', [d.Name]));
+  Fjs.DecI;
+  Fjs.WriteLn('}');
+  Fjs.WriteLn;
 end;
 
 procedure TWriter.WriteUnit(u: TUnitDef);
@@ -1442,7 +1575,7 @@ procedure TWriter.WriteUnit(u: TUnitDef);
 var
   d: TDef;
   i: integer;
-  HasSystem: boolean;
+  f: boolean;
 begin
   if u.Processed then
     exit;
@@ -1464,19 +1597,20 @@ begin
   try
     WriteFileComment(Fjs);
     Fjs.WriteLn(Format('package %s;', [JavaPackage]));
-    HasSystem:=False;
     if Length(u.UsedUnits) > 0 then begin
-      Fjs.WriteLn;
+      UpdateUsedUnits(u);
+      f:=False;
       for i:=0 to High(u.UsedUnits) do
-        if u.UsedUnits[i].IsUsed then begin
+        if u.UsedUnits[i].IsUnitUsed then begin
+          if not f then begin
+            Fjs.WriteLn;
+            f:=True;
+          end;
           Fjs.WriteLn(Format('import %s.%s.*;', [JavaPackage, LowerCase(u.UsedUnits[i].Name)]));
-          if AnsiCompareText(u.UsedUnits[i].Name, 'system') = 0 then
-            HasSystem:=True;
         end;
-      if not HasSystem then
-        Fjs.WriteLn(Format('import %s.system.*;', [JavaPackage]));
     end;
     if u.Name = 'system' then begin
+      Fjs.WriteLn;
       Fjs.WriteLn('import java.util.Date;');
       Fjs.WriteLn('import java.util.TimeZone;');
     end;
@@ -1513,8 +1647,9 @@ begin
       Fjs.WriteLn(Format('static { %s.system.InitJni(); }', [JavaPackage]));
       Fjs.WriteLn('protected long _pasobj = 0;');
       Fjs.WriteLn('protected PascalObject() { }');
-      Fjs.WriteLn('protected PascalObject(PascalObject obj) { if (obj == null) _pasobj=0; else _pasobj=obj._pasobj; }');
+      Fjs.WriteLn('protected PascalObject(PascalObject obj) { if (obj != null) _pasobj=obj._pasobj; }');
       Fjs.WriteLn('protected PascalObject(long objptr) { _pasobj=objptr; }');
+      Fjs.WriteLn('@Override protected void finalize() { }');
       Fjs.WriteLn('@Override public boolean equals(Object o) { return ((o instanceof PascalObject) && _pasobj == ((PascalObject)o)._pasobj); }');
       Fjs.WriteLn('@Override public int hashCode() { return (int)_pasobj; }');
       Fjs.DecI;
@@ -1527,11 +1662,12 @@ begin
       Fjs.WriteLn('public static class PascalObjectEx extends PascalObject {');
       Fjs.IncI;
       Fjs.WriteLn('protected boolean _cleanup = false;');
-      Fjs.WriteLn('protected void finalize() { ');
+      Fjs.WriteLn('@Override protected void finalize() { ');
 {$ifdef DEBUG}
       Fjs.WriteLn('String s = "finalize(): " + getClass().getName(); if (_cleanup) s=s+". Need __Release(). ptr="+_pasobj; System.out.println(s);', 1);
 {$endif DEBUG}
       Fjs.WriteLn('if (_cleanup) __Release();', 1);
+      Fjs.WriteLn('super.finalize();', 1);
       Fjs.WriteLn('}');
       Fjs.WriteLn('protected PascalObjectEx() { }');
       Fjs.WriteLn('protected PascalObjectEx(PascalObject obj) { super(obj); }');
@@ -1540,19 +1676,31 @@ begin
       Fjs.DecI;
       Fjs.WriteLn('}');
 
+      // Class
+      Fjs.WriteLn;
+      Fjs.WriteLn('native static long GetClassRef(int index);');
+      AddNativeMethod(u, '_GetClassRef', 'GetClassRef', '(I)J');
+      Fjs.WriteLn('static TClass GetTClass(int index) { TClass c = new TClass(null); c._pasobj=GetClassRef(index); return c; }');
+
       // Record
       Fjs.WriteLn;
       Fjs.WriteLn('public static class Record extends PascalObjectEx {');
       Fjs.IncI;
       Fjs.WriteLn('protected PascalObject _objref;');
+      Fjs.WriteLn('@Override protected void finalize() { if (_pasobj < 0) { _pasobj=-_pasobj; _cleanup=true; } super.finalize(); }');
       Fjs.WriteLn('protected void __Init(long objptr, boolean cleanup) { _pasobj=objptr; _cleanup=cleanup; if (_pasobj==0 && __Size() != 0) _pasobj=AllocMemory(__Size()); }');
       Fjs.WriteLn('protected Record(PascalObject obj) { super(obj); _objref=obj; }');
       Fjs.WriteLn('protected Record(long objptr) { super(objptr); }');
+      Fjs.WriteLn('protected final int __Size(int index) { return GetRecordSize(index); }');
       Fjs.WriteLn('public Record() { }');
       Fjs.WriteLn('public int __Size() { return 0; }');
       Fjs.DecI;
       Fjs.WriteLn('}');
 
+      Fjs.WriteLn;
+      Fjs.WriteLn('private native static int GetRecordSize(int index);');
+      AddNativeMethod(u, '_GetRecordSize', 'GetRecordSize', '(I)I');
+
       // Method pointer base class
       d:=TClassDef.Create(FThisUnit, dtClass);
       d.Name:='_TMethodPtrInfo';
@@ -1683,8 +1831,8 @@ begin
       Fps.WriteLn('else begin');
       Fps.WriteLn('mpi:=_TMethodPtrInfo.Create(env, nil, '''', '''');', 1);
       Fps.WriteLn('mpi.RealMethod:=m;', 1);
-      Fps.WriteLn('InterlockedIncrement(mpi.RefCnt);', 1);
       Fps.WriteLn('end;');
+      Fps.WriteLn('InterlockedIncrement(mpi.RefCnt);');
       Fps.WriteLn('finally', -1);
       Fps.WriteLn('_MethodPointersCS.Leave;');
       Fps.DecI;
@@ -1770,29 +1918,35 @@ begin
       Fjs.WriteLn('public int Value;');
       Fjs.WriteLn('public int Ord() { return Value; }');
       Fjs.WriteLn('@Override public boolean equals(Object o) { return (o instanceof Integer) && Value == (Integer)o; }');
+      Fjs.WriteLn('public boolean equals(int v) { return Value == v; }');
       Fjs.WriteLn('@Override public int hashCode() { return Value; }');
       Fjs.DecI;
       Fjs.WriteLn('}');
       Fjs.WriteLn;
 
       // Base class for Set
-      Fjs.WriteLn('public static class Set<TS extends Set<?,?>,TE extends Enum> {');
+      Fjs.WriteLn('private static abstract class BaseSet {');
       Fjs.IncI;
       Fjs.WriteLn('protected int Value = 0;');
-      Fjs.WriteLn('protected byte Size() { return 0; }');
-      Fjs.WriteLn('protected int Base() { return 0; }');
-      Fjs.WriteLn('protected int ElMax() { return 0; }');
-      Fjs.WriteLn('protected int Ord(TE Element) { return 0; }');
-      Fjs.WriteLn('protected int GetMask(TE Element) {');
-      Fjs.IncI;
-      Fjs.WriteLn('return 1 << (Ord(Element) - Base());');
+      Fjs.WriteLn('protected abstract byte Size();');
+      Fjs.WriteLn('protected abstract int Base();');
+      Fjs.WriteLn('protected abstract int ElMax();');
+      Fjs.WriteLn('public BaseSet() { }');
       Fjs.DecI;
       Fjs.WriteLn('}');
+
+      Fjs.WriteLn('public static abstract class Set<TS extends BaseSet,TE extends Enum> extends BaseSet {');
+      Fjs.IncI;
+      Fjs.WriteLn('protected int GetMask(TE Element) { return 1 << (Element.Ord() - Base()); }');
       Fjs.WriteLn('public Set() { }');
+      Fjs.WriteLn('@SuppressWarnings({"unchecked", "varargs"})');
       Fjs.WriteLn('public Set(TE... Elements) { Include(Elements); }');
+      Fjs.WriteLn('@SuppressWarnings({"unchecked", "varargs"})');
       Fjs.WriteLn('public Set(TS... Elements) { for (TS e : Elements) Include(e); }');
+      Fjs.WriteLn('@SuppressWarnings({"unchecked", "varargs"})');
       Fjs.WriteLn('public void Include(TE... Elements) { for (TE e: Elements) Value = Value | GetMask(e); }');
       Fjs.WriteLn('public void Include(TS s) { Value=Value | s.Value; }');
+      Fjs.WriteLn('@SuppressWarnings({"unchecked", "varargs"})');
       Fjs.WriteLn('public void Exclude(TE... Elements) { for (TE e: Elements) Value = Value & ~GetMask(e); }');
       Fjs.WriteLn('public void Exclude(TS s) { Value=Value & ~s.Value; }');
       Fjs.WriteLn('public void Assign(TS s) { Value=s.Value; }');
@@ -1800,7 +1954,7 @@ begin
       Fjs.WriteLn('public boolean Has(TE Element) { return (Value & GetMask(Element)) != 0; }');
       Fjs.WriteLn('public boolean IsEmpty() { return Value == 0; }');
       Fjs.WriteLn('public boolean equals(TS s) { return Value == s.Value; }');
-      Fjs.WriteLn('public boolean equals(TE Element) { return Value == Ord(Element); }');
+      Fjs.WriteLn('public boolean equals(TE Element) { return Value == Element.Ord(); }');
       Fjs.WriteLn('public boolean equals(int Element) { return Value == Element; }');
       Fjs.DecI;
       Fjs.WriteLn('}');
@@ -1824,6 +1978,52 @@ begin
       Fjs.DecI;
       Fjs.WriteLn('}');
       Fjs.WriteLn;
+
+      // Interface support
+      Fps.WriteLn;
+      Fps.WriteLn('function _IntfCast(env: PJNIEnv; _self: JObject; objptr: jlong; objid: jstring): jlong;' + JniCaliing);
+      Fps.WriteLn('var');
+      Fps.WriteLn('obj: system.TObject;', 1);
+      Fps.WriteLn('intf: IUnknown;', 1);
+      Fps.WriteLn('begin');
+      Fps.IncI;
+      Fps.WriteLn('Result:=0;');
+      EHandlerStart;
+      Fps.WriteLn('if objptr = 0 then exit;');
+      Fps.WriteLn('if objid = nil then');
+      Fps.WriteLn('raise Exception.Create(''A GUID must be assigned for the interface to allow a type cast.'');', 1);
+      Fps.WriteLn('obj:=system.TObject(pointer(ptruint(objptr)));');
+      Fps.WriteLn('if not (obj is system.TInterfacedObject) then');
+      Fps.WriteLn('raise Exception.Create(''Object must be inherited from TInterfacedObject.'');', 1);
+      Fps.WriteLn('if (system.TInterfacedObject(obj) as IUnknown).QueryInterface(StringToGUID(ansistring(_StringFromJString(env, objid))), intf) <> 0 then');
+      Fps.WriteLn('raise Exception.Create(''Invalid type cast.'');', 1);
+      Fps.WriteLn('intf._AddRef;');
+      Fps.WriteLn('Result:=ptruint(intf);');
+      EHandlerEnd('env');
+      Fps.DecI;
+      Fps.WriteLn('end;');
+
+      AddNativeMethod(u, '_IntfCast', 'InterfaceCast', '(JLjava/lang/String;)J');
+
+      Fjs.WriteLn('private native static long InterfaceCast(long objptr, String objid);');
+      Fjs.WriteLn;
+      Fjs.WriteLn('public static class PascalInterface extends PascalObjectEx {');
+      Fjs.IncI;
+      Fjs.WriteLn('protected void __Init() { }');
+      Fjs.WriteLn('public void __TypeCast(PascalObject obj, String intfId) {');
+      Fjs.WriteLn('if (obj != null) {', 1);
+      Fjs.WriteLn('if (obj instanceof PascalInterface) {', 2);
+      Fjs.WriteLn('_pasobj=obj._pasobj;',3);
+      Fjs.WriteLn('__Init();',3);
+      Fjs.WriteLn('} else',2);
+      Fjs.WriteLn('_pasobj=InterfaceCast(obj._pasobj, intfId);', 3);
+      Fjs.WriteLn('}', 1);
+      Fjs.WriteLn('}');
+      Fjs.WriteLn('protected PascalInterface(long objptr, boolean cleanup) { _pasobj=objptr; __Init(); }');
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+      Fjs.WriteLn;
+
     end;
     Fjs.WriteLn(Format('static { %s.system.InitJni(); }', [JavaPackage]));
     Fjs.WriteLn;
@@ -1842,6 +2042,8 @@ begin
           WriteProcType(TProcDef(d), True);
         dtPointer:
           WritePointer(TPointerDef(d), True);
+        dtClassRef:
+          WriteClassRef(TClassRefDef(d), True);
       end;
     end;
 
@@ -1867,6 +2069,8 @@ begin
           WriteConst(TConstDef(d));
         dtPointer:
           WritePointer(TPointerDef(d), False);
+        dtClassRef:
+          WriteClassRef(TClassRefDef(d), False);
       end;
     end;
 
@@ -1891,10 +2095,10 @@ begin
 
   Fps.WriteLn('const');
   for i:=0 to FClasses.Count - 1 do begin
-    ci:=TClassInfo(FClasses.Objects[i]);
+    ci:=FClasses.GetClassInfo(i);
     if ci.Funcs.Count = 0 then
       continue;
-    Fps.WriteLn(Format('  _%sNativeMethods: array[0..%d] of JNINativeMethod = (', [GetClassPrefix(ci.Def, FClasses[i]), ci.Funcs.Count - 1]));
+    Fps.WriteLn(Format('  _%sNativeMethods: array[0..%d] of JNINativeMethod = (', [GetClassPrefix(ci.Def, FClasses.GetClassName(i)), ci.Funcs.Count - 1]));
     for j:=0 to ci.Funcs.Count - 1 do begin
       with TProcInfo(ci.Funcs[j]) do
         Fps.Write(Format('    (name: ''%s''; signature: ''%s''; fnPtr: @%s)', [Name, JniSignature, JniName]));
@@ -1953,7 +2157,7 @@ begin
   end;
 
   for i:=0 to FClasses.Count - 1 do begin
-    ci:=TClassInfo(FClasses.Objects[i]);
+    ci:=FClasses.GetClassInfo(i);
     s:=GetTypeInfoVar(ci.Def);
     if (s = '') or (ci.IsCommonClass) then
       s:='nil'
@@ -1962,13 +2166,13 @@ begin
     if ci.Funcs.Count = 0 then
       ss:='nil'
     else
-      ss:=Format('@_%sNativeMethods', [GetClassPrefix(ci.Def, FClasses[i])]);
+      ss:=Format('@_%sNativeMethods', [GetClassPrefix(ci.Def, FClasses.GetClassName(i))]);
     fn:='';
     if ci.Def <> nil then
       if ci.Def.DefType in [dtSet, dtEnum] then
         fn:=', ''Value'', ''I''';
     Fps.WriteLn(Format('if not _Reg(''%s'', %s, %d, %s%s) then exit;',
-                       [GetJavaClassPath(ci.Def, FClasses[i]), ss, ci.Funcs.Count, s, fn]));
+                       [GetJavaClassPath(ci.Def, FClasses.GetClassName(i)), ss, ci.Funcs.Count, s, fn]));
   end;
 
   Fps.WriteLn('Result:=JNI_VERSION_1_6;');
@@ -1978,6 +2182,75 @@ begin
   Fps.WriteLn('exports JNI_OnLoad;');
 end;
 
+procedure TWriter.WriteRecordSizes;
+var
+  i, j: integer;
+  s: string;
+begin
+  Fps.WriteLn;
+  Fps.WriteLn('function _GetRecordSize(env: PJNIEnv; jobj: jobject; index: jint): jint;' + JniCaliing);
+  if FRecords.Count > 0 then begin
+    Fps.WriteLn(Format('const sizes: array[0..%d] of longint =', [FRecords.Count - 1]));
+    Fps.IncI;
+    s:='(';
+    j:=0;
+    for i:=0 to FRecords.Count - 1 do begin
+      if i > 0 then
+        s:=s + ',';
+      Inc(j);
+      if j > 20 then begin
+        Fps.WriteLn(s);
+        s:='';
+        j:=0;
+      end;
+      s:=s + IntToStr(TClassDef(FRecords[i]).Size);
+    end;
+    Fps.WriteLn(s + ');');
+    Fps.DecI;
+  end;
+  Fps.WriteLn('begin');
+  if FRecords.Count > 0 then
+    s:='sizes[index]'
+  else
+    s:='0';
+  Fps.WriteLn('Result:=' + s + ';', 1);
+  Fps.WriteLn('end;');
+end;
+
+procedure TWriter.WriteClassTable;
+var
+  i: integer;
+  s,ss: string;
+begin
+  Fps.WriteLn;
+  Fps.WriteLn('function _GetClassRef(env: PJNIEnv; jobj: jobject; index: jint): jlong;' + JniCaliing);
+  if FRealClasses.Count > 0 then begin
+    Fps.WriteLn(Format('const cls: array[0..%d] of TClass =', [FRealClasses.Count - 1]));
+    Fps.IncI;
+    s:='(';
+    for i:=0 to FRealClasses.Count - 1 do begin
+      if i > 0 then
+        s:=s + ',';
+      if Length(s) > 100 then begin
+        Fps.WriteLn(s);
+        s:='';
+      end;
+      with TClassDef(FRealClasses[i]) do
+        ss:=Parent.Name + '.' + Name;
+      s:=s + ss;
+    end;
+    Fps.WriteLn(s + ');');
+    Fps.DecI;
+  end;
+  Fps.WriteLn('begin');
+  if FRealClasses.Count > 0 then
+    s:='cls[index]'
+  else
+    s:='nil';
+  Fps.WriteLn('Result:=-jlong(ptruint(pointer(' + s + ')));', 1);
+  Fps.WriteLn('end;');
+end;
+
 function TWriter.JniToPasType(d: TDef; const v: string; CheckNil: boolean): string;
 var
   n: string;
@@ -2033,6 +2306,11 @@ begin
         else
           Result:=Format('pointer(ptruint(%s))', [Result]);
       end;
+    dtClassRef:
+      begin
+        Result:=Format('_GetClass(_env, %s, %s)', [Result, GetTypeInfoVar(d)]);
+        Result:=Format('%s.%s(%s)', [d.Parent.Name, d.Name, Result]);
+      end;
   end;
 end;
 
@@ -2048,7 +2326,7 @@ begin
           btString, btWideString:
             Result:=Format('_StringToJString(_env, _JNIString(%s))', [Result]);
           btBoolean:
-            Result:=Format('jboolean(LongBool(%s))', [Result]);
+            Result:=Format('(jboolean(%s) and 1)', [Result]);
           btChar:
             Result:=Format('jchar(widechar(%s))', [Result]);
           btWideChar:
@@ -2078,6 +2356,8 @@ begin
         Result:=Format('_CreateJavaObj(_env, %s, %s)', [Result, GetTypeInfoVar(d)])
       else
         Result:=Format('ptruint(pointer(%s))', [Result]);
+    dtClassRef:
+      Result:=Format('_CreateJavaObj(_env, -jlong(ptruint(pointer(%s))), %s)', [Result, GetTypeInfoVar(d)])
   end;
 end;
 
@@ -2249,10 +2529,10 @@ procedure TWriter.RegisterPseudoClass(d: TDef);
 var
   ci: TClassInfo;
 begin
-  if FClasses.IndexOf(d.Name) < 0 then begin
+  if FClasses.IndexOf(d.Name, d) < 0 then begin
     ci:=TClassInfo.Create;
     ci.Def:=d;
-    FClasses.AddObject(d.Name, ci);
+    FClasses.Add(d.Name, d, ci);
   end;
 end;
 
@@ -2305,13 +2585,13 @@ begin
   pi.Name:=Name;
   pi.JniName:=JniName;
   pi.JniSignature:=Signature;
-  i:=FClasses.IndexOf(ParentDef.AliasName);
+  i:=FClasses.IndexOf(ParentDef.AliasName, ParentDef);
   if i < 0 then begin
     ci:=TClassInfo.Create;
     ci.Def:=ParentDef;
-    i:=FClasses.AddObject(ParentDef.AliasName, ci);
+    i:=FClasses.Add(ParentDef.AliasName, ParentDef, ci);
   end;
-  TClassInfo(FClasses.Objects[i]).Funcs.Add(pi);
+  FClasses.GetClassInfo(i).Funcs.Add(pi);
 end;
 
 function TWriter.GetProcSignature(d: TProcDef): string;
@@ -2351,6 +2631,42 @@ begin
   Fps.WriteLn('end;');
 end;
 
+procedure TWriter.UpdateUsedUnits(u: TUnitDef);
+
+  procedure _CheckDef(d: TDef);
+  begin
+    if (d = nil) or not d.IsUsed then
+      exit;
+    d:=d.Parent;
+    if (d <> nil) and (d.DefType = dtUnit) then
+      with TUnitDef(d) do
+        if not IsUnitUsed and IsUsed then
+          IsUnitUsed:=True;
+  end;
+
+  procedure _ScanDef(def: TDef);
+  var
+    i: integer;
+    d: TDef;
+  begin
+    for i:=0 to def.Count - 1 do begin
+      d:=def[i];
+      if not d.IsUsed then
+        continue;
+      _CheckDef(d.GetRefDef);
+      _CheckDef(d.GetRefDef2);
+      _ScanDef(d);
+    end;
+  end;
+
+var
+  i: integer;
+begin
+  for i:=0 to High(u.UsedUnits) do
+    u.UsedUnits[i].IsUnitUsed:=False;
+  _ScanDef(u);
+end;
+
 procedure TWriter.WriteClassInfoVar(d: TDef);
 begin
   Fps.WriteLn;
@@ -2398,8 +2714,7 @@ var
   i: integer;
 begin
   Units:=TStringList.Create;
-  FClasses:=TStringList.Create;
-  FClasses.Sorted:=True;
+  FClasses:=TClassList.Create;
   JavaPackage:='pas';
   IncludeList:=TStringList.Create;
   IncludeList.Duplicates:=dupIgnore;
@@ -2412,6 +2727,17 @@ begin
     ExcludeList.Add(ExcludeDelphi7[i]);
 
   FThisUnit:=TUnitDef.Create(nil, dtUnit);
+  FRecords:=TObjectList.Create(False);
+  FRealClasses:=TObjectList.Create(False);
+end;
+
+function DoCanUseDef(def, refdef: TDef): boolean;
+begin
+  Result:=True;
+  if (def.DefType = dtArray) and (refdef is TVarDef) then begin
+    // Arrays are supported only for variables, fields, properties and constants
+    Result:=refdef.DefType in [dtVar, dtProp, dtField, dtConst];
+  end;
 end;
 
 destructor TWriter.Destroy;
@@ -2425,6 +2751,8 @@ begin
   IncludeList.Free;
   ExcludeList.Free;
   FThisUnit.Free;
+  FRecords.Free;
+  FRealClasses.Free;
   inherited Destroy;
 end;
 
@@ -2487,6 +2815,7 @@ begin
   p:=TPPUParser.Create(SearchPath);
   try
     p.OnCheckItem:=@DoCheckItem;
+    OnCanUseDef:=@DoCanUseDef;
     for i:=0 to Units.Count - 1 do
       IncludeList.Add(ChangeFileExt(ExtractFileName(Units[i]), ''));
     for i:=0 to Units.Count - 1 do
@@ -2507,18 +2836,26 @@ begin
 
     Fps.WriteLn;
     Fps.WriteLn('uses');
-    Fps.WriteLn('{$ifndef FPC} Windows, {$endif} {$ifdef unix} cthreads, {$endif} SysUtils, SyncObjs,', 1);
+    Fps.WriteLn('{$ifdef unix} cthreads, {$endif}', 1);
     s:='';
     for i:=0 to p.Units.Count - 1 do begin
       ProcessRules(p.Units[i]);
       ss:=LowerCase(p.Units[i].Name);
-      if (ss ='system') or (ss = 'objpas') or (ss = 'sysutils') or (ss = 'syncobjs') or (ss = 'jni') then
+      if (ss ='system') or (ss = 'objpas') or (ss = 'sysutils') or (ss = 'syncobjs') or (ss = 'jni')
+         or (ss = 'cthreads') or (ss = 'windows')
+      then
         continue;
       if s <> '' then
         s:=s + ', ';
+      if Length(s) >= 100 then begin
+        Fps.WriteLn(s, 1);
+        s:='';
+      end;
       s:=s + p.Units[i].Name;
     end;
-    Fps.WriteLn(s + ', jni;', 1);
+    if s <> '' then
+      Fps.WriteLn(s + ',', 1);
+    Fps.WriteLn('{$ifndef FPC} Windows, {$endif} SysUtils, SyncObjs, jni;', 1);
 
     // Types
     Fps.WriteLn;
@@ -2564,13 +2901,13 @@ begin
     Fps.WriteLn('end;');
 
     Fps.WriteLn;
-    Fps.WriteLn('function _CreateJavaObj(env: PJNIEnv; PasObj: pointer; const ci: _TJavaClassInfo; cleanup: boolean = True): jobject;');
+    Fps.WriteLn('function _CreateJavaObj(env: PJNIEnv; PasObj: jlong; const ci: _TJavaClassInfo; cleanup: boolean = True): jobject; overload;');
     Fps.WriteLn('var v: array [0..1] of jvalue;');
     Fps.WriteLn('begin');
     Fps.IncI;
     Fps.WriteLn('Result:=nil;');
-    Fps.WriteLn('if PasObj = nil then exit;');
-    Fps.WriteLn('v[0].J:=Int64(ptruint(PasObj));');
+    Fps.WriteLn('if PasObj = 0 then exit;');
+    Fps.WriteLn('v[0].J:=PasObj;');
     Fps.WriteLn('if ci.ConstrId = nil then begin');
     Fps.WriteLn('Result:=env^^.AllocObject(env, ci.ClassRef);', 1);
     Fps.WriteLn('if Result = nil then exit;', 1);
@@ -2581,6 +2918,12 @@ begin
     Fps.WriteLn('end;');
     Fps.DecI;
     Fps.WriteLn('end;');
+    Fps.WriteLn;
+    Fps.WriteLn('function _CreateJavaObj(env: PJNIEnv; PasObj: pointer; const ci: _TJavaClassInfo; cleanup: boolean = True): jobject; overload;');
+    Fps.WriteLn('begin');
+    Fps.WriteLn('Result:=_CreateJavaObj(env, jlong(ptruint(PasObj)), ci, cleanup)', 1);
+    Fps.WriteLn('end;');
+    Fps.WriteLn;
 
     Fps.WriteLn;
     Fps.WriteLn('function _GetPasObj(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo; CheckNil: boolean): pointer;');
@@ -2591,13 +2934,29 @@ begin
     Fps.WriteLn('pasobj:=env^^.GetLongField(env, jobj, ci.ObjFieldId)', 1);
     Fps.WriteLn('else');
     Fps.WriteLn('pasobj:=0;', 1);
-    Fps.WriteLn('if CheckNil and (pasobj = 0) then');
+    Fps.WriteLn('if CheckNil and (pasobj <= 0) then');
     Fps.WriteLn('raise Exception.Create(''Attempt to access a released Pascal object.'');', 1);
     Fps.WriteLn('Result:=pointer(ptruint(pasobj));');
     Fps.DecI;
     Fps.WriteLn('end;');
 
     Fps.WriteLn;
+    Fps.WriteLn('function _GetClass(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo): TClass;');
+    Fps.WriteLn('var pasobj: jlong;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('if jobj <> nil then');
+    Fps.WriteLn('pasobj:=env^^.GetLongField(env, jobj, ci.ObjFieldId)', 1);
+    Fps.WriteLn('else');
+    Fps.WriteLn('pasobj:=0;', 1);
+    Fps.WriteLn('if pasobj > 0 then');
+    Fps.WriteLn('Result:=TObject(ptruint(pasobj)).ClassType', 1);
+    Fps.WriteLn('else');
+    Fps.WriteLn('Result:=TClass(ptruint(-pasobj));', 1);
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
     Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);');
     Fps.WriteLn('begin');
     if p.OnExceptionProc <> nil then begin
@@ -2654,6 +3013,9 @@ begin
         WriteUnit(TUnitDef(p.Units[i]));
       end;
 
+    WriteRecordSizes;
+    WriteClassTable;
+
     WriteOnLoad;
 
     Fps.WriteLn;
diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js
new file mode 100644
index 0000000000..34d34df847
--- /dev/null
+++ b/utils/pas2js/dist/rtl.js
@@ -0,0 +1,345 @@
+/*
+    This file is part of the Free Pascal pas2js tool.
+    Copyright (c) 2017 Mattias Gaertner
+
+    Basic RTL for pas2js programs.
+
+    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.
+*/
+
+var pas = {};
+
+var rtl = {
+
+  quiet: false,
+  debug_load_units: false,
+
+  m_loading: 0,
+  m_loading_intf: 1,
+  m_intf_loaded: 2,
+  m_loading_impl: 3, // loading all used unit
+  m_initializing: 4, // running initialization
+  m_initialized: 5,
+
+  debug: function(){
+    if (rtl.quiet || !console || !console.log) return;
+    console.log(arguments);
+  },
+
+  error: function(s){
+    rtl.debug('Error: ',s);
+    throw s;
+  },
+
+  warn: function(s){
+    rtl.debug('Warn: ',s);
+  },
+
+  isArray: function(a) {
+    return a instanceof Array;
+  },
+
+  isNumber: function(n){
+    return typeof(n)=="number";
+  },
+
+  isInteger: function(A){
+    return Math.floor(A)===A;
+  },
+
+  isBoolean: function(b){
+    return typeof(b)=="boolean";
+  },
+
+  isString: function(s){
+    return typeof(s)=="string";
+  },
+
+  isObject: function(o){
+    return typeof(o)=="object";
+  },
+
+  isFunction: function(f){
+    return typeof(f)=="function";
+  },
+
+  isNull: function(o){
+    return (o==null && typeof(o)=='object') || o==undefined;
+  },
+
+  isRecord: function(r){
+    return (typeof(r)=="function") && (typeof(r.$create) == "function");
+  },
+
+  isClass: function(c){
+    return (typeof(o)=="object") && (o.$class == o);
+  },
+
+  isClassInstance: function(c){
+    return (typeof(o)=="object") && (o.$class == Object.getPrototypeOf(o));
+  },
+
+  hasString: function(s){
+    return rtl.isString(s) && (s.length>0);
+  },
+
+  module: function(module_name, intfuseslist, code, impluseslist){
+    if (rtl.debug_load_units) rtl.debug('rtl.module name="'+module_name+'" intfuses='+intfuseslist+' impluses='+impluseslist);
+    if (!rtl.hasString(module_name)) rtl.error('invalid module name "'+module_name+'"');
+    if (!rtl.isArray(intfuseslist)) rtl.error('invalid interface useslist of "'+module_name+'"');
+    if (!rtl.isFunction(code)) rtl.error('invalid module code of "'+module_name+'"');
+    if ((impluseslist!=undefined) && !rtl.isArray(impluseslist)) rtl.error('invalid implementation useslist of "'+module_name+'"');
+
+    if (pas[module_name])
+      rtl.error('module "'+module_name+'" already registered');
+
+    var module = pas[module_name] = {
+      $name: module_name,
+      $intfuseslist: intfuseslist,
+      $impluseslist: impluseslist,
+      $state: rtl.m_loading,
+      $code: code
+    };
+  },
+
+  run: function(module_name){
+    if (module_name==undefined) module_name='program';
+    if (rtl.debug_load_units) rtl.debug('rtl.run module="'+module_name+'"');
+    var module = pas[module_name];
+    rtl.loadintf(module);
+    rtl.loadimpl(module);
+    if (module_name=='program'){
+      if (rtl.debug_load_units) rtl.debug('running $main');
+      pas.program.$main();
+    }
+    return pas.System.ExitCode;
+  },
+
+  loadintf: function(module){
+    if (module.state>rtl.m_loading_intf) return; // already finished
+    if (rtl.debug_load_units) rtl.debug('loadintf: '+module.$name);
+    if (module.$state==rtl.m_loading_intf)
+      rtl.error('unit cycle detected "'+module.$name+'"');
+    module.$state=rtl.m_loading_intf;
+    // load interfaces of interface useslist
+    rtl.loaduseslist(module,module.$intfuseslist,rtl.loadintf);
+    // run interface
+    if (rtl.debug_load_units) rtl.debug('loadintf: run intf of '+module.$name);
+    module.$code(module.$intfuseslist,module);
+    // success
+    module.$state=rtl.m_intf_loaded;
+    // Note: units only used in implementations are not yet loaded (not even their interfaces)
+  },
+
+  loaduseslist: function(module,useslist,f){
+    if (useslist==undefined) return;
+    for (var i in useslist){
+      var unitname=useslist[i];
+      if (rtl.debug_load_units) rtl.debug('loaduseslist of "'+module.name+'" uses="'+unitname+'"');
+      if (pas[unitname]==undefined)
+        rtl.error('module "'+module.$name+'" misses "'+unitname+'"');
+      f(pas[unitname]);
+    }
+  },
+
+  loadimpl: function(module){
+    if (module.$state>=rtl.m_loading_impl) return; // already processing
+    if (module.$state<rtl.m_loading_intf) rtl.loadintf(module);
+    if (rtl.debug_load_units) rtl.debug('loadimpl: '+module.$name+' load uses');
+    module.$state=rtl.m_loading_impl;
+    // load implementation of interfaces useslist
+    rtl.loaduseslist(module,module.$intfuseslist,rtl.loadimpl);
+    // load implementation of implementation useslist
+    rtl.loaduseslist(module,module.$impluseslist,rtl.loadimpl);
+    // Note: At this point all interfaces used by this unit are loaded. If
+    // there are implementation uses cycles some used units might not yet be
+    // initialized. This is by design.
+
+    // run initialization
+    if (rtl.debug_load_units) rtl.debug('loadimpl: '+module.$name+' run init');
+    module.$state=rtl.m_initializing;
+    if (rtl.isFunction(module.$init))
+      module.$init();
+    // unit initialized
+    module.$state=rtl.m_initialized;
+  },
+
+  createCallback: function(scope, fnname){
+    var cb = function(){
+      return scope[fnname].apply(scope,arguments);
+    };
+    cb.scope = scope;
+    cb.fnname = fnname;
+    return cb;
+  },
+
+  cloneCallback: function(cb){
+    return rtl.createCallback(cb.scope,cb.fnname);
+  },
+
+  eqCallback: function(a,b){
+    if (a==null){
+      return (b==null);
+    } else {
+      return (b!=null) && (a.scope==b.scope) && (a.fnname==b.fnname);
+    }
+  },
+
+  createClass: function(owner,name,ancestor,initfn){
+    var c = null;
+    if (ancestor != null){
+      c = Object.create(ancestor);
+      c.$ancestor = ancestor; // c.$ancestor == Object.getPrototypeOf(c)
+    } else {
+      c = {};
+      c.$create = function(fnname,args){
+        var o = Object.create(this);
+        o.$class = this; // Note: o.$class == Object.getPrototypeOf(o)
+        if (args == undefined) args = [];
+        o.$init();
+        o[fnname].apply(o,args);
+        o.AfterConstruction();
+        return o;
+      };
+      c.$destroy = function(fnname){
+        this.BeforeDestruction();
+        this[fnname]();
+        this.$final;
+      };
+    };
+    c.$classname = name;
+    c.$name = owner.$name+'.'+name;
+    c.$unitname = rtl.isString(owner.$unitname) ? owner.$unitname : owner.$name;
+    owner[name] = c;
+    initfn.call(c);
+  },
+
+  as: function(instance,typ){
+    if(typ.isPrototypeOf(instance)) return instance;
+    throw pas.System.EInvalidCast.$create("create");
+  },
+
+  arraySetLength: function(arr,newlength,defaultvalue){
+    var oldlen = arr.length;
+    if (oldlen==newlength) return;
+    arr.length = newlength;
+    if (rtl.isArray(defaultvalue)){
+      for (var i=oldlen; i<newlength; i++) arr[i]=[]; // new array
+    } else if (rtl.isFunction(defaultvalue)){
+      for (var i=oldlen; i<newlength; i++) arr[i]=new defaultvalue(); // new record
+    } else {
+      for (var i=oldlen; i<newlength; i++) arr[i]=defaultvalue;
+    }
+    return arr;
+  },
+
+  arrayNewMultiDim: function(dims,defaultvalue){
+    function create(dim){
+      if (dim == dims.length-1){
+        return rtl.arraySetLength([],dims[dim],defaultvalue);
+      }
+      var a = [];
+      var count = dims[dim];
+      a.length = count;
+      for(var i=0; i<count; i++) a[i] = create(dim+1);
+      return a;
+    };
+    return create(0);
+  },
+
+  setCharAt: function(s,index,c){
+    return s.substr(0,index)+c+s.substr(index+1);
+  },
+
+  createSet: function(){
+    var s = {};
+    for (var i=0; i<arguments.length; i++){
+      if (arguments[i]!=null){
+        s[arguments[i]]=true;
+      } else {
+        var first=arguments[i+=1];
+        var last=arguments[i+=1];
+        for(var j=first; j<=last; j++) s[j]=true;
+      }
+    }
+    return s;
+  },
+
+  cloneSet: function(s){
+    var r = {};
+    for (var key in s) if (s.hasOwnProperty(key)) r[key]=true;
+    return r;
+  },
+
+  refSet: function(s){
+    s.$shared = true;
+    return s;
+  },
+
+  includeSet: function(s,enumvalue){
+    if (s.$shared) s = cloneSet(s);
+    s[enumvalue] = true;
+    return s;
+  },
+
+  excludeSet: function(s,enumvalue){
+    if (s.$shared) s = cloneSet(s);
+    delete s[enumvalue];
+    return s;
+  },
+
+  diffSet: function(s,t){
+    var r = {};
+    for (var key in s) if (s.hasOwnProperty(key) && !t[key]) r[key]=true;
+    delete r.$shared;
+    return r;
+  },
+
+  unionSet: function(s,t){
+    var r = {};
+    for (var key in s) if (s.hasOwnProperty(key)) r[key]=true;
+    for (var key in t) if (t.hasOwnProperty(key)) r[key]=true;
+    delete r.$shared;
+    return r;
+  },
+
+  intersectSet: function(s,t){
+    var r = {};
+    for (var key in s) if (s.hasOwnProperty(key) && t[key]) r[key]=true;
+    delete r.$shared;
+    return r;
+  },
+
+  symDiffSet: function(s,t){
+    var r = {};
+    for (var key in s) if (s.hasOwnProperty(key) && !t[key]) r[key]=true;
+    for (var key in t) if (t.hasOwnProperty(key) && !s[key]) r[key]=true;
+    delete r.$shared;
+    return r;
+  },
+
+  eqSet: function(s,t){
+    for (var key in s) if (s.hasOwnProperty(key) && !t[key] && (key!='$shared')) return false;
+    for (var key in t) if (t.hasOwnProperty(key) && !s[key] && (key!='$shared')) return false;
+    return true;
+  },
+
+  neSet: function(s,t){
+    return !rtl.eqSet(s,t);
+  },
+
+  leSet: function(s,t){
+    for (var key in s) if (s.hasOwnProperty(key) && !t[key] && (key!='$shared')) return false;
+    return true;
+  },
+
+  geSet: function(s,t){
+    for (var key in t) if (t.hasOwnProperty(key) && !s[key] && (key!='$shared')) return false;
+    return true;
+  },
+}