auto-merge: trunk -> InterfaceRTTI

git-svn-id: branches/interfacertti@33858 -

.gitattributes

@@ -358,6 +358,7 @@ compiler/llvm/symllvm.pas svneol=native#text/plain
 compiler/llvm/tgllvm.pas svneol=native#text/plain
 compiler/m68k/aasmcpu.pas svneol=native#text/plain
 compiler/m68k/ag68kgas.pas svneol=native#text/plain
+compiler/m68k/ag68kvasm.pas svneol=native#text/plain
 compiler/m68k/aoptcpu.pas svneol=native#text/plain
 compiler/m68k/aoptcpub.pas svneol=native#text/plain
 compiler/m68k/aoptcpud.pas svneol=native#text/plain
@@ -377,6 +378,7 @@ compiler/m68k/n68kcnv.pas svneol=native#text/plain
 compiler/m68k/n68kinl.pas svneol=native#text/plain
 compiler/m68k/n68kmat.pas svneol=native#text/plain
 compiler/m68k/n68kmem.pas svneol=native#text/plain
+compiler/m68k/n68kset.pas svneol=native#text/plain
 compiler/m68k/r68kbss.inc svneol=native#text/plain
 compiler/m68k/r68kcon.inc svneol=native#text/plain
 compiler/m68k/r68kgas.inc svneol=native#text/plain
@@ -2019,6 +2021,7 @@ packages/fcl-base/examples/txmlreg.pp svneol=native#text/plain
 packages/fcl-base/examples/xmldump.pp svneol=native#text/plain
 packages/fcl-base/fpmake.pp svneol=native#text/plain
 packages/fcl-base/src/advancedipc.pp svneol=native#text/plain
+packages/fcl-base/src/advancedsingleinstance.pas svneol=native#text/plain
 packages/fcl-base/src/ascii85.pp svneol=native#text/plain
 packages/fcl-base/src/avl_tree.pp svneol=native#text/plain
 packages/fcl-base/src/base64.pp svneol=native#text/plain
@@ -2603,6 +2606,8 @@ packages/fcl-pdf/utils/ttfdump.lpr svneol=native#text/plain
 packages/fcl-process/Makefile svneol=native#text/plain
 packages/fcl-process/Makefile.fpc svneol=native#text/plain
 packages/fcl-process/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-process/examples/checkipcserver.lpi svneol=native#text/plain
+packages/fcl-process/examples/checkipcserver.lpr svneol=native#text/plain
 packages/fcl-process/examples/demoproject.ico -text
 packages/fcl-process/examples/demoproject.lpi svneol=native#text/plain
 packages/fcl-process/examples/demoproject.pp svneol=native#text/plain
@@ -2616,6 +2621,8 @@ packages/fcl-process/examples/ipcclient.lpi svneol=native#text/plain
 packages/fcl-process/examples/ipcclient.pp svneol=native#text/plain
 packages/fcl-process/examples/ipcserver.lpi svneol=native#text/plain
 packages/fcl-process/examples/ipcserver.pp svneol=native#text/plain
+packages/fcl-process/examples/simpleipcserver.lpi svneol=native#text/plain
+packages/fcl-process/examples/simpleipcserver.lpr svneol=native#text/plain
 packages/fcl-process/examples/waitonexit.pp svneol=native#text/pascal
 packages/fcl-process/fpmake.pp svneol=native#text/plain
 packages/fcl-process/src/amicommon/pipes.inc svneol=native#text/plain
@@ -3589,14 +3596,18 @@ packages/googleapi/README.txt svneol=native#text/plain
 packages/googleapi/examples/generator/googleapiconv.lpi svneol=native#text/plain
 packages/googleapi/examples/generator/googleapiconv.pp svneol=native#text/plain
 packages/googleapi/fpmake.pp svneol=native#text/plain
+packages/googleapi/src/googleacceleratedmobilepageurl.pp svneol=native#text/plain
 packages/googleapi/src/googleadexchangebuyer.pp svneol=native#text/plain
+packages/googleapi/src/googleadexchangebuyer2.pp svneol=native#text/plain
 packages/googleapi/src/googleadexchangeseller.pp svneol=native#text/plain
 packages/googleapi/src/googleadmin.pp svneol=native#text/plain
 packages/googleapi/src/googleadsense.pp svneol=native#text/plain
 packages/googleapi/src/googleadsensehost.pp svneol=native#text/plain
 packages/googleapi/src/googleanalytics.pp svneol=native#text/plain
+packages/googleapi/src/googleanalyticsreporting.pp svneol=native#text/plain
 packages/googleapi/src/googleandroidenterprise.pp svneol=native#text/plain
 packages/googleapi/src/googleandroidpublisher.pp svneol=native#text/plain
+packages/googleapi/src/googleappengine.pp svneol=native#text/plain
 packages/googleapi/src/googleappsactivity.pp svneol=native#text/plain
 packages/googleapi/src/googleappstate.pp svneol=native#text/plain
 packages/googleapi/src/googleaudit.pp svneol=native#text/plain
@@ -3607,17 +3618,27 @@ packages/googleapi/src/googleblogger.pp svneol=native#text/plain
 packages/googleapi/src/googlebooks.pp svneol=native#text/plain
 packages/googleapi/src/googlecalendar.pp svneol=native#text/plain
 packages/googleapi/src/googlecivicinfo.pp svneol=native#text/plain
+packages/googleapi/src/googleclassroom.pp svneol=native#text/plain
 packages/googleapi/src/googleclient.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudbilling.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudbuild.pp svneol=native#text/plain
+packages/googleapi/src/googleclouddebugger.pp svneol=native#text/plain
+packages/googleapi/src/googleclouderrorreporting.pp svneol=native#text/plain
 packages/googleapi/src/googlecloudlatencytest.pp svneol=native#text/plain
 packages/googleapi/src/googlecloudmonitoring.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudresourcemanager.pp svneol=native#text/plain
 packages/googleapi/src/googlecloudsearch.pp svneol=native#text/plain
+packages/googleapi/src/googlecloudtrace.pp svneol=native#text/plain
+packages/googleapi/src/googleclouduseraccounts.pp svneol=native#text/plain
 packages/googleapi/src/googlecompute.pp svneol=native#text/plain
 packages/googleapi/src/googlecomputeaccounts.pp svneol=native#text/plain
+packages/googleapi/src/googleconsumersurveys.pp svneol=native#text/plain
 packages/googleapi/src/googlecontainer.pp svneol=native#text/plain
 packages/googleapi/src/googlecontent.pp svneol=native#text/plain
 packages/googleapi/src/googlecoordinate.pp svneol=native#text/plain
 packages/googleapi/src/googlecustomsearch.pp svneol=native#text/plain
 packages/googleapi/src/googledataflow.pp svneol=native#text/plain
+packages/googleapi/src/googledataproc.pp svneol=native#text/plain
 packages/googleapi/src/googledatastore.pp svneol=native#text/plain
 packages/googleapi/src/googledeploymentmanager.pp svneol=native#text/plain
 packages/googleapi/src/googledfareporting.pp svneol=native#text/plain
@@ -3627,48 +3648,65 @@ packages/googleapi/src/googledns.pp svneol=native#text/plain
 packages/googleapi/src/googledoubleclickbidmanager.pp svneol=native#text/plain
 packages/googleapi/src/googledoubleclicksearch.pp svneol=native#text/plain
 packages/googleapi/src/googledrive.pp svneol=native#text/plain
+packages/googleapi/src/googlefirebaserules.pp svneol=native#text/plain
 packages/googleapi/src/googlefitness.pp svneol=native#text/plain
 packages/googleapi/src/googlefreebase.pp svneol=native#text/plain
 packages/googleapi/src/googlefusiontables.pp svneol=native#text/plain
 packages/googleapi/src/googlegames.pp svneol=native#text/plain
-packages/googleapi/src/googlegamesConfiguration.pp svneol=native#text/plain
-packages/googleapi/src/googlegamesManagement.pp svneol=native#text/plain
+packages/googleapi/src/googlegamesconfiguration.pp svneol=native#text/plain
+packages/googleapi/src/googlegamesmanagement.pp svneol=native#text/plain
 packages/googleapi/src/googlegan.pp svneol=native#text/plain
 packages/googleapi/src/googlegenomics.pp svneol=native#text/plain
 packages/googleapi/src/googlegmail.pp svneol=native#text/plain
 packages/googleapi/src/googlegroupsmigration.pp svneol=native#text/plain
 packages/googleapi/src/googlegroupssettings.pp svneol=native#text/plain
+packages/googleapi/src/googleiam.pp svneol=native#text/plain
 packages/googleapi/src/googleidentitytoolkit.pp svneol=native#text/plain
+packages/googleapi/src/googlekgsearch.pp svneol=native#text/plain
 packages/googleapi/src/googlelicensing.pp svneol=native#text/plain
 packages/googleapi/src/googlelogging.pp svneol=native#text/plain
 packages/googleapi/src/googlemanager.pp svneol=native#text/plain
 packages/googleapi/src/googlemapsengine.pp svneol=native#text/plain
 packages/googleapi/src/googlemirror.pp svneol=native#text/plain
+packages/googleapi/src/googlemonitoring.pp svneol=native#text/plain
 packages/googleapi/src/googleoauth2.pp svneol=native#text/plain
 packages/googleapi/src/googlepagespeedonline.pp svneol=native#text/plain
+packages/googleapi/src/googlepartners.pp svneol=native#text/plain
+packages/googleapi/src/googlepeople.pp svneol=native#text/plain
+packages/googleapi/src/googleplaymoviespartner.pp svneol=native#text/plain
 packages/googleapi/src/googleplus.pp svneol=native#text/plain
-packages/googleapi/src/googleplusDomains.pp svneol=native#text/plain
+packages/googleapi/src/googleplusdomains.pp svneol=native#text/plain
 packages/googleapi/src/googleprediction.pp svneol=native#text/plain
+packages/googleapi/src/googleproximitybeacon.pp svneol=native#text/plain
 packages/googleapi/src/googlepubsub.pp svneol=native#text/plain
-packages/googleapi/src/googleqpxExpress.pp svneol=native#text/plain
+packages/googleapi/src/googleqpxexpress.pp svneol=native#text/plain
 packages/googleapi/src/googlereplicapool.pp svneol=native#text/plain
 packages/googleapi/src/googlereplicapoolupdater.pp svneol=native#text/plain
 packages/googleapi/src/googlereseller.pp svneol=native#text/plain
 packages/googleapi/src/googleresourceviews.pp svneol=native#text/plain
+packages/googleapi/src/googleruntimeconfig.pp svneol=native#text/plain
+packages/googleapi/src/googlesafebrowsing.pp svneol=native#text/plain
+packages/googleapi/src/googlescript.pp svneol=native#text/plain
 packages/googleapi/src/googleservice.pp svneol=native#text/plain
-packages/googleapi/src/googlesiteVerification.pp svneol=native#text/plain
+packages/googleapi/src/googleserviceregistry.pp svneol=native#text/plain
+packages/googleapi/src/googlesheets.pp svneol=native#text/plain
+packages/googleapi/src/googlesiteverification.pp svneol=native#text/plain
 packages/googleapi/src/googlespectrum.pp svneol=native#text/plain
 packages/googleapi/src/googlesqladmin.pp svneol=native#text/plain
 packages/googleapi/src/googlestorage.pp svneol=native#text/plain
+packages/googleapi/src/googlestoragetransfer.pp svneol=native#text/plain
 packages/googleapi/src/googletagmanager.pp svneol=native#text/plain
 packages/googleapi/src/googletaskqueue.pp svneol=native#text/plain
 packages/googleapi/src/googletasks.pp svneol=native#text/plain
+packages/googleapi/src/googletoolresults.pp svneol=native#text/plain
 packages/googleapi/src/googletranslate.pp svneol=native#text/plain
 packages/googleapi/src/googleurlshortener.pp svneol=native#text/plain
+packages/googleapi/src/googlevision.pp svneol=native#text/plain
 packages/googleapi/src/googlewebfonts.pp svneol=native#text/plain
 packages/googleapi/src/googlewebmasters.pp svneol=native#text/plain
 packages/googleapi/src/googleyoutube.pp svneol=native#text/plain
-packages/googleapi/src/googleyoutubeAnalytics.pp svneol=native#text/plain
+packages/googleapi/src/googleyoutubeanalytics.pp svneol=native#text/plain
+packages/googleapi/src/googleyoutubereporting.pp svneol=native#text/plain
 packages/graph/Makefile svneol=native#text/plain
 packages/graph/Makefile.fpc svneol=native#text/plain
 packages/graph/Makefile.fpc.fpcmake svneol=native#text/plain
@@ -6326,14 +6364,17 @@ packages/os4units/src/agraphics.pas svneol=native#text/pascal
 packages/os4units/src/amigados.pas svneol=native#text/pascal
 packages/os4units/src/asl.pas svneol=native#text/pascal
 packages/os4units/src/clipboard.pas svneol=native#text/pascal
+packages/os4units/src/cybergraphics.pas svneol=native#text/pascal
 packages/os4units/src/diskfont.pas svneol=native#text/pascal
 packages/os4units/src/exec.pas svneol=native#text/pascal
+packages/os4units/src/icon.pas svneol=native#text/pascal
 packages/os4units/src/iffparse.pas svneol=native#text/pascal
 packages/os4units/src/inputevent.pas svneol=native#text/pascal
 packages/os4units/src/intuition.pas svneol=native#text/pascal
 packages/os4units/src/keymap.pas svneol=native#text/pascal
 packages/os4units/src/layers.pas svneol=native#text/pascal
 packages/os4units/src/mui.pas svneol=native#text/pascal
+packages/os4units/src/picasso96api.pas svneol=native#text/pascal
 packages/os4units/src/timer.pas svneol=native#text/pascal
 packages/os4units/src/utility.pas svneol=native#text/pascal
 packages/os4units/src/workbench.pas svneol=native#text/pascal
@@ -7795,7 +7836,6 @@ packages/winunits-base/src/tmschema.inc svneol=native#text/plain
 packages/winunits-base/src/typelib.pas svneol=native#text/plain
 packages/winunits-base/src/urlmon.pp svneol=native#text/plain
 packages/winunits-base/src/uxtheme.pp svneol=native#text/plain
-packages/winunits-base/src/win9xwsmanager.pp svneol=native#text/pascal
 packages/winunits-base/src/wininet.pp svneol=native#text/plain
 packages/winunits-base/src/winspool.pp svneol=native#text/pascal
 packages/winunits-base/src/winutils.pp svneol=native#text/pascal
@@ -9227,6 +9267,7 @@ rtl/nativent/classes.pp svneol=native#text/pascal
 rtl/nativent/ddk.pas svneol=native#text/pascal
 rtl/nativent/ddk/ddkex.inc svneol=native#text/plain
 rtl/nativent/ddk/ddktypes.inc svneol=native#text/plain
+rtl/nativent/dos.pp svneol=native#text/plain
 rtl/nativent/ndk.pas svneol=native#text/pascal
 rtl/nativent/ndk/iofuncs.inc svneol=native#text/plain
 rtl/nativent/ndk/iotypes.inc svneol=native#text/plain
@@ -9473,6 +9514,8 @@ rtl/objpas/sysutils/sysint.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysinth.inc svneol=native#text/plain
 rtl/objpas/sysutils/syspch.inc svneol=native#text/plain
 rtl/objpas/sysutils/syspchh.inc svneol=native#text/plain
+rtl/objpas/sysutils/syssb.inc svneol=native#text/plain
+rtl/objpas/sysutils/syssbh.inc svneol=native#text/plain
 rtl/objpas/sysutils/syssr.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysstr.inc svneol=native#text/plain
 rtl/objpas/sysutils/sysstrh.inc svneol=native#text/plain
@@ -12252,6 +12295,7 @@ tests/test/tgeneric1.pp svneol=native#text/plain
 tests/test/tgeneric10.pp svneol=native#text/plain
 tests/test/tgeneric100.pp svneol=native#text/pascal
 tests/test/tgeneric101.pp svneol=native#text/pascal
+tests/test/tgeneric102.pp svneol=native#text/pascal
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
@@ -13001,6 +13045,7 @@ tests/test/uenum2b.pp svneol=native#text/plain
 tests/test/ugenconstraints.pas svneol=native#text/pascal
 tests/test/ugeneric.test75.pp svneol=native#text/pascal
 tests/test/ugeneric10.pp svneol=native#text/plain
+tests/test/ugeneric102.pp svneol=native#text/pascal
 tests/test/ugeneric14.pp svneol=native#text/plain
 tests/test/ugeneric3.pp svneol=native#text/plain
 tests/test/ugeneric4.pp svneol=native#text/plain
@@ -13277,6 +13322,8 @@ tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
 tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
 tests/test/units/variants/tw26370.pp svneol=native#text/plain
 tests/test/units/variants/tw27044.pp svneol=native#text/plain
+tests/test/units/windows/twinrawinput32.pp svneol=native#text/plain
+tests/test/units/windows/twinrawinput64.pp svneol=native#text/plain
 tests/test/uobjc24.pp svneol=native#text/plain
 tests/test/uobjc26.pp svneol=native#text/plain
 tests/test/uobjc27a.pp svneol=native#text/plain
@@ -15058,7 +15105,10 @@ tests/webtbs/tw3004.pp svneol=native#text/plain
 tests/webtbs/tw3005.pp svneol=native#text/plain
 tests/webtbs/tw30082.pp svneol=native#text/plain
 tests/webtbs/tw3010.pp svneol=native#text/plain
+tests/webtbs/tw30119a.pp svneol=native#text/pascal
+tests/webtbs/tw30119b.pp svneol=native#text/pascal
 tests/webtbs/tw3012.pp svneol=native#text/plain
+tests/webtbs/tw30166.pp svneol=native#text/plain
 tests/webtbs/tw3023.pp svneol=native#text/plain
 tests/webtbs/tw3028.pp svneol=native#text/plain
 tests/webtbs/tw3038.pp svneol=native#text/plain
@@ -16276,6 +16326,7 @@ utils/unicode/cldrhelper.pas svneol=native#text/pascal
 utils/unicode/cldrparser.lpi svneol=native#text/plain
 utils/unicode/cldrparser.lpr svneol=native#text/pascal
 utils/unicode/cldrtest.pas svneol=native#text/pascal
+utils/unicode/cldrtxt.pas svneol=native#text/plain
 utils/unicode/cldrxml.pas svneol=native#text/pascal
 utils/unicode/data/readme.txt svneol=native#text/plain
 utils/unicode/fpmake.pp svneol=native#text/plain

compiler/aasmtai.pas

@@ -230,6 +230,7 @@ interface
 {$ifdef m68k}
        { m68k only }
        ,top_regset
+       ,top_realconst
 {$endif m68k}
 {$ifdef jvm}
        { jvm only}
@@ -419,7 +420,8 @@ interface
             top_conditioncode : (cc : TAsmCond);
         {$endif defined(arm) or defined(aarch64)}
         {$ifdef m68k}
-            top_regset : (dataregset,addrregset,fpuregset:^tcpuregisterset);
+            top_regset : (dataregset,addrregset,fpuregset: tcpuregisterset);
+            top_realconst : (val_real:bestreal);
         {$endif m68k}
         {$ifdef jvm}
             top_single : (sval:single);
@@ -2686,14 +2688,6 @@ implementation
               top_regset:
                 dispose(regset);
 {$endif ARM}
-{$ifdef m68k}
-              top_regset:
-                begin
-                  dispose(dataregset);
-                  dispose(addrregset);
-                  dispose(fpuregset);
-                end;
-{$endif m68k}
 {$ifdef jvm}
               top_string:
                 freemem(pcval);

compiler/aoptbase.pas

@@ -101,6 +101,10 @@ unit aoptbase;
 
         { returns true if hp loads a value from reg }
         function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; Virtual;
+
+        { compares reg1 and reg2 having the same type and being the same super registers
+          so the register size is neglected }
+        function SuperRegistersEqual(reg1,reg2 : TRegister) : Boolean;
     end;
 
     function labelCanBeSkipped(p: tai_label): boolean;
@@ -305,6 +309,12 @@ unit aoptbase;
     end;
 
 
+  function TAOptBase.SuperRegistersEqual(reg1,reg2 : TRegister) : Boolean;
+  Begin
+    Result:=(getregtype(reg1) = getregtype(reg2)) and
+            (getsupreg(reg1) = getsupreg(Reg2));
+  end;
+
   { ******************* Processor dependent stuff *************************** }
 
   Function TAOptBase.RegMaxSize(Reg: TRegister): TRegister;

compiler/aoptobj.pas

@@ -346,7 +346,9 @@ Unit AoptObj;
 
         { processor dependent methods }
         // if it returns true, perform a "continue"
+        function PrePeepHoleOptsCpu(var p: tai): boolean; virtual;
         function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
+        function PeepHoleOptPass2Cpu(var p: tai): boolean; virtual;
         function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
       End;
 
@@ -1080,8 +1082,7 @@ Unit AoptObj;
              (StartPai.typ = ait_regAlloc) Then
             Begin
               if (tai_regalloc(StartPai).ratype=ra_alloc) and
-                (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and
-                (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then
+                SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
                begin
                  Result:=tai_regalloc(StartPai);
                  exit;
@@ -1178,7 +1179,7 @@ Unit AoptObj;
 
 {$push}
 {$r-}
-    function tAOptObj.getlabelwithsym(sym: tasmlabel): tai;
+    function TAOptObj.getlabelwithsym(sym: tasmlabel): tai;
       begin
         if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and
            (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then   { range check, a jump can go past an assembler block! }
@@ -1342,7 +1343,19 @@ Unit AoptObj;
 
 
     procedure TAOptObj.PrePeepHoleOpts;
+      var
+        p: tai;
       begin
+        p := BlockStart;
+        ClearUsedRegs;
+        while (p <> BlockEnd) Do
+          begin
+            UpdateUsedRegs(tai(p.next));
+            if PrePeepHoleOptsCpu(p) then
+              continue;
+            UpdateUsedRegs(p);
+            p:=tai(p.next);
+          end;
       end;
 
 
@@ -1400,10 +1413,10 @@ Unit AoptObj;
                                     no-line-info-start/end etc }
                                   if hp1.typ<>ait_marker then
                                     begin
-  {$if defined(SPARC) or defined(MIPS) }
+{$if defined(SPARC) or defined(MIPS) }
                                       if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then
                                         RemoveDelaySlot(hp1);
-  {$endif SPARC or MIPS }
+{$endif SPARC or MIPS }
                                       asml.remove(hp1);
                                       hp1.free;
                                       stoploop:=false;
@@ -1423,9 +1436,9 @@ Unit AoptObj;
                                 (p<>blockstart) then
                               begin
                                 tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs;
-  {$if defined(SPARC) or defined(MIPS)}
+{$if defined(SPARC) or defined(MIPS)}
                                 RemoveDelaySlot(p);
-  {$endif SPARC or MIPS}
+{$endif SPARC or MIPS}
                                 hp2:=tai(hp1.next);
                                 asml.remove(p);
                                 p.free;
@@ -1451,15 +1464,15 @@ Unit AoptObj;
                                   FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then
                                   begin
                                     if (taicpu(p).opcode=aopt_condjmp)
-  {$if defined(arm) or defined(aarch64)}
+{$if defined(arm) or defined(aarch64)}
                                       and (taicpu(p).condition<>C_None)
-  {$endif arm or aarch64}
-  {$if defined(aarch64)}
+{$endif arm or aarch64}
+{$if defined(aarch64)}
                                       { can't have conditional branches to
                                         global labels on AArch64, because the
                                         offset may become too big }
                                       and (tasmlabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).bind=AB_LOCAL)
-  {$endif aarch64}
+{$endif aarch64}
                                     then
                                       begin
                                         taicpu(p).condition:=inverse_cond(taicpu(p).condition);
@@ -1470,9 +1483,9 @@ Unit AoptObj;
 
                                          taicpu(p).oper[0]^.ref^.symbol.increfs;
                                         }
-  {$if defined(SPARC) or defined(MIPS)}
+{$if defined(SPARC) or defined(MIPS)}
                                         RemoveDelaySlot(hp1);
-  {$endif SPARC or MIPS}
+{$endif SPARC or MIPS}
                                         asml.remove(hp1);
                                         hp1.free;
                                         stoploop:=false;
@@ -1504,7 +1517,19 @@ Unit AoptObj;
 
 
     procedure TAOptObj.PeepHoleOptPass2;
+      var
+        p: tai;
       begin
+        p := BlockStart;
+        ClearUsedRegs;
+        while (p <> BlockEnd) Do
+          begin
+            UpdateUsedRegs(tai(p.next));
+            if PeepHoleOptPass2Cpu(p) then
+              continue;
+            UpdateUsedRegs(p);
+            p:=tai(p.next);
+          end;
       end;
 
 
@@ -1525,12 +1550,24 @@ Unit AoptObj;
       end;
 
 
+    function TAOptObj.PrePeepHoleOptsCpu(var p : tai) : boolean;
+      begin
+        result := false;
+      end;
+
+
     function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
       begin
         result := false;
       end;
 
 
+    function TAOptObj.PeepHoleOptPass2Cpu(var p : tai) : boolean;
+      begin
+        result := false;
+      end;
+
+
     function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
       begin
         result := false;

compiler/avr/aoptcpu.pas

@@ -800,7 +800,7 @@ Implementation
                       mov rX,...
                       mov rX,...
                     }
-                    else if taicpu(hp1).opcode=A_MOV then
+                    else if (hp1.typ=ait_instruction) and (taicpu(hp1).opcode=A_MOV) then
                       while (hp1.typ=ait_instruction) and (taicpu(hp1).opcode=A_MOV) and
                             MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^) and
                             { don't remove the first mov if the second is a mov rX,rX }

compiler/dbgdwarf.pas

@@ -1683,8 +1683,8 @@ implementation
 
     procedure TDebugInfoDwarf.appenddef_array(list:TAsmList;def:tarraydef);
       var
-        size : aint;
-        elesize : aint;
+        size : PInt;
+        elesize : PInt;
         elestrideattr : tdwarf_attribute;
         labsym: tasmlabel;
       begin
@@ -2461,14 +2461,14 @@ implementation
 { This is only a minimal change to at least be able to get a value
   in only one thread is present PM 2014-11-21, like for stabs format }
                         templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
-                        templist.concat(tai_const.Create_type_name(aitconst_ptr,sym.mangledname,
+                        templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,
                           offset+sizeof(pint)));
                         blocksize:=1+sizeof(puint);
                       end
                     else
                       begin
                         templist.concat(tai_const.create_8bit(ord(DW_OP_addr)));
-                        templist.concat(tai_const.Create_type_name(aitconst_ptr,sym.mangledname,offset));
+                        templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset));
                         blocksize:=1+sizeof(puint);
                       end;
                   end;
@@ -2929,7 +2929,7 @@ implementation
           toasm :
             begin
               templist.concat(tai_const.create_8bit(3));
-              templist.concat(tai_const.create_type_name(aitconst_ptr,sym.mangledname,0));
+              templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0));
               blocksize:=1+sizeof(puint);
             end;
           tovar:

compiler/fmodule.pas

@@ -195,6 +195,9 @@ interface
           non-generic typename and the data is a TFPObjectList of tgenericdummyentry
           instances whereby the last one is the current top most one }
         genericdummysyms: TFPHashObjectList;
+        { contains a list of specializations for which the method bodies need
+          to be generated }
+        pendingspecializations : TFPHashObjectList;
 
         { this contains a list of units that needs to be waited for until the
           unit can be finished (code generated, etc.); this is needed to handle
@@ -585,6 +588,7 @@ implementation
         checkforwarddefs:=TFPObjectList.Create(false);
         extendeddefs:=TFPHashObjectList.Create(true);
         genericdummysyms:=tfphashobjectlist.create(true);
+        pendingspecializations:=tfphashobjectlist.create(false);
         waitingforunit:=tfpobjectlist.create(false);
         waitingunits:=tfpobjectlist.create(false);
         globalsymtable:=nil;
@@ -677,6 +681,7 @@ implementation
         FImportLibraryList.Free;
         extendeddefs.Free;
         genericdummysyms.free;
+        pendingspecializations.free;
         waitingforunit.free;
         waitingunits.free;
         stringdispose(asmprefix);
@@ -774,6 +779,8 @@ implementation
         wpoinfo:=nil;
         checkforwarddefs.free;
         checkforwarddefs:=TFPObjectList.Create(false);
+        unitimportsyms.free;
+        unitimportsyms:=TFPObjectList.Create(false);
         derefdata.free;
         derefdata:=TDynamicArray.Create(1024);
         if assigned(unitmap) then
@@ -806,6 +813,8 @@ implementation
         dependent_units:=TLinkedList.Create;
         resourcefiles.Free;
         resourcefiles:=TCmdStrList.Create;
+        pendingspecializations.free;
+        pendingspecializations:=tfphashobjectlist.create(false);
         linkunitofiles.Free;
         linkunitofiles:=TLinkContainer.Create;
         linkunitstaticlibs.Free;
@@ -1049,10 +1058,6 @@ implementation
             macrosymtablestack.free;
             macrosymtablestack:=nil;
           end;
-        extendeddefs.free;
-        extendeddefs:=nil;
-        genericdummysyms.free;
-        genericdummysyms:=nil;
         waitingforunit.free;
         waitingforunit:=nil;
         localmacrosymtable.free;

compiler/hlcgobj.pas

@@ -598,15 +598,8 @@ unit hlcgobj;
          protected
           { helpers called by gen_initialize_code/gen_finalize_code }
           procedure inittempvariables(list:TAsmList);virtual;
-          procedure initialize_data(p:TObject;arg:pointer);virtual;
           procedure finalizetempvariables(list:TAsmList);virtual;
           procedure initialize_regvars(p:TObject;arg:pointer);virtual;
-          procedure finalize_sym(asmlist:TAsmList;sym:tsym);virtual;
-          { generates the code for finalisation of local variables }
-          procedure finalize_local_vars(p:TObject;arg:pointer);virtual;
-          { generates the code for finalization of static symtable and
-            all local (static) typed consts }
-          procedure finalize_static_data(p:TObject;arg:pointer);virtual;
           { generates the code for decrementing the reference count of parameters }
           procedure final_paras(p:TObject;arg:pointer);
          public
@@ -674,7 +667,7 @@ implementation
        fmodule,export,
        verbose,defutil,paramgr,
        symtable,
-       nbas,ncon,nld,ncgrtti,pass_1,pass_2,
+       nbas,ncon,nld,ncgrtti,pass_2,
        cpuinfo,cgobj,cutils,procinfo,
 {$ifdef x86}
        cgx86,
@@ -4515,26 +4508,12 @@ implementation
 
   procedure thlcgobj.gen_initialize_code(list: TAsmList);
     begin
-      { initialize local data like ansistrings }
+      { initialize register variables }
       case current_procinfo.procdef.proctypeoption of
          potype_unitinit:
-           begin
-              { this is also used for initialization of variables in a
-                program which does not have a globalsymtable }
-              if assigned(current_module.globalsymtable) then
-                TSymtable(current_module.globalsymtable).SymList.ForEachCall(@initialize_data,list);
-              TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_data,list);
-              TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
-           end;
-         { units have seperate code for initilization and finalization }
-         potype_unitfinalize: ;
-         { program init/final is generated in separate procedure }
+           TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
          potype_proginit:
-           begin
-             TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
-           end;
-         else
-           current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list);
+           TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list);
       end;
 
       { initialises temp. ansi/wide string data }
@@ -4565,24 +4544,6 @@ implementation
       { finalize temporary data }
       finalizetempvariables(list);
 
-      { finalize local data like ansistrings}
-      case current_procinfo.procdef.proctypeoption of
-         potype_unitfinalize:
-           begin
-              { this is also used for initialization of variables in a
-                program which does not have a globalsymtable }
-              if assigned(current_module.globalsymtable) then
-                TSymtable(current_module.globalsymtable).SymList.ForEachCall(@finalize_static_data,list);
-              TSymtable(current_module.localsymtable).SymList.ForEachCall(@finalize_static_data,list);
-           end;
-         { units/progs have separate code for initialization and finalization }
-         potype_unitinit: ;
-         { program init/final is generated in separate procedure }
-         potype_proginit: ;
-         else
-           current_procinfo.procdef.localst.SymList.ForEachCall(@finalize_local_vars,list);
-      end;
-
       { finalize paras data }
       if assigned(current_procinfo.procdef.parast) and
          not(po_assembler in current_procinfo.procdef.procoptions) then
@@ -4682,35 +4643,6 @@ implementation
        end;
     end;
 
-  procedure thlcgobj.initialize_data(p: TObject; arg: pointer);
-    var
-      OldAsmList : TAsmList;
-      hp : tnode;
-    begin
-      if (tsym(p).typ = localvarsym) and
-         { local (procedure or unit) variables only need initialization if
-           they are used }
-         ((tabstractvarsym(p).refs>0) or
-          { managed return symbols must be inited }
-          ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
-         ) and
-         not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
-         not(vo_is_external in tabstractvarsym(p).varoptions) and
-         not(vo_is_default_var in tabstractvarsym(p).varoptions) and
-         (is_managed_type(tabstractvarsym(p).vardef) or
-          ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
-         ) then
-        begin
-          OldAsmList:=current_asmdata.CurrAsmList;
-          current_asmdata.CurrAsmList:=TAsmList(arg);
-          hp:=cnodeutils.initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false);
-          firstpass(hp);
-          secondpass(hp);
-          hp.free;
-          current_asmdata.CurrAsmList:=OldAsmList;
-        end;
-    end;
-
   procedure thlcgobj.finalizetempvariables(list: TAsmList);
     var
       hp : ptemprecord;
@@ -4777,80 +4709,6 @@ implementation
        end;
     end;
 
-  procedure thlcgobj.finalize_sym(asmlist: TAsmList; sym: tsym);
-    var
-      hp : tnode;
-      OldAsmList : TAsmList;
-    begin
-      include(current_procinfo.flags,pi_needs_implicit_finally);
-      OldAsmList:=current_asmdata.CurrAsmList;
-      current_asmdata.CurrAsmList:=asmlist;
-      hp:=cloadnode.create(sym,sym.owner);
-      if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
-        include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
-      hp:=cnodeutils.finalize_data_node(hp);
-      firstpass(hp);
-      secondpass(hp);
-      hp.free;
-      current_asmdata.CurrAsmList:=OldAsmList;
-    end;
-
-  procedure thlcgobj.finalize_local_vars(p: TObject; arg: pointer);
-    begin
-      if (tsym(p).typ=localvarsym) and
-         (tlocalvarsym(p).refs>0) and
-         not(vo_is_external in tlocalvarsym(p).varoptions) and
-         not(vo_is_funcret in tlocalvarsym(p).varoptions) and
-         not(vo_is_default_var in tabstractvarsym(p).varoptions) and
-         is_managed_type(tlocalvarsym(p).vardef) then
-        finalize_sym(TAsmList(arg),tsym(p));
-    end;
-
-  procedure thlcgobj.finalize_static_data(p: TObject; arg: pointer);
-    var
-      i : longint;
-      pd : tprocdef;
-    begin
-      case tsym(p).typ of
-        staticvarsym :
-          begin
-                { local (procedure or unit) variables only need finalization
-                  if they are used
-                }
-            if ((tstaticvarsym(p).refs>0) or
-                { global (unit) variables always need finalization, since
-                  they may also be used in another unit
-                }
-                (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and
-                (
-                  (tstaticvarsym(p).varspez<>vs_const) or
-                  (vo_force_finalize in tstaticvarsym(p).varoptions)
-                ) and
-               not(vo_is_funcret in tstaticvarsym(p).varoptions) and
-               not(vo_is_external in tstaticvarsym(p).varoptions) and
-               is_managed_type(tstaticvarsym(p).vardef) and
-               not (
-                   assigned(tstaticvarsym(p).fieldvarsym) and
-                   assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
-                   (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
-                 )
-               then
-              finalize_sym(TAsmList(arg),tsym(p));
-          end;
-        procsym :
-          begin
-            for i:=0 to tprocsym(p).ProcdefList.Count-1 do
-              begin
-                pd:=tprocdef(tprocsym(p).ProcdefList[i]);
-                if assigned(pd.localst) and
-                   (pd.procsym=tprocsym(p)) and
-                   (pd.localst.symtabletype<>staticsymtable) then
-                  pd.localst.SymList.ForEachCall(@finalize_static_data,arg);
-              end;
-          end;
-      end;
-    end;
-
   procedure thlcgobj.final_paras(p: TObject; arg: pointer);
     var
       list : TAsmList;
@@ -4979,6 +4837,7 @@ implementation
                            else
                              highloc.loc:=LOC_INVALID;
                            eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
+                           g_ptrtypecast_ref(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(eldef),href);
                            g_array_rtti_helper(list,eldef,href,highloc,'fpc_initialize_array');
                          end
                        else

compiler/i8086/cgcpu.pas

@@ -1809,6 +1809,13 @@ unit cgcpu;
 
     procedure tcg8086.g_stackpointer_alloc(list : TAsmList;localsize: longint);
       begin
+        if cs_check_stack in current_settings.localswitches then
+          begin
+            cg.getcpuregister(list,NR_AX);
+            cg.a_load_const_reg(list,OS_16, localsize,NR_AX);
+            cg.a_call_name(list,'FPC_STACKCHECK_I8086',false);
+            cg.ungetcpuregister(list, NR_AX);
+          end;
         if localsize>0 then
           list.concat(Taicpu.Op_const_reg(A_SUB,S_W,localsize,NR_STACK_POINTER_REG));
       end;

compiler/llvm/aasmllvm.pas

@@ -142,11 +142,10 @@ interface
       );
 
     taillvmalias = class(tailineinfo)
-      vis: tllvmvisibility;
-      linkage: tllvmlinkage;
+      bind: tasmsymbind;
       oldsym, newsym: TAsmSymbol;
       def: tdef;
-      constructor create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _vis: tllvmvisibility; _linkage: tllvmlinkage);
+      constructor create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _bind: tasmsymbind);
     end;
 
     taillvmdeclflag =
@@ -244,7 +243,7 @@ uses
 
     { taillvmalias }
 
-    constructor taillvmalias.create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _vis: tllvmvisibility; _linkage: tllvmlinkage);
+    constructor taillvmalias.create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _bind: tasmsymbind);
       begin
         inherited Create;
         typ:=ait_llvmalias;
@@ -252,8 +251,7 @@ uses
         newsym:=current_asmdata.DefineAsmSymbol(newname,AB_GLOBAL,AT_FUNCTION);
         newsym.declared:=true;
         def:=_def;
-        vis:=_vis;
-        linkage:=_linkage;
+        bind:=_bind;
       end;
 
 
@@ -584,7 +582,7 @@ uses
           la_icmp, la_fcmp:
             begin
               case opnr of
-                0: result:=pasbool8type;
+                0: result:=llvmbool1type;
                 3,4: result:=oper[2]^.def;
                 else
                   internalerror(2013110801);

compiler/llvm/agllvm.pas

@@ -731,13 +731,15 @@ implementation
       procedure WriteLinkageVibilityFlags(bind: TAsmSymBind);
         begin
           case bind of
-             AB_EXTERNAL:
+             AB_EXTERNAL,
+             AB_EXTERNAL_INDIRECT:
                writer.AsmWrite(' external');
              AB_COMMON:
                writer.AsmWrite(' common');
              AB_LOCAL:
                writer.AsmWrite(' internal');
-             AB_GLOBAL:
+             AB_GLOBAL,
+             AB_INDIRECT:
                writer.AsmWrite('');
              AB_WEAK_EXTERNAL:
                writer.AsmWrite(' extern_weak');
@@ -1047,18 +1049,7 @@ implementation
             begin
               writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym));
               writer.AsmWrite(' = alias ');
-              if taillvmalias(hp).linkage<>lll_default then
-                begin
-                  str(taillvmalias(hp).linkage, s);
-                  writer.AsmWrite(copy(s, length('lll_')+1, 255));
-                  writer.AsmWrite(' ');
-                end;
-              if taillvmalias(hp).vis<>llv_default then
-                begin
-                  str(taillvmalias(hp).vis, s);
-                  writer.AsmWrite(copy(s, length('llv_')+1, 255));
-                  writer.AsmWrite(' ');
-                end;
+              WriteLinkageVibilityFlags(taillvmalias(hp).bind);
               if taillvmalias(hp).def.typ=procdef then
                 writer.AsmWrite(llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias))
               else

compiler/llvm/hlcgllvm.pas

@@ -934,7 +934,7 @@ implementation
       tmpsrc1:=getintregister(list,calcsize);
       a_load_reg_reg(list,size,calcsize,dst,tmpsrc1);
       location_reset(ovloc,LOC_REGISTER,OS_8);
-      ovloc.register:=getintregister(list,pasbool8type);
+      ovloc.register:=getintregister(list,llvmbool1type);
       list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,ovloc.register,OC_NE,calcsize,tmpsrc1,tmpdst));
     end;
 
@@ -950,6 +950,9 @@ implementation
       if (size=pasbool8type) and
          (cmp_op in [OC_EQ,OC_NE]) then
         begin
+          { convert to an llvmbool1type and use directly }
+          tmpreg:=getintregister(list,llvmbool1type);
+          a_load_reg_reg(list,size,llvmbool1type,reg,tmpreg);
           case cmp_op of
             OC_EQ:
               invert:=a=0;
@@ -967,7 +970,7 @@ implementation
               l:=falselab;
               falselab:=tmplab;
             end;
-          list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab));
+          list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,tmpreg,l,falselab));
           a_label(list,fallthroughlab);
           exit;
         end;
@@ -984,13 +987,13 @@ implementation
     begin
       if getregtype(reg1)<>getregtype(reg2) then
         internalerror(2012111105);
-      resreg:=getintregister(list,pasbool8type);
+      resreg:=getintregister(list,llvmbool1type);
       current_asmdata.getjumplabel(falselab);
       { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that
         e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM,
         OC_GT is true if op1>op2 }
       list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1));
-      list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab));
+      list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,resreg,l,falselab));
       a_label(list,falselab);
     end;
 
@@ -1037,7 +1040,7 @@ implementation
       a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
       { we don't know anything about volatility here, should become an extra
         parameter to g_concatcopy }
-      a_load_const_cgpara(list,pasbool8type,0,volatilepara);
+      a_load_const_cgpara(list,llvmbool1type,0,volatilepara);
       g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
       sourcepara.done;
       destpara.done;
@@ -1171,7 +1174,7 @@ implementation
       while assigned(item) do
         begin
           if mangledname<>item.Str then
-            list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,llv_default,lll_default));
+            list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,asmsym.bind));
           item:=TCmdStrListItem(item.next);
         end;
       list.concat(taillvmdecl.createdef(asmsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment));
@@ -1292,7 +1295,7 @@ implementation
       if ovloc.size<>OS_8 then
         internalerror(2015122504);
       current_asmdata.getjumplabel(hl);
-      a_cmp_const_loc_label(list,pasbool8type,OC_EQ,0,ovloc,hl);
+      a_cmp_const_loc_label(list,llvmbool1type,OC_EQ,0,ovloc,hl);
       g_call_system_proc(list,'fpc_overflow',[],nil);
       a_label(list,hl);
     end;
@@ -1901,7 +1904,7 @@ implementation
       if po_external in procdef.procoptions then
         exit;
       asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION);
-      list.concat(taillvmalias.create(asmsym,procdef.mangledname,procdef,llv_default,lll_default));
+      list.concat(taillvmalias.create(asmsym,procdef.mangledname,procdef,asmsym.bind));
     end;
 
 

compiler/llvm/llvmdef.pas

@@ -211,17 +211,23 @@ implementation
                   end;
               end;
             end
-          else if is_pasbool(fromsize) and
-                  not is_pasbool(tosize) then
+          else if (fromsize=llvmbool1type) and
+                  (tosize<>llvmbool1type) then
             begin
               if is_cbool(tosize) then
                 result:=la_sext
               else
                 result:=la_zext
             end
-          else if is_pasbool(tosize) and
-                  not is_pasbool(fromsize) then
-            result:=la_trunc
+          else if (tosize=llvmbool1type) and
+                  (fromsize<>llvmbool1type) then
+            begin
+              { would have to compare with 0, can't just take the lowest bit }
+              if is_cbool(fromsize) then
+                internalerror(2016052001)
+              else
+                result:=la_trunc
+            end
           else
             result:=la_bitcast;
         end;
@@ -308,10 +314,10 @@ implementation
               if is_void(def) then
                 encodedstr:=encodedstr+'void'
               { mainly required because comparison operations return i1, and
-                otherwise we always have to immediatel extend them to i8 for
-                no good reason; besides, Pascal booleans can only contain 0
-                or 1 in valid code anyway (famous last words...) }
-              else if torddef(def).ordtype=pasbool8 then
+                we need a way to represent the i1 type in Pascal. We don't
+                reuse pasbool8type, because putting an i1 in a record or
+                passing it as a parameter may result in unexpected behaviour }
+              else if def=llvmbool1type then
                 encodedstr:=encodedstr+'i1'
               else
                 encodedstr:=encodedstr+'i'+tostr(def.size*8);

compiler/llvm/nllvmadd.pas

@@ -109,7 +109,7 @@ implementation
       pass_left_right;
 
       location_reset(location,LOC_REGISTER,OS_8);
-      location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type);
+      location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type);
 
       force_reg_left_right(false,false);
 
@@ -143,11 +143,15 @@ implementation
         else
           internalerror(2012042701);
       end;
+      tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+      hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,llvmbool1type,resultdef,location.register,tmpreg);
+      location.register:=tmpreg;
     end;
 
 
   procedure tllvmaddnode.second_cmpordinal;
     var
+      tmpreg: tregister;
       cmpop: topcmp;
       unsigned : boolean;
     begin
@@ -189,7 +193,7 @@ implementation
         cmpop:=swap_opcmp(cmpop);
 
       location_reset(location,LOC_REGISTER,OS_8);
-      location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+      location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type);
 
       if right.location.loc=LOC_CONSTANT then
         current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,
@@ -197,6 +201,10 @@ implementation
       else
         current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,
           location.register,cmpop,left.resultdef,left.location.register,right.location.register));
+
+      tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+      hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,llvmbool1type,resultdef,location.register,tmpreg);
+      location.register:=tmpreg;
     end;
 
 
@@ -214,6 +222,7 @@ implementation
 
   procedure tllvmaddnode.second_addfloat;
     var
+      tmpreg: tregister;
       op    : tllvmop;
       llvmfpcmp : tllvmfpcmp;
       size : tdef;
@@ -279,7 +288,7 @@ implementation
       else
         begin
           location_reset(location,LOC_REGISTER,OS_8);
-          location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+          location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type);
         end;
 
       { see comment in thlcgllvm.a_loadfpu_ref_reg }
@@ -297,7 +306,10 @@ implementation
       else
         begin
           current_asmdata.CurrAsmList.concat(taillvm.op_reg_fpcond_size_reg_reg(op,
-            location.register,llvmfpcmp,size,left.location.register,right.location.register))
+            location.register,llvmfpcmp,size,left.location.register,right.location.register));
+          tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+          hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,llvmbool1type,resultdef,location.register,tmpreg);
+          location.register:=tmpreg;
         end;
     end;
 

compiler/llvm/nllvmcnv.pas

@@ -50,7 +50,7 @@ interface
          { procedure second_cord_to_pointer;override; }
          procedure second_proc_to_procvar;override;
          procedure second_nil_to_methodprocvar; override;
-         procedure second_bool_to_int;override;
+         { procedure second_bool_to_int;override; }
          procedure second_int_to_bool;override;
          { procedure second_load_smallset;override;  }
          { procedure second_ansistring_to_pchar;override; }
@@ -202,39 +202,6 @@ procedure tllvmtypeconvnode.second_nil_to_methodprocvar;
   end;
 
 
-procedure tllvmtypeconvnode.second_bool_to_int;
-  var
-    pdef: tdef;
-    hreg: tregister;
-  begin
-    inherited;
-    { all boolean/integer of the same size are represented using the same type
-      by FPC in LLVM, except for Pascal booleans, which are i1 -> convert
-      the type if necessary. This never has to be done for registers on the
-      assignment side, because we make everything that's explicitly typecasted
-      on the assignment side non regable for llvm }
-    if is_pasbool(left.resultdef) and
-       (nf_explicit in flags) and
-       not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
-       (resultdef.size=1) then
-      case location.loc of
-        LOC_REFERENCE,LOC_CREFERENCE:
-          begin
-            pdef:=cpointerdef.getreusable(resultdef);
-            hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,pdef);
-            hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,pdef,location.reference,hreg);
-            hlcg.reference_reset_base(location.reference,pdef,hreg,0,location.reference.alignment);
-          end;
-        LOC_REGISTER,LOC_CREGISTER:
-          begin
-            hreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
-            hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,location.register,hreg);
-            location.register:=hreg;
-          end;
-      end;
-  end;
-
-
 procedure tllvmtypeconvnode.second_int_to_bool;
   var
     truelabel,

compiler/llvm/nllvmmat.pas

@@ -96,16 +96,16 @@ procedure tllvmmoddivnode.pass_generate_code;
       begin
         current_asmdata.getjumplabel(hl);
         location_reset(ovloc,LOC_REGISTER,OS_8);
-        ovloc.register:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type);
+        ovloc.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type);
         if right.nodetype=ordconstn then
           current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,ovloc.register,OC_EQ,resultdef,left.location.register,low(int64)))
         else
           begin
-            tmpovreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type);
-            tmpovreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type);
+            tmpovreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type);
+            tmpovreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type);
             current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,tmpovreg1,OC_EQ,resultdef,left.location.register,low(int64)));
             current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,tmpovreg2,OC_EQ,resultdef,right.location.register,-1));
-            hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,pasbool8type,tmpovreg1,tmpovreg2,ovloc.register);
+            hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,llvmbool1type,tmpovreg1,tmpovreg2,ovloc.register);
           end;
         hlcg.g_overflowCheck_loc(current_asmdata.CurrAsmList,location,resultdef,ovloc);
       end;

compiler/llvm/nllvmutil.pas

@@ -45,13 +45,16 @@ implementation
     uses
       verbose,cutils,globals,fmodule,systems,
       aasmbase,aasmtai,cpubase,llvmbase,aasmllvm,
+      aasmcnst,
       symbase,symtable,defutil,
       llvmtype;
 
   class procedure tllvmnodeutils.insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint);
     var
-      asmsym: tasmsymbol;
+      asmsym,
+      symind: tasmsymbol;
       field1, field2: tsym;
+      tcb: ttai_typedconstbuilder;
     begin
       if sym.globalasmsym then
         asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_GLOBAL,AT_DATA)
@@ -65,6 +68,15 @@ implementation
         list.concat(taillvmdecl.createdef(asmsym,
           get_threadvar_record(sym.vardef,field1,field2),
           nil,sec_data,varalign));
+      symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA);
+      tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]);
+      tcb.emit_tai(Tai_const.Create_sym_offset(asmsym,0),cpointerdef.getreusable(sym.vardef));
+      list.concatlist(tcb.get_final_asmlist(
+        symind,cpointerdef.getreusable(sym.vardef),
+        sec_rodata,
+        lower(sym.mangledname),
+        const_align(sym.vardef.alignment)));
+      tcb.free;
     end;
 
 

compiler/m68k/aasmcpu.pas

@@ -42,6 +42,7 @@ type
      opsize : topsize;
 
      procedure loadregset(opidx:longint; const dataregs,addrregs,fpuregs:tcpuregisterset);
+     procedure loadrealconst(opidx:longint; const value_real: bestreal);
 
      constructor op_none(op : tasmop);
      constructor op_none(op : tasmop;_size : topsize);
@@ -57,6 +58,7 @@ type
      constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
      constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint);
      constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference);
+     constructor op_realconst_reg(op : tasmop;_size : topsize;_op1: bestreal;_op2: tregister);
 
      constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister);
      { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
@@ -125,31 +127,40 @@ type
          begin
            if typ<>top_regset then
              clearop(opidx);
-           new(dataregset);
-           new(addrregset);
-           new(fpuregset);
-           dataregset^:=dataregs;
-           addrregset^:=addrregs;
-           fpuregset^:=fpuregs;
+           dataregset:=dataregs;
+           addrregset:=addrregs;
+           fpuregset:=fpuregs;
            typ:=top_regset;
            for i:=RS_D0 to RS_D7 do
              begin
-               if assigned(add_reg_instruction_hook) and (i in dataregset^) then
+               if assigned(add_reg_instruction_hook) and (i in dataregset) then
                  add_reg_instruction_hook(self,newreg(R_INTREGISTER,i,R_SUBWHOLE));
              end;
            for i:=RS_A0 to RS_SP do
              begin
-               if assigned(add_reg_instruction_hook) and (i in addrregset^) then
+               if assigned(add_reg_instruction_hook) and (i in addrregset) then
                  add_reg_instruction_hook(self,newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE));
              end;
            for i:=RS_FP0 to RS_FP7 do
              begin
-               if assigned(add_reg_instruction_hook) and (i in fpuregset^) then
+               if assigned(add_reg_instruction_hook) and (i in fpuregset) then
                  add_reg_instruction_hook(self,newreg(R_FPUREGISTER,i,R_SUBWHOLE));
              end;
          end;
       end;
 
+    procedure taicpu.loadrealconst(opidx:longint; const value_real: bestreal);
+      begin
+        allocate_oper(opidx+1);
+        with oper[opidx]^ do
+          begin
+            if typ<>top_realconst then
+              clearop(opidx);
+            val_real:=value_real;
+            typ:=top_realconst;
+          end;
+      end;
+
 
     procedure taicpu.init(_size : topsize);
       begin
@@ -260,6 +271,14 @@ type
          loadref(1,_op2);
       end;
 
+    constructor taicpu.op_realconst_reg(op : tasmop;_size : topsize;_op1 : bestreal;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadrealconst(0,_op1);
+         loadreg(1,_op2);
+      end;
 
     constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister);
       begin
@@ -479,7 +498,7 @@ type
           A_ADD, A_ADDQ, A_ADDX, A_SUB, A_SUBQ, A_SUBX,
           A_AND, A_LSR, A_LSL, A_ASR, A_ASL, A_EOR, A_EORI, A_OR,
           A_ROL, A_ROR, A_ROXL, A_ROXR,
-          A_MULS, A_MULU, A_DIVS, A_DIVU, A_DIVSL, A_DIVUL,
+          A_MULS, A_MULU, A_DIVS, A_DIVU, A_DIVSL, A_DIVUL, A_REMS, A_REMU,
           A_BSET, A_BCLR:
             if opnr=1 then
               result:=operand_readwrite;

compiler/m68k/ag68kgas.pas

@@ -163,23 +163,30 @@ interface
               getopstr:='';
               for i:=RS_D0 to RS_D7 do
                 begin
-                  if i in o.dataregset^ then
+                  if i in o.dataregset then
                    getopstr:=getopstr+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/';
                 end;
               for i:=RS_A0 to RS_SP do
                 begin
-                  if i in o.addrregset^ then
+                  if i in o.addrregset then
                    getopstr:=getopstr+gas_regname(newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE))+'/';
                 end;
               for i:=RS_FP0 to RS_FP7 do
                 begin
-                  if i in o.fpuregset^ then
+                  if i in o.fpuregset then
                    getopstr:=getopstr+gas_regname(newreg(R_FPUREGISTER,i,R_SUBNONE))+'/';
                 end;
               delete(getopstr,length(getopstr),1);
             end;
           top_const:
             getopstr:='#'+tostr(longint(o.val));
+          top_realconst:
+            begin
+              str(o.val_real,getopstr);
+              if getopstr[1]=' ' then
+                getopstr[1]:='+';
+              getopstr:='#0d'+getopstr;
+            end;
           else internalerror(200405021);
         end;
       end;
@@ -288,7 +295,7 @@ interface
                         sep:=#9
                       else
                       if (i=2) and
-                         (op in [A_DIVSL,A_DIVUL,A_MULS,A_MULU,A_DIVS,A_DIVU]) then
+                         (op in [A_DIVSL,A_DIVUL,A_MULS,A_MULU,A_DIVS,A_DIVU,A_REMS,A_REMU]) then
                         sep:=':'
                       else
                         sep:=',';

compiler/m68k/ag68kvasm.pas

@@ -0,0 +1,115 @@
+{
+    Copyright (c) 2016 by the Free Pascal development team
+
+    This unit is the VASM assembler writer for 68k
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit ag68kvasm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       aasmbase,systems,
+       aasmtai,aasmdata,
+       aggas,ag68kgas,
+       cpubase,cgutils,
+       globtype;
+
+  type
+    tm68kvasm = class(Tm68kGNUassembler)
+      constructor create(info: pasminfo; smart: boolean); override;
+      function MakeCmdLine: TCmdStr; override;
+    end;
+
+  implementation
+
+    uses
+       cutils,cfileutl,globals,verbose,
+       cgbase,
+       assemble,script,
+       itcpugas,cpuinfo,
+       aasmcpu;
+
+
+{****************************************************************************}
+{                         VASM m68k Assembler writer                         }
+{****************************************************************************}
+
+
+    constructor tm68kvasm.create(info: pasminfo; smart: boolean);
+      begin
+        inherited;
+        InstrWriter := Tm68kInstrWriter.create(self);
+      end;
+
+    function tm68kvasm.MakeCmdLine: TCmdStr;
+      var
+        objtype: string;
+      begin
+        result:=asminfo^.asmcmd;
+
+        case target_info.system of
+          system_m68k_amiga: objtype:='-Fhunk';
+          system_m68k_atari: objtype:='-Fvobj'; // fix me?
+          system_m68k_linux: objtype:='-Felf';
+        else
+          internalerror(2016052601);
+        end;
+
+        if (target_info.system = system_m68k_amiga) then 
+          begin
+            Replace(result,'$ASM',maybequoted(ScriptFixFileName(Unix2AmigaPath(AsmFileName))));
+            Replace(result,'$OBJ',maybequoted(ScriptFixFileName(Unix2AmigaPath(ObjFileName))));
+          end
+        else
+          begin
+            Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
+            Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
+          end;
+        Replace(result,'$ARCH','-m'+GasCpuTypeStr[current_settings.cputype]);
+        Replace(result,'$OTYPE',objtype);
+        Replace(result,'$EXTRAOPT',asmextraopt);
+      end;
+
+
+
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+  const
+    as_m68k_vasm_info : tasminfo =
+       (
+         id     : as_m68k_vasm;
+
+         idtxt  : 'VASM';
+         asmbin : 'vasmm68k_std';
+         asmcmd:  '-quiet -elfregs -gas $OTYPE $ARCH -o $OBJ $EXTRAOPT $ASM';
+         supported_targets : [system_m68k_amiga,system_m68k_atari,system_m68k_linux];
+         flags : [af_needar,af_smartlink_sections];
+         labelprefix : '.L';
+         comment : '# ';
+         dollarsign: '$';
+       );
+
+begin
+  RegisterAssembler(as_m68k_vasm_info,tm68kvasm);
+end.

compiler/m68k/aoptcpu.pas

@@ -60,6 +60,7 @@ unit aoptcpu;
     var
       next: tai;
       tmpref: treference;
+      tmpsingle: single;
     begin
       result:=false;
       case p.typ of
@@ -135,6 +136,43 @@ unit aoptcpu;
                     taicpu(p).ops:=1;
                     result:=true;
                   end;
+              A_FCMP:
+                if (taicpu(p).oper[0]^.typ = top_realconst) then
+                  begin
+                    if (taicpu(p).oper[0]^.val_real = 0.0) then
+                      begin 
+                        DebugMsg('Optimizer: FCMP #0.0 to FTST',p);
+                        taicpu(p).opcode:=A_FTST;
+                        taicpu(p).opsize:=S_FX;
+                        taicpu(p).loadoper(0,taicpu(p).oper[1]^);
+                        taicpu(p).clearop(1);
+                        taicpu(p).ops:=1;
+                        result:=true;
+                      end
+                    else
+                      begin
+                        tmpsingle:=taicpu(p).oper[0]^.val_real;
+                        if (taicpu(p).opsize = S_FD) and
+                           ((taicpu(p).oper[0]^.val_real - tmpsingle) = 0.0) then
+                          begin
+                            DebugMsg('Optimizer: FCMP const to lesser precision',p);
+                            taicpu(p).opsize:=S_FS;
+                            result:=true;
+                          end;
+                      end;
+                  end;
+              A_FMOVE,A_FMUL,A_FADD,A_FSUB,A_FDIV:
+                  if (taicpu(p).oper[0]^.typ = top_realconst) then
+                    begin
+                      tmpsingle:=taicpu(p).oper[0]^.val_real;
+                      if (taicpu(p).opsize = S_FD) and
+                         ((taicpu(p).oper[0]^.val_real - tmpsingle) = 0.0) then
+                        begin
+                          DebugMsg('Optimizer: FMOVE/FMUL/FADD/FSUB/FDIV const to lesser precision',p);
+                          taicpu(p).opsize:=S_FS;
+                          result:=true;
+                        end;
+                    end;
             end;
           end;
       end;

compiler/m68k/cgcpu.pas

@@ -50,8 +50,10 @@ unit cgcpu;
         procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override;
 
         procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
+        procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
         procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
         procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
+        procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
         procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override;
 
         procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override;
@@ -65,6 +67,7 @@ unit cgcpu;
         procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
         procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
         procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); override;
+        procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
 
         procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override;
         procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); override;
@@ -108,6 +111,8 @@ unit cgcpu;
        procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
        procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
        procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
+       procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); override;
+       procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); override;
      end;
 
      { This function returns true if the reference+offset is valid.
@@ -359,14 +364,7 @@ unit cgcpu;
           reference_reset_base(ref, NR_STACK_POINTER_REG, 0, tcgsize2size[pushsize]);
           ref.direction := dir_dec;
 
-          if tcgsize2size[paraloc^.size]<cgpara.alignment then
-            begin
-              tmpreg:=getintregister(list,pushsize);
-              a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg);
-              list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],tmpreg,ref));
-            end
-          else
-              list.concat(taicpu.op_ref_ref(A_MOVE,tcgsize2opsize[pushsize],href,ref));
+          a_load_ref_ref(list,int_cgsize(tcgsize2size[paraloc^.size]),pushsize,href,ref);
         end;
 
       var
@@ -391,7 +389,7 @@ unit cgcpu;
                 if tcgsize2size[cgpara.size]<>tcgsize2size[size] then
                   internalerror(200501161);
                 { We need to push the data in reverse order,
-                  therefor we use a recursive algorithm }
+                  therefore we use a recursive algorithm }
                 pushdata(cgpara.location,0);
               end
           end
@@ -708,6 +706,12 @@ unit cgcpu;
         hreg : tregister;
         href : treference;
       begin
+        if needs_unaligned(ref.alignment,tosize) then
+          begin
+            inherited;
+            exit;
+          end;
+
         a:=longint(a);
         href:=ref;
         fixref(list,href,false);
@@ -752,6 +756,13 @@ unit cgcpu;
         href : treference;
         hreg : tregister;
       begin
+        if needs_unaligned(ref.alignment,tosize) then
+          begin
+            //list.concat(tai_comment.create(strpnew('a_load_reg_ref calling unaligned')));
+            a_load_reg_ref_unaligned(list,fromsize,tosize,register,ref);
+            exit;
+          end;
+
         href := ref;
         hreg := register;
         fixref(list,href,false);
@@ -765,6 +776,55 @@ unit cgcpu;
       end;
 
 
+    procedure tcg68k.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
+      var
+        tmpref : treference;
+        tmpreg,
+        tmpreg2 : tregister;
+      begin
+        if not needs_unaligned(ref.alignment,tosize) then
+          begin
+            a_load_reg_ref(list,fromsize,tosize,register,ref);
+            exit;
+          end;
+
+        list.concat(tai_comment.create(strpnew('a_load_reg_ref_unaligned: generating unaligned store')));
+
+        tmpreg2:=getaddressregister(list);
+        tmpref:=ref;
+        inc(tmpref.offset,tcgsize2size[tosize]);
+        a_loadaddr_ref_reg(list,ref,tmpreg2);
+        reference_reset_base(tmpref,tmpreg2,0,1);
+        tmpref.direction:=dir_none;
+
+        tmpreg:=getintregister(list,tosize);
+        a_load_reg_reg(list,fromsize,tosize,register,tmpreg);
+
+        case tosize of
+          OS_16,OS_S16:
+            begin
+              list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
+              list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
+              tmpref.direction:=dir_dec;
+              list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
+            end;
+          OS_32,OS_S32:
+            begin
+              list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
+              tmpref.direction:=dir_dec;
+              list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
+              list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
+              list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
+              list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
+              list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg));
+              list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref));
+            end
+          else
+            internalerror(2016052201);
+        end;
+      end;
+
+
     procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
       var
         aref: treference;
@@ -773,24 +833,38 @@ unit cgcpu;
         hreg: TRegister;
       begin
         usetemp:=TCGSize2OpSize[fromsize]<>TCGSize2OpSize[tosize];
+        usetemp:=usetemp or (needs_unaligned(sref.alignment,fromsize) or needs_unaligned(dref.alignment,tosize));
 
         aref := sref;
         bref := dref;
-        fixref(list,aref,false);
 
         if usetemp then
           begin
-            { if we will use a temp register, we don't need to fully resolve 
-              the dest ref, not even on coldfire }
-            fixref(list,bref,false); 
             { if we need to change the size then always use a temporary register }
             hreg:=getintregister(list,fromsize);
-            list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg));
-            sign_extend(list,fromsize,tosize,hreg);
-            list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref));
+
+            if needs_unaligned(sref.alignment,fromsize) then
+              a_load_ref_reg_unaligned(list,fromsize,tosize,sref,hreg)
+            else
+              begin
+                fixref(list,aref,false);
+                list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg));
+                sign_extend(list,fromsize,tosize,hreg);
+              end;
+
+            if needs_unaligned(dref.alignment,tosize) then
+              a_load_reg_ref_unaligned(list,tosize,tosize,hreg,dref)
+            else
+              begin
+                { if we use a temp register, we don't need to fully resolve 
+                  the dest ref, not even on coldfire }
+                fixref(list,bref,false);
+                list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref));
+              end;
           end
         else
           begin
+            fixref(list,aref,false);
             fixref(list,bref,current_settings.cputype in cpu_coldfire);
             list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref));
           end;
@@ -822,7 +896,7 @@ unit cgcpu;
                 add_move_instruction(instr);
                 list.concat(instr);
               end;
-            sign_extend(list,fromsize,reg2);
+            sign_extend(list,fromsize,tosize,reg2);
           end;
       end;
 
@@ -833,27 +907,98 @@ unit cgcpu;
        hreg : tregister;
        size : tcgsize;
        opsize: topsize;
+       needsext: boolean;
       begin
+         if needs_unaligned(ref.alignment,fromsize) then
+           begin
+             //list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned')));
+             a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register);
+             exit;
+           end;
+
          href:=ref;
          fixref(list,href,false);
-         if tcgsize2size[fromsize]<tcgsize2size[tosize] then
+
+         needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize];
+         if needsext then
            size:=fromsize
          else
            size:=tosize;
          opsize:=TCGSize2OpSize[size];
          if isaddressregister(register) and not (opsize in [S_L]) then
+           hreg:=getintregister(list,OS_ADDR)
+         else
+           hreg:=register;
+
+         if needsext and (CPUM68K_HAS_MVSMVZ in cpu_capabilities[current_settings.cputype]) and not (opsize in [S_L]) then
            begin
-             hreg:=getintregister(list,OS_ADDR);
-             list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg));
-             sign_extend(list,size,hreg);
-             a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register);
+             if fromsize in [OS_S8,OS_S16] then
+               list.concat(taicpu.op_ref_reg(A_MVS,opsize,href,hreg))
+             else if fromsize in [OS_8,OS_16] then
+               list.concat(taicpu.op_ref_reg(A_MVZ,opsize,href,hreg))
+             else
+               internalerror(2016050502);
            end
-         else 
+         else
            begin
-             list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,register));
-             { extend the value in the register }
-             sign_extend(list, size, register);
+             list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg));
+             sign_extend(list,size,hreg);
            end;
+
+         if hreg<>register then
+           a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register);
+      end;
+
+
+    procedure tcg68k.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
+      var
+        tmpref : treference;
+        tmpreg,
+        tmpreg2 : tregister;
+      begin
+        if not needs_unaligned(ref.alignment,fromsize) then
+          begin
+            a_load_ref_reg(list,fromsize,tosize,ref,register);
+            exit;
+          end;
+
+        list.concat(tai_comment.create(strpnew('a_load_ref_reg_unaligned: generating unaligned load')));
+
+        tmpreg2:=getaddressregister(list);
+        a_loadaddr_ref_reg(list,ref,tmpreg2);
+        reference_reset_base(tmpref,tmpreg2,0,1);
+        tmpref.direction:=dir_inc;
+
+        if isaddressregister(register) then
+          tmpreg:=getintregister(list,OS_ADDR)
+        else
+          tmpreg:=register;
+
+        case fromsize of
+          OS_16,OS_S16:
+            begin
+              list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
+              list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
+              tmpref.direction:=dir_none;
+              list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
+              sign_extend(list,fromsize,tmpreg);
+            end;
+          OS_32,OS_S32:
+            begin
+              list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
+              list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
+              list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
+              list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg));
+              list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
+              list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg));
+              tmpref.direction:=dir_none;
+              list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg));
+            end
+          else
+            internalerror(2016052103);
+        end;
+        if tmpreg<>register then
+          a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpreg,register);
       end;
 
 
@@ -1118,7 +1263,8 @@ unit cgcpu;
         opsize := TCGSize2OpSize[size];
 
         { on ColdFire all arithmetic operations are only possible on 32bit }
-        if ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)
+        if needs_unaligned(ref.alignment,size) or
+           ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)
            and not (op in [OP_NONE,OP_MOVE])) then
           begin
             inherited;
@@ -1284,16 +1430,22 @@ unit cgcpu;
 
         { on ColdFire all arithmetic operations are only possible on 32bit 
           and addressing modes are limited }
-        if ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
+        if needs_unaligned(ref.alignment,size) or
+           ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
           begin
+            //list.concat(tai_comment.create(strpnew('a_op_reg_ref: inherited #1')));
             inherited;
             exit;
           end;
 
         case op of
           OP_ADD,
-          OP_SUB :
+          OP_SUB,
+          OP_OR,
+          OP_XOR,
+          OP_AND:
             begin
+              //list.concat(tai_comment.create(strpnew('a_op_reg_ref: normal op')));
               href:=ref;
               fixref(list,href,false);
               { areg -> ref arithmetic operations are impossible on 68k }
@@ -1302,12 +1454,56 @@ unit cgcpu;
               list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href));
             end;
           else begin
-//            list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited')));
+            //list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited #2')));
             inherited;
           end;
         end;
       end;
 
+
+    procedure tcg68k.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
+      var
+        opcode : tasmop;
+        opsize : topsize;
+        href   : treference;
+        hreg   : tregister;
+      begin
+        opcode := topcg2tasmop[op];
+        opsize := TCGSize2OpSize[size];
+
+        { on ColdFire all arithmetic operations are only possible on 32bit 
+          and addressing modes are limited }
+        if needs_unaligned(ref.alignment,size) or
+           ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then
+          begin
+            //list.concat(tai_comment.create(strpnew('a_op_ref_reg: inherited #1')));
+            inherited;
+            exit;
+          end;
+
+        case op of
+          OP_ADD,
+          OP_SUB,
+          OP_OR,
+          OP_AND,
+          OP_MUL,
+          OP_IMUL:
+            begin
+              //list.concat(tai_comment.create(strpnew('a_op_ref_reg: normal op')));
+              href:=ref;
+              { Coldfire doesn't support d(Ax,Dx) for long MULx... }
+              fixref(list,href,(op in [OP_MUL,OP_IMUL]) and 
+                               (current_settings.cputype in cpu_coldfire));
+              list.concat(taicpu.op_ref_reg(opcode, opsize, href, reg));
+            end;
+          else begin
+            //list.concat(tai_comment.create(strpnew('a_op_ref_reg inherited #2')));
+            inherited;
+          end;
+        end;
+      end;
+
+
     procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
             l : tasmlabel);
       var
@@ -1372,7 +1568,7 @@ unit cgcpu;
       begin
         { optimize for usage of TST here, so ref compares against zero, which is the 
           most common case by far in the RTL code at least (KB) }
-        if (a = 0) then
+        if not needs_unaligned(ref.alignment,size) and (a = 0) then
           begin
             //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label with TST')));
             tmpref:=ref;
@@ -1513,7 +1709,7 @@ unit cgcpu;
          a_loadaddr_ref_reg(list,source,iregister);
          a_loadaddr_ref_reg(list,dest,jregister);
 
-         if (current_settings.cputype <> cpu_mc68000) then 
+         if not (needs_unaligned(source.alignment,OS_INT) or needs_unaligned(dest.alignment,OS_INT)) then
            begin
              if not ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=16))) then
                begin
@@ -1570,7 +1766,7 @@ unit cgcpu;
                  list.concat(taicpu.op_sym(A_BPL,S_NO,hl));
                end
              else
-               list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
+               list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl));
            end;
       end;
 
@@ -1770,7 +1966,7 @@ unit cgcpu;
             { Copy registers to temp }
             { NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. }
             href:=current_procinfo.save_regs_ref;
-            if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire) then
+            if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
               begin
                 list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
                 list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
@@ -1858,7 +2054,7 @@ unit cgcpu;
 
         { Restore registers from temp }
         href:=current_procinfo.save_regs_ref;
-        if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire) then
+        if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) then
           begin
             list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
             list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
@@ -2144,10 +2340,9 @@ unit cgcpu;
             begin
               tempref:=ref;
               tcg68k(cg).fixref(list,tempref,false);
+              list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reghi));
               inc(tempref.offset,4);
               list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reglo));
-              dec(tempref.offset,4);
-              list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reghi));
             end;
         else
           { XOR does not allow reference for source; ADD/SUB do not allow reference for
@@ -2210,6 +2405,34 @@ unit cgcpu;
       end;
 
 
+    procedure tcg64f68k.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
+      var
+        tmpref: treference;
+      begin
+        tmpref:=ref;
+        tcg68k(cg).fixref(list,tmpref,false);
+        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
+        inc(tmpref.offset,4);
+        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
+      end;
+
+    procedure tcg64f68k.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
+      var
+        tmpref: treference;
+      begin
+        { do not allow 64bit values to be loaded to address registers }
+        if isaddressregister(reg.reglo) or
+           isaddressregister(reg.reghi) then
+          internalerror(2016050501);
+
+        tmpref:=ref;
+        tcg68k(cg).fixref(list,tmpref,false);
+        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
+        inc(tmpref.offset,4);
+        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
+      end;
+
+
 procedure create_codegen;
   begin
     cg := tcg68k.create;

compiler/m68k/cpubase.pas

@@ -67,7 +67,7 @@ unit cpubase;
          { mc64040 instructions }
          a_move16,
          { coldfire v4 instructions }
-         a_mov3q,a_mvz,a_mvs,a_sats,a_byterev,a_ff1,
+         a_mov3q,a_mvz,a_mvs,a_sats,a_byterev,a_ff1,a_remu,a_rems,
          { fpu processor instructions - directly supported }
          { ieee aware and misc. condition codes not supported   }
          a_fabs,a_fadd,
@@ -364,6 +364,7 @@ unit cpubase;
     function isintregister(reg : tregister) : boolean;
     function fpuregopsize: TOpSize; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function fpuregsize: aint; {$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function needs_unaligned(const refalignment: aint; const size: tcgsize): boolean;
     function isregoverlap(reg1: tregister; reg2: tregister): boolean;
 
     function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
@@ -553,6 +554,13 @@ implementation
         result:=fpu_regsize[current_settings.fputype = fpu_coldfire];
       end;
 
+    function needs_unaligned(const refalignment: aint; const size: tcgsize): boolean;
+      begin
+        result:=not(CPUM68K_HAS_UNALIGNED in cpu_capabilities[current_settings.cputype]) and
+                (refalignment = 1) and
+                (tcgsize2size[size] > 1);
+      end;
+
     // the function returns true, if the registers overlap (subreg of the same superregister and same type)
     function isregoverlap(reg1: tregister; reg2: tregister): boolean;
       begin

compiler/m68k/cpuinfo.pas

@@ -38,6 +38,7 @@ Type
        cpu_MC68000,
        cpu_MC68020,
        cpu_MC68040,
+       cpu_MC68060,
        cpu_isa_a,
        cpu_isa_a_p,
        cpu_isa_b,
@@ -94,6 +95,7 @@ Const
      '68000',
      '68020',
      '68040',
+     '68060',
      'ISAA',
      'ISAA+',
      'ISAB',
@@ -105,6 +107,7 @@ Const
      '68000',
      '68020',
      '68040',
+     '68060',
      'isaa',
      'isaaplus',
      'isab',
@@ -142,25 +145,39 @@ type
       CPUM68K_HAS_TAS,       { CPU supports the TAS instruction                          }
       CPUM68K_HAS_BRAL,      { CPU supports the BRA.L/Bcc.L instructions                 }
       CPUM68K_HAS_ROLROR,    { CPU supports the ROL/ROR and ROXL/ROXR instructions       }
-      CPUM68K_HAS_BYTEREV    { CPU supports the BYTEREV instruction                      }
+      CPUM68K_HAS_BYTEREV,   { CPU supports the BYTEREV instruction                      }
+      CPUM68K_HAS_MVSMVZ,    { CPU supports the MVZ and MVS instructions                 }
+      CPUM68K_HAS_MOVE16,    { CPU supports the MOVE16 instruction                       }
+      CPUM68K_HAS_32BITMUL,  { CPU supports MULS/MULU 32x32 -> 32bit                     }
+      CPUM68K_HAS_64BITMUL,  { CPU supports MULS/MULU 32x32 -> 64bit                     }
+      CPUM68K_HAS_16BITDIV,  { CPU supports DIVS/DIVU 32/16 -> 16bit                     }
+      CPUM68K_HAS_32BITDIV,  { CPU supports DIVS/DIVU 32/32 -> 32bit                     }
+      CPUM68K_HAS_64BITDIV,  { CPU supports DIVS/DIVU 64/32 -> 32bit                     }
+      CPUM68K_HAS_REMSREMU,  { CPU supports the REMS/REMU instructions                   }
+      CPUM68K_HAS_UNALIGNED, { CPU supports unaligned access                             }
+      CPUM68K_HAS_BASEDISP   { CPU supports addressing with 32bit base displacements     }
      );
 
 const
   cpu_capabilities : array[tcputype] of set of tcpuflags =
     ( { cpu_none     } [],
-      { cpu_68000    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS,CPUM68K_HAS_ROLROR],
-      { cpu_68020    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR],
-      { cpu_68040    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR],
-      { cpu_isaa     } [],
-      { cpu_isaap    } [CPUM68K_HAS_BRAL,CPUM68K_HAS_BYTEREV],
-      { cpu_isab     } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL],
-      { cpu_isac     } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV],
-      { cpu_cfv4e    } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV]
+      { cpu_68000    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS,CPUM68K_HAS_ROLROR,CPUM68K_HAS_16BITDIV],
+      { cpu_68020    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV],
+      { cpu_68040    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV,CPUM68K_HAS_MOVE16],
+      { cpu_68060    } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_MOVE16],
+      { cpu_isaa     } [CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU],
+      { cpu_isaap    } [CPUM68K_HAS_BRAL,CPUM68K_HAS_BYTEREV,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU],
+      { cpu_isab     } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU],
+      { cpu_isac     } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU],
+      { cpu_cfv4e    } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU]
     );
 
   { all CPUs commonly called "coldfire" }
   cpu_coldfire = [cpu_isa_a,cpu_isa_a_p,cpu_isa_b,cpu_isa_c,cpu_cfv4e];
 
+  { all CPUs commonly called "68020+" }
+  cpu_mc68020p = [cpu_mc68020,cpu_mc68040,cpu_mc68060];
+
 Implementation
 
 end.

compiler/m68k/cpunode.pas

@@ -39,7 +39,7 @@ unit cpunode;
 //       nppccon,
 //       nppcflw,
          n68kmem,
-//       nppcset,
+         n68kset,
          n68kinl,
 //       nppcopt,
        { this not really a node }

compiler/m68k/cputarg.pas

@@ -59,6 +59,7 @@ implementation
 **************************************}
 
       ,ag68kgas
+      ,ag68kvasm
 
 {**************************************
              Debuginfo

compiler/m68k/itcpugas.pas

@@ -61,7 +61,7 @@ interface
          { mc64040 instructions }
          'move16',
          { coldfire v4 instructions }
-         'mov3q','mvz','mvs','sats','byterev','ff1',
+         'mov3q','mvz','mvs','sats','byterev','ff1','remu','rems',
          { fpu processor instructions - directly supported }
          { ieee aware and misc. condition codes not supported   }
          'fabs','fadd',

compiler/m68k/n68kadd.pas

@@ -37,6 +37,7 @@ interface
        protected
           procedure second_addfloat;override;
           procedure second_cmpfloat;override;
+          procedure second_addordinal;override;
           procedure second_cmpordinal;override;
           procedure second_cmpsmallset;override;
           procedure second_cmp64bit;override;
@@ -171,23 +172,39 @@ implementation
         case current_settings.fputype of
           fpu_68881,fpu_coldfire:
             begin
-              { have left in the register, right can be a memory location }
-              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
-
               { initialize the result }
               location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
-              location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+
+              { have left in the register, right can be a memory location }
+              if not (current_settings.fputype = fpu_coldfire) and
+                 (left.nodetype = realconstn) then
+                begin
+                  location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+                  current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FMOVE,tcgsize2opsize[left.location.size],trealconstnode(left).value_real,location.register))
+                end
+              else
+                begin
+                  hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+
+                  location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+                  cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
+                end;
 
               { emit the actual operation }
-              cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register);
               case right.location.loc of
                 LOC_FPUREGISTER,LOC_CFPUREGISTER:
                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,fpuregopsize,right.location.register,location.register));
                 LOC_REFERENCE,LOC_CREFERENCE:
                     begin
-                      href:=right.location.reference;
-                      tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire);
-                      current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,tcgsize2opsize[right.location.size],href,location.register));
+                      if not (current_settings.fputype = fpu_coldfire) and
+                         (right.nodetype = realconstn) then
+                        current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(op,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,location.register))
+                      else
+                        begin
+                          href:=right.location.reference;
+                          tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire);
+                          current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,tcgsize2opsize[right.location.size],href,location.register));
+                        end;
                     end
                 else
                   internalerror(2015021501);
@@ -214,17 +231,46 @@ implementation
           fpu_68881,fpu_coldfire:
             begin
               { force left fpureg as register, right can be reference }
-              hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
 
               { emit compare }
               case right.location.loc of
                 LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,fpuregopsize,right.location.register,left.location.register));
+                    begin
+                      hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,fpuregopsize,right.location.register,left.location.register));
+                    end;
                 LOC_REFERENCE,LOC_CREFERENCE:
                     begin
-                      href:=right.location.reference;
-                      tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire);
-                      current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_FCMP,tcgsize2opsize[right.location.size],href,left.location.register));
+                      { use FTST, if realconst is 0.0, it would be very had to do this in the
+                        optimized, because we would need to investigate the referenced value... }
+                      if (right.nodetype = realconstn) and
+                         (trealconstnode(right).value_real = 0.0) then
+                        begin
+                          if left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then
+                            current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_FTST,fpuregopsize,left.location.register))
+                          else
+                            if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
+                              begin
+                                href:=left.location.reference;
+                                tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false);
+                                current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FTST,tcgsize2opsize[left.location.size],href))
+                              end
+                            else
+                              internalerror(2016051001);
+                        end
+                      else
+                        begin
+                          hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+                          if not (current_settings.fputype = fpu_coldfire) and
+                             (right.nodetype = realconstn) then
+                            current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FCMP,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,left.location.register))
+                          else
+                            begin
+                              href:=right.location.reference;
+                              tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire);
+                              current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_FCMP,tcgsize2opsize[right.location.size],href,left.location.register));
+                            end;
+                        end;
                     end
                 else
                   internalerror(2015021502);
@@ -298,6 +344,70 @@ implementation
                                 Ordinals
 *****************************************************************************}
 
+    procedure t68kaddnode.second_addordinal;
+      var
+        cgop    : topcg;
+      begin
+        { if we need to handle overflow checking, fall back to the generic cg }
+        if (nodetype in [addn,subn,muln]) and
+           (left.resultdef.typ<>pointerdef) and
+           (right.resultdef.typ<>pointerdef) and
+           (cs_check_overflow in current_settings.localswitches) then
+          begin
+            inherited;
+            exit;
+          end;
+
+        case nodetype of
+          addn: cgop:=OP_ADD;
+          xorn: cgop:=OP_XOR;
+          orn : cgop:=OP_OR;
+          andn: cgop:=OP_AND;
+          subn: cgop:=OP_SUB;
+          muln:
+            begin
+              if not(is_signed(left.resultdef)) or
+                 not(is_signed(right.resultdef)) then
+                cgop:=OP_MUL
+              else
+                cgop:=OP_IMUL;
+            end;
+          else
+            internalerror(2013120104);
+        end;
+
+        pass_left_right;
+        if (nodetype=subn) and (nf_swapped in flags) then
+          swapleftright;
+
+        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
+
+        { initialize the result }
+        location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+        location.register := cg.getintregister(current_asmdata.CurrAsmList,location.size);
+        cg.a_load_reg_reg(current_asmdata.CurrAsmlist,left.location.size,location.size,left.location.register,location.register);
+
+        if (location.size <> right.location.size) or
+           not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_CONSTANT,LOC_REFERENCE,LOC_CREFERENCE]) or
+           (not(CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype]) and (nodetype = muln)) or 
+           ((right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(right.location.reference.alignment,def_cgsize(resultdef))) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+
+        case right.location.loc of
+          LOC_REGISTER,
+          LOC_CREGISTER:
+            cg.a_op_reg_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),right.location.register,location.register);
+          LOC_CONSTANT:
+            cg.a_op_const_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),right.location.value,location.register);
+          LOC_REFERENCE,
+          LOC_CREFERENCE:
+            cg.a_op_ref_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),right.location.reference,location.register);
+        else
+          internalerror(2016052101);
+        end;
+      end;
+
+
     procedure t68kaddnode.second_cmpordinal;
      var
       unsigned : boolean;
@@ -322,19 +432,25 @@ implementation
        if (right.location.loc=LOC_CONSTANT) and (right.location.value=0) then
          begin
            { Unsigned <0 or >=0 should not reach pass2, most likely }
-           case left.location.loc of
-             LOC_REFERENCE,
-             LOC_CREFERENCE:
-               begin
-                 href:=left.location.reference;
-                 tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false);
-                 current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,opsize,href));
-                 location_freetemp(current_asmdata.CurrAsmList,left.location);
-               end;
+           if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and not needs_unaligned(left.location.reference.alignment,cmpsize) then
+             begin
+               href:=left.location.reference;
+               tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false);
+               current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,opsize,href));
+               location_freetemp(current_asmdata.CurrAsmList,left.location);
+             end
            else
-             hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
-             current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,opsize,left.location.register));
-           end;
+             begin
+               hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+               if (current_settings.cputype = cpu_mc68000) and isaddressregister(left.location.register) then
+                 begin
+                   tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,cmpsize);
+                   cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,cmpsize,left.location.register,tmpreg);
+                 end
+               else
+                 tmpreg:=left.location.register;
+               current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,opsize,tmpreg));
+             end;
            location.resflags := getresflags(unsigned);
            exit;
          end;
@@ -361,6 +477,10 @@ implementation
                toggleflag(nf_swapped);
              end;
          end;
+
+       if (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(right.location.reference.alignment,cmpsize) then
+         hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+
        { left is now in register }
        case right.location.loc of
          LOC_CONSTANT:
@@ -490,26 +610,25 @@ implementation
         if (right.location.loc=LOC_CONSTANT) and (right.location.value64=0) and
           (nodetype in [equaln,unequaln]) then
           begin
-            case left.location.loc of
-              LOC_REFERENCE,
-              LOC_CREFERENCE:
-                begin
-                  href:=left.location.reference;
-                  tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false);
-                  current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href));
-                  firstjmp64bitcmp;
-                  inc(href.offset,4);
-                  current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href));
-                  secondjmp64bitcmp;
-                  location_freetemp(current_asmdata.CurrAsmList,left.location);
-                end;
+            if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and not needs_unaligned(left.location.reference.alignment,OS_INT) then
+              begin
+                href:=left.location.reference;
+                tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false);
+                current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href));
+                firstjmp64bitcmp;
+                inc(href.offset,4);
+                current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href));
+                secondjmp64bitcmp;
+                location_freetemp(current_asmdata.CurrAsmList,left.location);
+              end
             else
-              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reglo));
-              firstjmp64bitcmp;
-              current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reghi));
-              secondjmp64bitcmp;
-            end;
+              begin
+                hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reglo));
+                firstjmp64bitcmp;
+                current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reghi));
+                secondjmp64bitcmp;
+              end;
             exit;
           end;
 
@@ -526,6 +645,9 @@ implementation
               end;
           end;
 
+        if (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(right.location.reference.alignment,OS_INT) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+
         { left is now in register }
         case right.location.loc of
           LOC_REGISTER,LOC_CREGISTER:

compiler/m68k/n68kcnv.pas

@@ -46,7 +46,7 @@ implementation
       ncon,ncal,
       ncgutil,
       cpubase,cpuinfo,aasmcpu,
-      rgobj,tgobj,cgobj,hlcgobj,cgutils,globtype,cgcpu;
+      rgobj,tgobj,cgobj,hlcgobj,cgutils,globtype,cgcpu,cutils;
 
 
 {*****************************************************************************
@@ -191,7 +191,8 @@ implementation
          newsize:=def_cgsize(resultdef);
          opsize := def_cgsize(left.resultdef);
 
-        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then
+        if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) or
+           ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(left.location.reference.alignment,opsize)) then
           hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
 
          case left.location.loc of
@@ -199,51 +200,42 @@ implementation
               begin
                 if opsize in [OS_64,OS_S64] then
                   begin
+                    //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('typeconvnode second_int_to_bool #1')));
                     reg64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
                     reg64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
                     cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,reg64);
                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_OR,S_L,reg64.reghi,reg64.reglo));
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,reg64.reglo));
+                    // it's not necessary to call TST after OR, which sets the flags as required already
+                    //current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,reg64.reglo));
                   end
                 else
                   begin
-                    { can we optimize it, or do we need to fix the ref. ? }
-                    if isvalidrefoffset(left.location.reference) then
-                      begin
-                        { Coldfire cannot handle tst.l 123(dX) }
-                        if (current_settings.cputype in (cpu_coldfire + [cpu_mc68000])) and
-                           isintregister(left.location.reference.base) then
-                          begin
-                            tmpreference:=left.location.reference;
-                            hreg2:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                            tmpreference.base:=hreg2;
-                            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOVE,S_L,left.location.reference.base,hreg2));
-                            current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],tmpreference));
-                          end
-                        else
-                          current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],left.location.reference));
-                      end
-                    else
-                      begin
-                         hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
-                         cg.a_load_ref_reg(current_asmdata.CurrAsmList,opsize,opsize,
-                            left.location.reference,hreg2);
-                         current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2));
-                      end;
+                    //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('typeconvnode second_int_to_bool #2')));
+                    tmpreference:=left.location.reference;
+                    tcg68k(cg).fixref(current_asmdata.CurrAsmList,tmpreference,false);
+                    current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],tmpreference));
                   end;
               end;
             LOC_REGISTER,LOC_CREGISTER :
               begin
                 if opsize in [OS_64,OS_S64] then
                   begin
+                    //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('typeconvnode second_int_to_bool #3')));
                     hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOVE,S_L,left.location.register64.reglo,hreg2));
                     current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_OR,S_L,left.location.register64.reghi,hreg2));
-                    current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,hreg2));
+                    // it's not necessary to call TST after OR, which sets the flags as required already
+                    //current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,hreg2));
                   end
                 else
                   begin
-                    hreg2:=left.location.register;
+                    if (current_settings.cputype = cpu_mc68000) and isaddressregister(left.location.register) then
+                      begin
+                        hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,opsize,left.location.register,hreg2);
+                      end
+                    else
+                      hreg2:=left.location.register;
                     current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2));
                   end;
               end;

compiler/m68k/n68kmat.pas

@@ -80,6 +80,10 @@ implementation
           begin
             secondpass(left);
             opsize:=def_cgsize(resultdef);
+
+            if ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(left.location.reference.alignment,opsize)) then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
+
             case left.location.loc of
               LOC_FLAGS :
                 begin
@@ -117,7 +121,14 @@ implementation
                   else
                     begin
                       hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
-                      current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,tcgsize2opsize[opsize],left.location.register));
+                      if (current_settings.cputype = cpu_mc68000) and isaddressregister(left.location.register) then
+                        begin
+                          hreg:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+                          cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,opsize,left.location.register,hreg);
+                        end
+                      else
+                        hreg:=left.location.register;
+                      current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,tcgsize2opsize[opsize],hreg));
                     end;
                   location_reset(location,LOC_FLAGS,OS_NO);
                   location.resflags:=F_E;
@@ -135,7 +146,7 @@ implementation
 
   function tm68kmoddivnode.first_moddivint: tnode;
     begin
-      if current_settings.cputype=cpu_MC68020 then
+      if CPUM68K_HAS_32BITDIV in cpu_capabilities[current_settings.cputype] then
         result:=nil
       else
         result:=inherited first_moddivint;
@@ -143,13 +154,12 @@ implementation
 
 
   procedure tm68kmoddivnode.emit_div_reg_reg(signed: boolean;denum,num : tregister);
+   const
+     divudivs: array[boolean] of tasmop = (A_DIVU,A_DIVS);
    begin
-     if current_settings.cputype=cpu_MC68020 then
+     if CPUM68K_HAS_32BITDIV in cpu_capabilities[current_settings.cputype] then
        begin
-         if signed then
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
-         else
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DIVU,S_L,denum,num));
+         current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(divudivs[signed],S_L,denum,num));
        end
      else
        InternalError(2014062801);
@@ -157,22 +167,22 @@ implementation
 
 
   procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister);
+    const
+      remop: array[boolean,boolean] of tasmop = ((A_DIVU,A_DIVS),(A_REMU,A_REMS));
     var
       tmpreg : tregister;
     begin
-     if current_settings.cputype=cpu_MC68020 then
-       begin
-         tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-         { copy the numerator to the tmpreg, so we can use it as quotient, which
-           means we'll get the remainder immediately in the numerator }
-         cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,tmpreg);
-         if signed then
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVSL,S_L,denum,num,tmpreg))
-         else
-           current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVUL,S_L,denum,num,tmpreg));
-       end
-     else
-       InternalError(2014062802);
+      if CPUM68K_HAS_32BITDIV in cpu_capabilities[current_settings.cputype] then
+        begin
+          tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+          { copy the numerator to the tmpreg, so we can use it as quotient, which
+            means we'll get the remainder immediately in the numerator }
+          cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,tmpreg);
+          current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(
+            remop[CPUM68K_HAS_REMSREMU in cpu_capabilities[current_settings.cputype],signed],S_L,denum,num,tmpreg));
+        end
+      else
+        InternalError(2014062802);
     end;
 
 

compiler/m68k/n68kmem.pas

@@ -90,7 +90,7 @@ implementation
               end;
           end;
 
-        if (location.reference.base=NR_NO) and not (scaled) then
+        if (location.reference.base=NR_NO) and not (scaled) and not assigned(location.reference.symbol) then
           begin
            { prefer an address reg, if we will be a base, for indexes any register works }
             if isintregister(maybe_const_reg) then

compiler/m68k/n68kset.pas

@@ -0,0 +1,138 @@
+{
+    Copyright (c) 2016 by the Free Pascal development team
+
+    Generate m68k assembler for in set/case labels
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit n68kset;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,
+      symtype,
+      cgbase,cpuinfo,cpubase,
+      node,nset,ncgset;
+
+    type
+      tcpucasenode = class(tcgcasenode)
+        procedure genlinearlist(hp : pcaselabel); override;
+      end;
+
+implementation
+
+    uses
+      systems,globals,
+      cutils,verbose,
+      symdef,paramgr,
+      aasmtai,aasmdata,
+      nflw,constexp,
+      cgutils,cgobj,hlcgobj,
+      defutil;
+
+    procedure tcpucasenode.genlinearlist(hp : pcaselabel);
+
+      var
+         first : boolean;
+         last : TConstExprInt;
+         scratch_reg: tregister;
+         newsize: tcgsize;
+         newdef: tdef;
+
+      procedure genitem(t : pcaselabel);
+
+        begin
+           if assigned(t^.less) then
+             genitem(t^.less);
+           { do we need to test the first value? }
+           if first and (t^._low>get_min_value(left.resultdef)) then
+             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,tcgint(t^._low.svalue),hregister,elselabel);
+           if t^._low=t^._high then
+             begin
+               if t^._low-last=0 then
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_EQ,0,hregister,blocklabel(t^.blockid))
+               else
+                 begin
+                   hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._low.svalue-last.svalue), hregister);
+                   hlcg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,blocklabel(t^.blockid));
+                 end;
+               last:=t^._low;
+             end
+           else
+             begin
+                { it begins with the smallest label, if the value }
+                { is even smaller then jump immediately to the    }
+                { ELSE-label                                }
+                if first then
+                  begin
+                     { have we to ajust the first value ? }
+                     if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then
+                       hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._low.svalue), hregister);
+                  end
+                else
+                  begin
+                    { if there is no unused label between the last and the }
+                    { present label then the lower limit can be checked    }
+                    { immediately. else check the range in between:       }
+                    hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._low.svalue-last.svalue), hregister);
+                    hlcg.a_jmp_flags(current_asmdata.CurrAsmList,F_L,elselabel);
+                  end;
+                hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._high.svalue-t^._low.svalue), hregister);
+                hlcg.a_jmp_flags(current_asmdata.CurrAsmList,F_LE,blocklabel(t^.blockid));
+                last:=t^._high;
+             end;
+           first:=false;
+           if assigned(t^.greater) then
+             genitem(t^.greater);
+        end;
+
+      begin
+         { do we need to generate cmps? }
+         if (with_sign and (min_label<0)) then
+           genlinearcmplist(hp)
+         else
+           begin
+              { sign/zero extend the value to a full register before starting to
+                subtract values, so that on platforms that don't have
+                subregisters of the same size as the value we don't generate
+                sign/zero-extensions after every subtraction
+
+                make newsize always signed, since we only do this if the size in
+                bytes of the register is larger than the original opsize, so
+                the value can always be represented by a larger signed type }
+              newsize:=tcgsize2signed[reg_cgsize(hregister)];
+              if tcgsize2size[newsize]>opsize.size then
+                begin
+                  newdef:=cgsize_orddef(newsize);
+                  scratch_reg:=hlcg.getintregister(current_asmdata.CurrAsmList,newdef);
+                  hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,newdef,hregister,scratch_reg);
+                  hregister:=scratch_reg;
+                  opsize:=newdef;
+                end;
+              last:=0;
+              first:=true;
+              genitem(hp);
+              hlcg.a_jmp_always(current_asmdata.CurrAsmList,elselabel);
+           end;
+      end;
+
+begin
+  ccasenode:=tcpucasenode;
+end.

compiler/nbas.pas

@@ -214,7 +214,6 @@ interface
           tempinfo: ptempinfo;
 
           constructor create(const temp: ttempcreatenode); virtual;
-          constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure resolveppuidx;override;
@@ -224,8 +223,6 @@ interface
           procedure mark_write;override;
           function docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
-         protected
-          offset : longint;
          private
           tempidx : longint;
         end;
@@ -1024,14 +1021,6 @@ implementation
       begin
         inherited create(temprefn);
         tempinfo := temp.tempinfo;
-        offset:=0;
-      end;
-
-
-    constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint);
-      begin
-        self.create(temp);
-        offset := aoffset;
       end;
 
 
@@ -1040,7 +1029,6 @@ implementation
         n: ttemprefnode;
       begin
         n := ttemprefnode(inherited dogetcopy);
-        n.offset := offset;
 
         if assigned(tempinfo^.hookoncopy) then
           { if the temp has been copied, assume it becomes a new }
@@ -1073,7 +1061,6 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         tempidx:=ppufile.getlongint;
-        offset:=ppufile.getlongint;
       end;
 
 
@@ -1081,7 +1068,6 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putlongint(tempinfo^.owner.ppuidx);
-        ppufile.putlongint(offset);
       end;
 
 
@@ -1141,8 +1127,7 @@ implementation
       begin
         result :=
           inherited docompare(p) and
-          (ttemprefnode(p).tempinfo = tempinfo) and
-          (ttemprefnode(p).offset = offset);
+          (ttemprefnode(p).tempinfo = tempinfo);
       end;
 
 

compiler/ncal.pas

@@ -304,6 +304,7 @@ implementation
       symconst,defutil,defcmp,
       htypechk,pass_1,
       ncnv,nflw,nld,ninl,nadd,ncon,nmem,nset,nobjc,
+      pgenutil,
       ngenutil,objcutil,
       procinfo,cpuinfo,
       wpobase;
@@ -365,6 +366,8 @@ implementation
         restype: byte;
         selftemp: ttempcreatenode;
         selfpara: tnode;
+        vardispatchparadef: trecorddef;
+        vardispatchfield: tsym;
 
         names : ansistring;
         variantdispatch : boolean;
@@ -465,7 +468,9 @@ implementation
           end;
 
         { create a temp to store parameter values }
-        params:=ctempcreatenode.create(cformaltype,0,tt_persistent,false);
+        vardispatchparadef:=crecorddef.create_global_internal('',voidpointertype.size,voidpointertype.size,current_settings.alignment.maxCrecordalign);
+        { the size will be set once the vardistpatchparadef record has been completed }
+        params:=ctempcreatenode.create(vardispatchparadef,0,tt_persistent,false);
         addstatement(statements,params);
 
         calldescnode:=cdataconstnode.create;
@@ -518,15 +523,14 @@ implementation
             { for Variants, we always pass a pointer, RTL helpers must handle it
               depending on byref bit }
 
+            vardispatchfield:=vardispatchparadef.add_field_by_def('',assignmenttype);
             if assignmenttype=voidpointertype then
               addstatement(statements,cassignmentnode.create(
-                ctypeconvnode.create_internal(ctemprefnode.create_offset(params,paramssize),
-                  voidpointertype),
+                csubscriptnode.create(vardispatchfield,ctemprefnode.create(params)),
                 ctypeconvnode.create_internal(caddrnode.create_internal(para.left),voidpointertype)))
             else
               addstatement(statements,cassignmentnode.create(
-                ctypeconvnode.create_internal(ctemprefnode.create_offset(params,paramssize),
-                  assignmenttype),
+              csubscriptnode.create(vardispatchfield,ctemprefnode.create(params)),
                 ctypeconvnode.create_internal(para.left,assignmenttype)));
 
             inc(paramssize,max(voidpointertype.size,assignmenttype.size));
@@ -536,6 +540,9 @@ implementation
             para:=tcallparanode(para.nextpara);
           end;
 
+        { finalize the parameter record }
+        trecordsymtable(vardispatchparadef.symtable).addalignmentpadding;
+
         { Set final size for parameter block }
         params.size:=paramssize;
 
@@ -3597,6 +3604,8 @@ implementation
                      { if the final procedure definition is not yet owned,
                        ensure that it is }
                      procdefinition.register_def;
+                     if procdefinition.is_specialization and (procdefinition.typ=procdef) then
+                       maybe_add_pending_specialization(procdefinition);
 
                      candidates.free;
                  end; { end of procedure to call determination }

compiler/ncgbas.pas

@@ -490,8 +490,6 @@ interface
         case tempinfo^.location.loc of
           LOC_REFERENCE:
             begin
-              inc(location.reference.offset,offset);
-              location.reference.alignment:=newalignment(location.reference.alignment,offset);
               { ti_valid should be excluded if it's a normal temp }
             end;
           LOC_REGISTER,
@@ -516,8 +514,6 @@ interface
         tg.ChangeTempType(current_asmdata.CurrAsmList,tempinfo^.location.reference,tempinfo^.temptype);
         { adapt location }
         location.reference := ref;
-        inc(location.reference.offset,offset);
-        location.reference.alignment:=newalignment(location.reference.alignment,offset);
       end;
 
 

compiler/ncgmem.pas

@@ -926,12 +926,7 @@ implementation
                 LOC_REGISTER,
                 LOC_CREGISTER :
                   begin
-{$ifdef m68k}
-                    location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                    cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register,location.reference.base);
-{$else m68k}
                     hlcg.reference_reset_base(location.reference,left.resultdef,left.location.register,0,location.reference.alignment);
-{$endif m68k}
                   end;
                 LOC_CREFERENCE,
                 LOC_REFERENCE :

compiler/ncgutil.pas

@@ -1308,7 +1308,9 @@ implementation
         for i:=0 to current_procinfo.procdef.paras.count-1 do
           begin
             currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
-            gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
+            { don't use currpara.vardef, as this will be wrong in case of
+              call-by-reference parameters (it won't contain the pointerdef) }
+            gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside]));
             { gen_load_cgpara_loc() already allocated the initialloc
               -> don't allocate again }
             if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then

compiler/ncnv.pas

@@ -1760,7 +1760,7 @@ implementation
 
         { one dimensional }
         addstatement(newstatement,cassignmentnode.create(
-            ctemprefnode.create_offset(temp2,0),
+            ctemprefnode.create(temp2),
             cordconstnode.create
                (tarraydef(left.resultdef).highrange+1,s32inttype,true)));
         { create call to fpc_dynarr_setlength }

compiler/ngenutil.pas

@@ -37,6 +37,17 @@ interface
       class function call_fail_node:tnode; virtual;
       class function initialize_data_node(p:tnode; force: boolean):tnode; virtual;
       class function finalize_data_node(p:tnode):tnode; virtual;
+     strict protected
+      class procedure sym_maybe_initialize(p: TObject; arg: pointer);
+      { generates the code for finalisation of local variables }
+      class procedure local_varsyms_finalize(p:TObject;arg:pointer);
+      { generates the code for finalization of static symtable and
+        all local (static) typed consts }
+      class procedure static_syms_finalize(p: TObject; arg: pointer);
+      class procedure sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
+     public
+      class procedure procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
+      class procedure procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode);
       { returns true if the unit requires an initialisation section (e.g.,
         to force class constructors for the JVM target to initialise global
         records/arrays) }
@@ -260,6 +271,149 @@ implementation
     end;
 
 
+  class procedure tnodeutils.sym_maybe_initialize(p: TObject; arg: pointer);
+    begin
+      if (tsym(p).typ = localvarsym) and
+         { local (procedure or unit) variables only need initialization if
+           they are used }
+         ((tabstractvarsym(p).refs>0) or
+          { managed return symbols must be inited }
+          ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions))
+         ) and
+         not(vo_is_typed_const in tabstractvarsym(p).varoptions) and
+         not(vo_is_external in tabstractvarsym(p).varoptions) and
+         not(vo_is_default_var in tabstractvarsym(p).varoptions) and
+         (is_managed_type(tabstractvarsym(p).vardef) or
+          ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef))
+         ) then
+        begin
+          addstatement(tstatementnode(arg^),initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false));
+        end;
+    end;
+
+
+  class procedure tnodeutils.local_varsyms_finalize(p: TObject; arg: pointer);
+    begin
+      if (tsym(p).typ=localvarsym) and
+         (tlocalvarsym(p).refs>0) and
+         not(vo_is_external in tlocalvarsym(p).varoptions) and
+         not(vo_is_funcret in tlocalvarsym(p).varoptions) and
+         not(vo_is_default_var in tabstractvarsym(p).varoptions) and
+         is_managed_type(tlocalvarsym(p).vardef) then
+        sym_maybe_finalize(tstatementnode(arg^),tsym(p));
+    end;
+
+
+  class procedure tnodeutils.static_syms_finalize(p: TObject; arg: pointer);
+    var
+      i : longint;
+      pd : tprocdef;
+    begin
+      case tsym(p).typ of
+        staticvarsym :
+          begin
+            { local (procedure or unit) variables only need finalization
+              if they are used
+            }
+            if ((tstaticvarsym(p).refs>0) or
+                { global (unit) variables always need finalization, since
+                  they may also be used in another unit
+                }
+                (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and
+                (
+                  (tstaticvarsym(p).varspez<>vs_const) or
+                  (vo_force_finalize in tstaticvarsym(p).varoptions)
+                ) and
+               not(vo_is_funcret in tstaticvarsym(p).varoptions) and
+               not(vo_is_external in tstaticvarsym(p).varoptions) and
+               is_managed_type(tstaticvarsym(p).vardef) and
+               not (
+                   assigned(tstaticvarsym(p).fieldvarsym) and
+                   assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and
+                   (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions)
+                 )
+               then
+              sym_maybe_finalize(tstatementnode(arg^),tsym(p));
+          end;
+        procsym :
+          begin
+            for i:=0 to tprocsym(p).ProcdefList.Count-1 do
+              begin
+                pd:=tprocdef(tprocsym(p).ProcdefList[i]);
+                if assigned(pd.localst) and
+                   (pd.procsym=tprocsym(p)) and
+                   (pd.localst.symtabletype<>staticsymtable) then
+                  pd.localst.SymList.ForEachCall(@static_syms_finalize,arg);
+              end;
+          end;
+      end;
+    end;
+
+
+  class procedure tnodeutils.sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
+    var
+      hp: tnode;
+    begin
+      include(current_procinfo.flags,pi_needs_implicit_finally);
+      hp:=cloadnode.create(sym,sym.owner);
+      if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then
+        include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst);
+      addstatement(stat,finalize_data_node(hp));
+    end;
+
+
+  class procedure tnodeutils.procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
+    begin
+      { initialize local data like ansistrings }
+      case pd.proctypeoption of
+         potype_unitinit:
+           begin
+             { this is also used for initialization of variables in a
+               program which does not have a globalsymtable }
+             if assigned(current_module.globalsymtable) then
+               TSymtable(current_module.globalsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
+             TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
+             TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
+           end;
+         { units have seperate code for initilization and finalization }
+         potype_unitfinalize: ;
+         { program init/final is generated in separate procedure }
+         potype_proginit:
+           begin
+             TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat);
+           end;
+         else
+           current_procinfo.procdef.localst.SymList.ForEachCall(@sym_maybe_initialize,@stat);
+      end;
+    end;
+
+
+  class procedure tnodeutils.procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode);
+    begin
+      { no finalization in exceptfilters, they /are/ the finalization code }
+      if current_procinfo.procdef.proctypeoption=potype_exceptfilter then
+          exit;
+
+      { finalize local data like ansistrings}
+      case current_procinfo.procdef.proctypeoption of
+         potype_unitfinalize:
+           begin
+             { this is also used for initialization of variables in a
+               program which does not have a globalsymtable }
+             if assigned(current_module.globalsymtable) then
+               TSymtable(current_module.globalsymtable).SymList.ForEachCall(@static_syms_finalize,@stat);
+             TSymtable(current_module.localsymtable).SymList.ForEachCall(@static_syms_finalize,@stat);
+           end;
+         { units/progs have separate code for initialization and finalization }
+         potype_unitinit: ;
+         { program init/final is generated in separate procedure }
+         potype_proginit: ;
+         else
+           current_procinfo.procdef.localst.SymList.ForEachCall(@local_varsyms_finalize,@stat);
+      end;
+    end;
+
+
   class function tnodeutils.force_init: boolean;
     begin
       result:=
@@ -584,12 +738,15 @@ implementation
       else
         list.concat(Tai_datablock.create(sym.mangledname,size));
 
-      { add the indirect symbol if needed }
-      new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment));
-      symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA);
-      list.concat(Tai_symbol.Create_Global(symind,0));
-      list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0));
-      list.concat(tai_symbol_end.Create(symind));
+      if (tf_supports_packages in target_info.flags) then
+        begin
+          { add the indirect symbol if needed }
+          new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment));
+          symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA);
+          list.concat(Tai_symbol.Create_Global(symind,0));
+          list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0));
+          list.concat(tai_symbol_end.Create(symind));
+        end;
     end;
 
 
@@ -1160,7 +1317,8 @@ implementation
       );
       tcb.free;
 
-      if not(tf_no_generic_stackcheck in target_info.flags) then
+      if (tf_emit_stklen in target_info.flags) or
+          not(tf_no_generic_stackcheck in target_info.flags) then
         begin
           { stacksize can be specified and is now simulated }
           tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_make_dead_strippable]);

compiler/ninl.pas

@@ -3958,7 +3958,7 @@ implementation
            newblock:=internalstatements(newstatement);
 
            { get temp for array of lengths }
-           temp:=ctempcreatenode.create(sinttype,dims*sinttype.size,tt_persistent,false);
+           temp:=ctempcreatenode.create(carraydef.getreusable(sinttype,dims),dims*sinttype.size,tt_persistent,false);
            addstatement(newstatement,temp);
 
            { load array of lengths }
@@ -3967,7 +3967,10 @@ implementation
            while assigned(ppn.right) do
              begin
                addstatement(newstatement,cassignmentnode.create(
-                   ctemprefnode.create_offset(temp,counter*sinttype.size),
+                   cvecnode.create(
+                     ctemprefnode.create(temp),
+                     genintconstnode(counter)
+                   ),
                    ppn.left));
                ppn.left:=nil;
                dec(counter);
@@ -3977,8 +3980,11 @@ implementation
            ppn.left:=nil;
 
            { create call to fpc_dynarr_setlength }
-           npara:=ccallparanode.create(caddrnode.create_internal
-                     (ctemprefnode.create(temp)),
+           npara:=ccallparanode.create(caddrnode.create_internal(
+                     cvecnode.create(
+                       ctemprefnode.create(temp),
+                       genintconstnode(0)
+                     )),
                   ccallparanode.create(cordconstnode.create
                      (dims,sinttype,true),
                   ccallparanode.create(caddrnode.create_internal

compiler/ogbase.pas

@@ -192,7 +192,7 @@ interface
        symidx     : longint;
        objsection : TObjSection;
        offset,
-       size       : aword;
+       size       : PUInt;
        { Used for external and common solving during linking }
        exesymbol  : TExeSymbol;
 
@@ -260,7 +260,7 @@ interface
        SecAlign   : shortint;   { alignment of the section }
        { section Data }
        Size,
-       DataPos    : aword;
+       DataPos    : PUInt;
        MemPos     : qword;
        Group      : TObjSectionGroup;
        DataAlignBytes : shortint;
@@ -272,19 +272,19 @@ interface
        VTRefList : TFPObjectList;
        constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
        destructor  destroy;override;
-       function  write(const d;l:aword):aword;
+       function  write(const d;l:PUInt):PUInt;
        { writes string plus zero byte }
-       function  writestr(const s:string):aword;
-       function  WriteZeros(l:longword):aword;
+       function  writestr(const s:string):PUInt;
+       function  WriteZeros(l:longword):PUInt;
        { writes content of s without null termination }
-       function  WriteBytes(const s:string):aword;
+       function  WriteBytes(const s:string):PUInt;
        procedure writeReloc_internal(aTarget:TObjSection;offset:aword;len:byte;reltype:TObjRelocationType);virtual;
        function  setmempos(mpos:qword):qword;
-       procedure setDatapos(var dpos:aword);
-       procedure alloc(l:aword);
-       procedure addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
-       procedure addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType);
-       procedure addrawReloc(ofs:aword;p:TObjSymbol;RawReloctype:byte);
+       procedure setDatapos(var dpos:PUInt);
+       procedure alloc(l:PUInt);
+       procedure addsymReloc(ofs:PUInt;p:TObjSymbol;Reloctype:TObjRelocationType);
+       procedure addsectionReloc(ofs:PUInt;aobjsec:TObjSection;Reloctype:TObjRelocationType);
+       procedure addrawReloc(ofs:PUInt;p:TObjSymbol;RawReloctype:byte);
        procedure ReleaseData;
        function  FullName:string;
        { string representation for the linker map file }
@@ -373,7 +373,7 @@ interface
        procedure afteralloc;virtual;
        procedure afterwrite;virtual;
        procedure resetsections;
-       procedure layoutsections(var datapos:aword);
+       procedure layoutsections(var datapos:PUInt);
        property Name:TString80 read FName;
        property CurrObjSec:TObjSection read FCurrObjSec;
        property ObjSymbolList:TObjSymbolList read FObjSymbolList;
@@ -928,7 +928,7 @@ implementation
       end;
 
 
-    function TObjSection.write(const d;l:aword):aword;
+    function TObjSection.write(const d;l:PUInt):PUInt;
       begin
         result:=size;
         if assigned(Data) then
@@ -947,7 +947,7 @@ implementation
       end;
 
 
-    function TObjSection.writestr(const s:string):aword;
+    function TObjSection.writestr(const s:string):PUInt;
       var
         b: byte;
       begin
@@ -957,13 +957,13 @@ implementation
       end;
 
 
-    function TObjSection.WriteBytes(const s:string):aword;
+    function TObjSection.WriteBytes(const s:string):PUInt;
       begin
         result:=Write(s[1],length(s));
       end;
 
 
-    function TObjSection.WriteZeros(l:longword):aword;
+    function TObjSection.WriteZeros(l:longword):PUInt;
       var
         empty : array[0..1023] of byte;
       begin
@@ -995,7 +995,7 @@ implementation
       end;
 
 
-    procedure TObjSection.setDatapos(var dpos:aword);
+    procedure TObjSection.setDatapos(var dpos:PUInt);
       begin
         if oso_Data in secoptions then
           begin
@@ -1018,7 +1018,7 @@ implementation
       end;
 
 
-    procedure TObjSection.alloc(l:aword);
+    procedure TObjSection.alloc(l:PUInt);
       begin
 {$ifndef cpu64bitalu}
         if (qword(size)+l)>high(size) then
@@ -1031,19 +1031,19 @@ implementation
       end;
 
 
-    procedure TObjSection.addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType);
+    procedure TObjSection.addsymReloc(ofs:PUInt;p:TObjSymbol;Reloctype:TObjRelocationType);
       begin
         ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype));
       end;
 
 
-    procedure TObjSection.addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType);
+    procedure TObjSection.addsectionReloc(ofs:PUInt;aobjsec:TObjSection;Reloctype:TObjRelocationType);
       begin
         ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype));
       end;
 
 
-    procedure TObjSection.addrawReloc(ofs:aword;p:TObjSymbol;RawReloctype:byte);
+    procedure TObjSection.addrawReloc(ofs:PUInt;p:TObjSymbol;RawReloctype:byte);
       begin
         ObjRelocations.Add(TObjRelocation.CreateRaw(ofs,p,RawReloctype));
       end;
@@ -1498,7 +1498,7 @@ implementation
       end;
 
 
-    procedure TObjData.layoutsections(var DataPos:aword);
+    procedure TObjData.layoutsections(var DataPos:PUInt);
       var
         i: longint;
       begin

compiler/pdecsub.pas

@@ -3229,6 +3229,7 @@ const
         are written using ;procdir; or ['procdir'] syntax.
       }
       var
+        stoprecording,
         res : boolean;
       begin
         if (m_mac in current_settings.modeswitches) and (cs_externally_visible in current_settings.localswitches) then
@@ -3257,6 +3258,17 @@ const
             include(pd.procoptions,po_staticmethod);
           end;
 
+        { for a generic routine we also need to record the procedure          }
+        { directives, but only if we aren't already recording for a           }
+        { surrounding generic                                                 }
+        if pd.is_generic and (pd.typ=procdef) and not current_scanner.is_recording_tokens then
+          begin
+            current_scanner.startrecordtokens(tprocdef(pd).genericdecltokenbuf);
+            stoprecording:=true;
+          end
+        else
+          stoprecording:=false;
+
         while token in [_ID,_LECKKLAMMER] do
          begin
            if try_to_consume(_LECKKLAMMER) then
@@ -3302,6 +3314,10 @@ const
            else
             break;
          end;
+
+        if stoprecording then
+          current_scanner.stoprecordtokens;
+
          { nostackframe requires assembler, but assembler
            may be specified in the implementation part only,
            and in not required if the function is first forward declared

compiler/pexpr.pas

@@ -66,7 +66,7 @@ implementation
 
     uses
        { common }
-       cutils,
+       cutils,cclasses,
        { global }
        verbose,
        systems,widestr,
@@ -1717,28 +1717,39 @@ implementation
          temp    : ttempcreatenode;
          paras : tcallparanode;
          newblock : tnode;
-         countindices : aint;
+         countindices : longint;
+         elements: tfplist;
+         arraydef: tdef;
        begin
          { create statements with call initialize the arguments and
            call fpc_dynarr_setlength }
          newblock:=internalstatements(newstatement);
 
-         { get temp for array of indicies,
-           we set the real size later }
-         temp:=ctempcreatenode.create(s32inttype,4,tt_persistent,false);
-         addstatement(newstatement,temp);
-
+         { store all indices in a temporary array }
          countindices:=0;
+         elements:=tfplist.Create;
          repeat
            p4:=comp_expr([ef_accept_equal]);
-
-           addstatement(newstatement,cassignmentnode.create(
-             ctemprefnode.create_offset(temp,countindices*s32inttype.size),p4));
-            inc(countindices);
+           elements.add(p4);
          until not try_to_consume(_COMMA);
 
-         { set real size }
-         temp.size:=countindices*s32inttype.size;
+         arraydef:=carraydef.getreusable(s32inttype,elements.count);
+         temp:=ctempcreatenode.create(arraydef,arraydef.size,tt_persistent,false);
+         addstatement(newstatement,temp);
+         for countindices:=0 to elements.count-1 do
+           begin
+             addstatement(newstatement,
+               cassignmentnode.create(
+                 cvecnode.create(
+                   ctemprefnode.create(temp),
+                   genintconstnode(countindices)
+                 ),
+                 tnode(elements[countindices])
+               )
+             );
+           end;
+         countindices:=elements.count;
+         elements.free;
 
          consume(_RECKKLAMMER);
 
@@ -1752,7 +1763,7 @@ implementation
              paras:=ccallparanode.create(cordconstnode.create
                    (countindices,s32inttype,true),
                 ccallparanode.create(caddrnode.create_internal
-               (ctemprefnode.create(temp)),
+               (cvecnode.create(ctemprefnode.create(temp),genintconstnode(0))),
                 ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype),
                 ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype)
                   ,nil))));
@@ -1827,7 +1838,7 @@ implementation
 
           { one dimensional }
           addstatement(newstatement,cassignmentnode.create(
-              ctemprefnode.create_offset(temp2,0),
+              ctemprefnode.create(temp2),
               cordconstnode.create
                  (paracount,s32inttype,true)));
           { create call to fpc_dynarr_setlength }

compiler/pgenutil.pas

@@ -51,6 +51,9 @@ uses
     function resolve_generic_dummysym(const name:tidstring):tsym;
     function could_be_generic(const name:tidstring):boolean;inline;
 
+    procedure generate_specialization_procs;
+    procedure maybe_add_pending_specialization(def:tdef);
+
     procedure specialization_init(genericdef:tdef;var state:tspecializationstate);
     procedure specialization_done(var state:tspecializationstate);
 
@@ -70,7 +73,7 @@ uses
   node,nobj,nmem,
   { parser }
   scanner,
-  pbase,pexpr,pdecsub,ptype;
+  pbase,pexpr,pdecsub,ptype,psub;
 
 
     procedure maybe_add_waiting_unit(tt:tdef);
@@ -701,6 +704,7 @@ uses
         item : tobject;
         hintsprocessed : boolean;
         pd : tprocdef;
+        pdflags : tpdflags;
       begin
         if not assigned(context) then
           internalerror(2015052203);
@@ -995,6 +999,14 @@ uses
                     end;
                   procdef:
                     begin
+                      pdflags:=[pd_body,pd_implemen];
+                      if genericdef.owner.symtabletype=objectsymtable then
+                        include(pdflags,pd_object)
+                      else if genericdef.owner.symtabletype=recordsymtable then
+                        include(pdflags,pd_record);
+                      parse_proc_directives(pd,pdflags);
+                      while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do
+                        consume(_SEMICOLON);
                       handle_calling_convention(tprocdef(result),hcc_all);
                       proc_add_definition(tprocdef(result));
                       { for partial specializations we implicitely declare the routine as
@@ -1060,6 +1072,10 @@ uses
             tempst.free;
 
             specialization_done(state);
+
+            { procdefs are only added once we know which overload we use }
+            if result.typ<>procdef then
+              current_module.pendingspecializations.add(result.typename,result);
           end;
 
         generictypelist.free;
@@ -1494,4 +1510,157 @@ uses
       fillchar(state, sizeof(state), 0);
     end;
 
+
+{****************************************************************************
+                      SPECIALIZATION BODY GENERATION
+****************************************************************************}
+
+
+    procedure process_procdef(def:tprocdef;hmodule:tmodule);
+      var
+        oldcurrent_filepos : tfileposinfo;
+      begin
+        if assigned(def.genericdef) and
+            (def.genericdef.typ=procdef) and
+            assigned(tprocdef(def.genericdef).generictokenbuf) then
+          begin
+            if not assigned(tprocdef(def.genericdef).generictokenbuf) then
+              internalerror(2015061902);
+            oldcurrent_filepos:=current_filepos;
+            current_filepos:=tprocdef(def.genericdef).fileinfo;
+            { use the index the module got from the current compilation process }
+            current_filepos.moduleindex:=hmodule.unit_index;
+            current_tokenpos:=current_filepos;
+            current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf);
+            read_proc_body(def);
+            current_filepos:=oldcurrent_filepos;
+          end
+        { synthetic routines will be implemented afterwards }
+        else if def.synthetickind=tsk_none then
+          MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false));
+      end;
+
+
+    function process_abstractrecorddef(def:tabstractrecorddef):boolean;
+      var
+        i  : longint;
+        hp : tdef;
+        hmodule : tmodule;
+      begin
+        result:=true;
+        hmodule:=find_module_from_symtable(def.genericdef.owner);
+        if hmodule=nil then
+          internalerror(201202041);
+        for i:=0 to def.symtable.DefList.Count-1 do
+          begin
+            hp:=tdef(def.symtable.DefList[i]);
+            if hp.typ=procdef then
+             begin
+               { only generate the code if we need a body }
+               if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
+                 continue;
+               { and the body is available already (which is implicitely the
+                 case if the generic routine is part of another unit) }
+               if (hmodule=current_module) and tprocdef(tprocdef(hp).genericdef).forwarddef then
+                 begin
+                   result:=false;
+                   continue;
+                 end;
+               process_procdef(tprocdef(hp),hmodule);
+             end
+           else
+             if hp.typ in [objectdef,recorddef] then
+               { generate code for subtypes as well }
+               result:=process_abstractrecorddef(tabstractrecorddef(hp)) and result;
+         end;
+      end;
+
+
+    procedure generate_specialization_procs;
+      var
+        i : longint;
+        list,
+        readdlist : tfpobjectlist;
+        def : tstoreddef;
+        state : tspecializationstate;
+        hmodule : tmodule;
+      begin
+        { first copy all entries and then work with that list to ensure that
+          we don't get an infinite recursion }
+        list:=tfpobjectlist.create(false);
+        readdlist:=tfpobjectlist.create(false);
+
+        for i:=0 to current_module.pendingspecializations.Count-1 do
+          list.add(current_module.pendingspecializations.Items[i]);
+
+        current_module.pendingspecializations.clear;
+
+        for i:=0 to list.count-1 do
+          begin
+            def:=tstoreddef(list[i]);
+            if not tstoreddef(def).is_specialization then
+              continue;
+            case def.typ of
+              procdef:
+                begin
+                  { the use of forwarddef should not backfire as the
+                    specialization always belongs to the current module }
+                  if not tprocdef(def).forwarddef then
+                    continue;
+                  if not assigned(def.genericdef) then
+                    internalerror(2015061903);
+                  hmodule:=find_module_from_symtable(def.genericdef.owner);
+                  if hmodule=nil then
+                    internalerror(2015061904);
+                  { we need to check for a forward declaration only if the
+                    generic was declared in the same unit (otherwise there
+                    should be one) }
+                  if (hmodule=current_module) and tprocdef(def.genericdef).forwarddef then
+                    begin
+                      readdlist.add(def);
+                      continue;
+                    end;
+
+                  specialization_init(tstoreddef(def).genericdef,state);
+
+                  process_procdef(tprocdef(def),hmodule);
+
+                  specialization_done(state);
+                end;
+              recorddef,
+              objectdef:
+                begin
+                  specialization_init(tstoreddef(def).genericdef,state);
+
+                  if not process_abstractrecorddef(tabstractrecorddef(def)) then
+                    readdlist.add(def);
+
+                  specialization_done(state);
+                end;
+            end;
+          end;
+
+        { add those defs back to the pending list for which we don't yet have
+          all method bodies }
+        for i:=0 to readdlist.count-1 do
+          current_module.pendingspecializations.add(tstoreddef(readdlist[i]).typename,readdlist[i]);
+
+        readdlist.free;
+        list.free;
+      end;
+
+
+    procedure maybe_add_pending_specialization(def:tdef);
+      var
+        hmodule : tmodule;
+        st : tsymtable;
+      begin
+        st:=def.owner;
+        while st.symtabletype in [localsymtable] do
+          st:=st.defowner.owner;
+        hmodule:=find_module_from_symtable(st);
+        if tstoreddef(def).is_specialization and (hmodule=current_module) then
+          current_module.pendingspecializations.add(def.typename,def);
+      end;
+
 end.

compiler/pkgutil.pas

@@ -639,8 +639,7 @@ implementation
       module:=tmodule(loaded_units.first);
       while assigned(module) do
         begin
-          //if not assigned(module.package) then
-          if (uf_in_library and module.flags)=0 then
+          if not assigned(module.package) then
             processimportedsyms(module.unitimportsyms);
           module:=tmodule(module.next);
         end;

compiler/pmodules.pas

@@ -47,7 +47,7 @@ implementation
        objcgutl,
        pkgutil,
        wpobase,
-       scanner,pbase,pexpr,psystem,psub,pdecsub,ncgvmt,ncgrtti,
+       scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,ncgvmt,ncgrtti,
        cpuinfo;
 
 

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 182;
+  CurrentPPUVersion = 183;
 
   ppubufsize   = 16384;
 

compiler/psub.pas

@@ -85,9 +85,10 @@ interface
       true) }
     procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;isgeneric:boolean);
 
-    procedure import_external_proc(pd:tprocdef);
+    { parses only the body of a non nested routine; needs a correctly setup pd }
+    procedure read_proc_body(pd:tprocdef);inline;
 
-    procedure generate_specialization_procs;
+    procedure import_external_proc(pd:tprocdef);
 
 
 implementation
@@ -756,6 +757,7 @@ implementation
                       begin
                         include(tocode.flags,nf_block_with_exit);
                         addstatement(newstatement,final_asmnode);
+                        cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement);
                         final_used:=true;
                       end;
 
@@ -875,6 +877,7 @@ implementation
         addstatement(newstatement,loadpara_asmnode);
         addstatement(newstatement,stackcheck_asmnode);
         addstatement(newstatement,entry_asmnode);
+        cnodeutils.procdef_block_add_implicit_initialize_nodes(procdef,newstatement);
         addstatement(newstatement,init_asmnode);
         addstatement(newstatement,bodyentrycode);
 
@@ -896,6 +899,7 @@ implementation
             { Generate code that will be in the try...finally }
             finalcode:=internalstatements(codestatement);
             addstatement(codestatement,final_asmnode);
+            cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,codestatement);
             final_used:=true;
 
             current_filepos:=entrypos;
@@ -929,9 +933,12 @@ implementation
             if not is_constructor then
               begin
                 addstatement(newstatement,final_asmnode);
+                cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement);
                 final_used:=true;
               end;
           end;
+        if not final_used then
+          cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement);
         do_firstpass(newblock);
         code:=newblock;
         current_filepos:=oldfilepos;
@@ -2021,7 +2028,12 @@ implementation
         if not isnestedproc then
           begin
             if not(df_generic in current_procinfo.procdef.defoptions) then
-              tcgprocinfo(current_procinfo).generate_code_tree;
+              begin
+                { also generate the bodies for all previously done
+                  specializations so that we might inline them }
+                generate_specialization_procs;
+                tcgprocinfo(current_procinfo).generate_code_tree;
+              end;
           end;
 
         { reset _FAIL as _SELF normal }
@@ -2045,6 +2057,21 @@ implementation
       end;
 
 
+    procedure read_proc_body(pd:tprocdef);
+      var
+        old_module_procinfo : tobject;
+        old_current_procinfo : tprocinfo;
+      begin
+        old_current_procinfo:=current_procinfo;
+        old_module_procinfo:=current_module.procinfo;
+        current_procinfo:=nil;
+        current_module.procinfo:=nil;
+        read_proc_body(nil,pd);
+        current_procinfo:=old_current_procinfo;
+        current_module.procinfo:=old_module_procinfo;
+      end;
+
+
     procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;isgeneric:boolean);
       {
         Parses the procedure directives, then parses the procedure body, then
@@ -2492,131 +2519,4 @@ implementation
       end;
 
 
-{****************************************************************************
-                      SPECIALIZATION BODY GENERATION
-****************************************************************************}
-
-
-    procedure specialize_objectdefs(p:TObject;arg:pointer);
-      var
-        specobj : tabstractrecorddef;
-        state : tspecializationstate;
-
-        procedure process_procdef(def:tprocdef;hmodule:tmodule);
-          var
-            oldcurrent_filepos : tfileposinfo;
-          begin
-            if assigned(def.genericdef) and
-                (def.genericdef.typ=procdef) and
-                assigned(tprocdef(def.genericdef).generictokenbuf) then
-              begin
-                if not assigned(tprocdef(def.genericdef).generictokenbuf) then
-                  internalerror(2015061902);
-                oldcurrent_filepos:=current_filepos;
-                current_filepos:=tprocdef(def.genericdef).fileinfo;
-                { use the index the module got from the current compilation process }
-                current_filepos.moduleindex:=hmodule.unit_index;
-                current_tokenpos:=current_filepos;
-                current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf);
-                read_proc_body(nil,def);
-                current_filepos:=oldcurrent_filepos;
-              end
-            { synthetic routines will be implemented afterwards }
-            else if def.synthetickind=tsk_none then
-              MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false));
-          end;
-
-      procedure process_abstractrecorddef(def:tabstractrecorddef);
-        var
-          i  : longint;
-          hp : tdef;
-          hmodule : tmodule;
-        begin
-          hmodule:=find_module_from_symtable(def.genericdef.owner);
-          if hmodule=nil then
-            internalerror(201202041);
-          for i:=0 to def.symtable.DefList.Count-1 do
-            begin
-              hp:=tdef(def.symtable.DefList[i]);
-              if hp.typ=procdef then
-               begin
-                 { only generate the code if we need a body }
-                 if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
-                   continue;
-                 process_procdef(tprocdef(hp),hmodule);
-               end
-             else
-               if hp.typ in [objectdef,recorddef] then
-                 { generate code for subtypes as well }
-                 process_abstractrecorddef(tabstractrecorddef(hp));
-           end;
-        end;
-
-      procedure process_procsym(procsym:tprocsym);
-        var
-          i : longint;
-          pd : tprocdef;
-          state : tspecializationstate;
-          hmodule : tmodule;
-        begin
-          for i:=0 to procsym.procdeflist.count-1 do
-            begin
-              pd:=tprocdef(procsym.procdeflist[i]);
-              if not pd.is_specialization then
-                continue;
-              if not pd.forwarddef then
-                continue;
-              if not assigned(pd.genericdef) then
-                internalerror(2015061903);
-              hmodule:=find_module_from_symtable(pd.genericdef.owner);
-              if hmodule=nil then
-                internalerror(2015061904);
-
-              specialization_init(pd.genericdef,state);
-
-              process_procdef(pd,hmodule);
-
-              specialization_done(state);
-            end;
-        end;
-
-      begin
-        if not((tsym(p).typ=typesym) and
-               (ttypesym(p).typedef.typesym=tsym(p)) and
-               (ttypesym(p).typedef.typ in [objectdef,recorddef])
-              ) and
-            not (tsym(p).typ=procsym) then
-          exit;
-
-        if tsym(p).typ=procsym then
-          process_procsym(tprocsym(p))
-        else
-          if df_specialization in ttypesym(p).typedef.defoptions then
-            begin
-              { Setup symtablestack a definition time }
-              specobj:=tabstractrecorddef(ttypesym(p).typedef);
-
-              if not (is_class_or_object(specobj) or is_record(specobj) or is_javaclass(specobj)) then
-                exit;
-
-              specialization_init(specobj.genericdef,state);
-
-              { procedure definitions for classes or objects }
-              process_abstractrecorddef(specobj);
-
-              specialization_done(state);
-            end
-          else
-            tabstractrecorddef(ttypesym(p).typedef).symtable.symlist.whileeachcall(@specialize_objectdefs,nil);
-      end;
-
-
-    procedure generate_specialization_procs;
-      begin
-        if assigned(current_module.globalsymtable) then
-          current_module.globalsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
-        if assigned(current_module.localsymtable) then
-          current_module.localsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil);
-      end;
-
 end.

compiler/psystem.pas

@@ -243,6 +243,9 @@ implementation
         bool16type:=corddef.create(bool16bit,low(int64),high(int64),true);
         bool32type:=corddef.create(bool32bit,low(int64),high(int64),true);
         bool64type:=corddef.create(bool64bit,low(int64),high(int64),true);
+{$ifdef llvm}
+        llvmbool1type:=corddef.create(pasbool8,0,1,true);
+{$endif llvm}
         cansichartype:=corddef.create(uchar,0,255,true);
         cwidechartype:=corddef.create(uwidechar,0,65535,true);
         cshortstringtype:=cstringdef.createshort(255,true);
@@ -413,6 +416,9 @@ implementation
         addtype('WordBool',bool16type);
         addtype('LongBool',bool32type);
         addtype('QWordBool',bool64type);
+{$ifdef llvm}
+        addtype('LLVMBool1',llvmbool1type);
+{$endif llvm}
         addtype('Byte',u8inttype);
         addtype('ShortInt',s8inttype);
         addtype('Word',u16inttype);
@@ -459,6 +465,9 @@ implementation
         addtype('$wordbool',bool16type);
         addtype('$longbool',bool32type);
         addtype('$qwordbool',bool64type);
+{$ifdef llvm}
+        addtype('$llvmbool1',llvmbool1type);
+{$endif llvm}
         addtype('$char_pointer',charpointertype);
         addtype('$widechar_pointer',widecharpointertype);
         addtype('$parentfp_void_pointer',parentfpvoidpointertype);
@@ -621,6 +630,9 @@ implementation
         loadtype('longint_farpointer',longintfarpointertype);
   {$endif i8086}
 {$endif x86}
+{$ifdef llvm}
+        loadtype('llvmbool1',llvmbool1type);
+{$endif llvm}
         loadtype('file',cfiletype);
         if not(target_info.system in systems_managed_vm) then
           begin

compiler/ptconst.pas

@@ -135,13 +135,16 @@ implementation
             current_asmdata.asmlists[al_const].concatlist(datalist);
             { the (empty) lists themselves are freed by tcbuilder }
 
-            { add indirect symbol }
-            { ToDo: do we also need this for the else part? }
-            new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment));
-            symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA);
-            list.concat(Tai_symbol.Create_Global(symind,0));
-            list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0));
-            list.concat(tai_symbol_end.Create(symind));
+            if (tf_supports_packages in target_info.flags) then
+              begin
+                { add indirect symbol }
+                { ToDo: do we also need this for the else part? }
+                new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment));
+                symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA);
+                list.concat(Tai_symbol.Create_Global(symind,0));
+                list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0));
+                list.concat(tai_symbol_end.Create(symind));
+              end;
           end
         else
           begin

compiler/scanner.pas

@@ -177,6 +177,7 @@ interface
           procedure recordtoken;
           procedure startrecordtokens(buf:tdynamicarray);
           procedure stoprecordtokens;
+          function is_recording_tokens:boolean;
           procedure replaytoken;
           procedure startreplaytokens(buf:tdynamicarray);
           { bit length asizeint is target depend }
@@ -2800,6 +2801,11 @@ type
         recordtokenbuf:=nil;
       end;
 
+    function tscannerfile.is_recording_tokens: boolean;
+      begin
+        result:=assigned(recordtokenbuf);
+      end;
+
 
     procedure tscannerfile.writetoken(t : ttoken);
       var

compiler/symdef.pas

@@ -1029,6 +1029,9 @@ interface
        bool16type,
        bool32type,
        bool64type,                { implement me }
+{$ifdef llvm}
+       llvmbool1type,             { LLVM i1 type }
+{$endif llvm}
        u8inttype,                 { 8-Bit unsigned integer }
        s8inttype,                 { 8-Bit signed integer }
        u16inttype,                { 16-Bit unsigned integer }
@@ -5750,7 +5753,7 @@ implementation
            assigned(returndef) and
            not(is_void(returndef)) then
           s:=s+':'+returndef.GetTypeName;
-        if owner.symtabletype=localsymtable then
+        if assigned(owner) and (owner.symtabletype=localsymtable) then
           s:=s+' is nested'
         else if po_is_block in procoptions then
           s:=s+' is block';

compiler/systems.inc

@@ -222,6 +222,7 @@
              ,as_llvm
              ,as_clang
              ,as_solaris_as
+             ,as_m68k_vasm
        );
 
        tlink = (ld_none,

compiler/systems.pas

@@ -137,6 +137,7 @@ interface
             tf_pic_default,
             { the os does some kind of stack checking and it can be converted into a rte 202 }
             tf_no_generic_stackcheck,
+            tf_emit_stklen,                     // Means that the compiler should emit a _stklen variable with the stack size, even if tf_no_generic_stackcheck is specified
             tf_has_winlike_resources,
             tf_safecall_clearstack,             // With this flag set, after safecall calls the caller cleans up the stack
             tf_safecall_exceptions,             // Exceptions in safecall calls are not raised, but passed to the caller as an ordinal (hresult) in the function result.

compiler/systems/i_amiga.pas

@@ -34,7 +34,7 @@ unit i_amiga;
             system       : system_m68k_Amiga;
             name         : 'Commodore Amiga';
             shortname    : 'amiga';
-            flags        : [tf_files_case_aware,tf_has_winlike_resources];
+            flags        : [tf_files_case_aware,tf_requires_proper_alignment,tf_has_winlike_resources];
             cpu          : cpu_m68k;
             unit_env     : 'AMIGAUNITS';
             extradefines : 'HASAMIGA;AMIGA68K';
@@ -97,7 +97,7 @@ unit i_amiga;
             system       : system_powerpc_Amiga;
             name         : 'AmigaOS for PowerPC';
             shortname    : 'amiga';
-            flags        : [tf_files_case_aware,tf_has_winlike_resources];
+            flags        : [tf_files_case_aware,tf_requires_proper_alignment,tf_has_winlike_resources];
             cpu          : cpu_powerpc;
             unit_env     : 'AMIGAUNITS';
             extradefines : 'PPC603;HASAMIGA;AMIGAOS4';

compiler/systems/i_morph.pas

@@ -34,7 +34,7 @@ unit i_morph;
             system       : system_powerpc_MorphOS;
             name         : 'MorphOS';
             shortname    : 'MorphOS';
-            flags        : [tf_files_case_aware,tf_smartlink_library,tf_has_winlike_resources];
+            flags        : [tf_files_case_aware,tf_requires_proper_alignment,tf_smartlink_library,tf_has_winlike_resources];
             cpu          : cpu_powerpc;
             unit_env     : 'MORPHOSUNITS';
             extradefines : 'HASAMIGA';

compiler/systems/i_msdos.pas

@@ -42,7 +42,8 @@ unit i_msdos;
             name         : 'MS-DOS 16-bit real mode';
             shortname    : 'MSDOS';
             flags        : [tf_use_8_3,tf_smartlink_library,
-                            tf_no_objectfiles_when_smartlinking,tf_cld];
+                            tf_no_objectfiles_when_smartlinking,tf_cld,
+                            tf_no_generic_stackcheck,tf_emit_stklen];
             cpu          : cpu_i8086;
             unit_env     : 'MSDOSUNITS';
             extradefines : '';

compiler/systems/i_win16.pas

@@ -43,6 +43,7 @@ unit i_win16;
             shortname    : 'Win16';
             flags        : [tf_use_8_3,tf_smartlink_library,
                             tf_no_objectfiles_when_smartlinking,tf_cld,
+                            tf_no_generic_stackcheck,tf_emit_stklen,
                             tf_x86_far_procs_push_odd_bp];
             cpu          : cpu_i8086;
             unit_env     : 'WIN16UNITS';

compiler/x86/cgx86.pas

@@ -3067,7 +3067,14 @@ unit cgx86;
                 if current_procinfo.framepointer=NR_STACK_POINTER_REG then
                   current_asmdata.asmcfi.cfa_def_cfa_offset(list,localsize+sizeof(pint));
                 current_procinfo.final_localsize:=localsize;
-              end;
+              end
+{$ifdef i8086}
+            else
+              { on i8086 we always call g_stackpointer_alloc, even with a zero size,
+                because it will generate code for stack checking, if stack checking is on }
+              g_stackpointer_alloc(list,0)
+{$endif i8086}
+              ;
 
 {$ifdef i8086}
               { win16 exported proc prologue follow-up (see the huge comment above for details) }

compiler/x86/nx86inl.pas

@@ -330,7 +330,7 @@ implementation
            begin
              secondpass(left);
              if left.location.loc<>LOC_MMREGISTER then
-               hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
+               hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,UseAVX);
              if UseAVX then
                begin
                  location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef));
@@ -377,24 +377,24 @@ implementation
          if use_vectorfpu(left.resultdef) then
            begin
              secondpass(left);
-             hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
+             hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
              location_reset(location,LOC_REGISTER,OS_S64);
              location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_S64);
              if UseAVX then
                case left.location.size of
                  OS_F32:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSS2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSS2SI,S_NO,left.location.register,location.register));
                  OS_F64:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSD2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSD2SI,S_NO,left.location.register,location.register));
                  else
                    internalerror(2007031402);
                end
              else
                case left.location.size of
                  OS_F32:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSS2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSS2SI,S_NO,left.location.register,location.register));
                  OS_F64:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSD2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSD2SI,S_NO,left.location.register,location.register));
                  else
                    internalerror(2007031402);
                end;
@@ -421,24 +421,24 @@ implementation
            not((left.location.loc=LOC_FPUREGISTER) and (current_settings.fputype>=fpu_sse3)) then
            begin
              secondpass(left);
-             hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false);
+             hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
              location_reset(location,LOC_REGISTER,OS_S64);
              location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_S64);
              if UseAVX then
                case left.location.size of
                  OS_F32:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSS2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSS2SI,S_NO,left.location.register,location.register));
                  OS_F64:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSD2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSD2SI,S_NO,left.location.register,location.register));
                  else
                    internalerror(2007031401);
                end
              else
                case left.location.size of
                  OS_F32:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSS2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSS2SI,S_NO,left.location.register,location.register));
                  OS_F64:
-                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSD2SI,S_Q,left.location.register,location.register));
+                   current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSD2SI,S_NO,left.location.register,location.register));
                  else
                    internalerror(2007031401);
                end;

compiler/x86/nx86set.pas

@@ -112,6 +112,8 @@ implementation
              { case expr greater than max_ => goto elselabel }
              cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opcgsize,OC_A,aint(max_)-aint(min_),hregister,elselabel);
              min_:=0;
+             { do not sign extend when we load the index register, as we applied an offset above }
+             opcgsize:=tcgsize2unsigned[opcgsize];
           end;
         current_asmdata.getglobaldatalabel(table);
         { make it a 32bit register }

compiler/x86_64/nx64set.pas

@@ -112,7 +112,10 @@ implementation
              { case expr greater than max_ => goto elselabel }
              cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opcgsize,OC_A,aint(max_)-aint(min_),hregister,elselabel);
              min_:=0;
+             { do not sign extend when we load the index register, as we applied an offset above }
+             opcgsize:=tcgsize2unsigned[opcgsize];
           end;
+
         { local label in order to avoid using GOT }
         current_asmdata.getlabel(tablelabel,alt_data);
         indexreg:=cg.makeregsize(current_asmdata.CurrAsmList,hregister,OS_ADDR);

packages/fcl-base/fpmake.pp

@@ -124,6 +124,8 @@ begin
       end;
     T:=P.Targets.addUnit('advancedipc.pp');
       T.ResourceStrings:=true;
+    T:=P.Targets.addUnit('advancedsingleinstance.pp');
+      T.ResourceStrings:=true;	  
     // Additional sources
     P.Sources.AddSrcFiles('src/win/fclel.*', P.Directory);
     // Install windows resources

packages/fcl-base/src/advancedipc.pp

@@ -168,43 +168,6 @@ type
 
   EICPException = class(Exception);
 
-  TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: Integer; MsgData: TStream) of object;
-
-  TAdvancedSingleInstance = class(TBaseSingleInstance)
-  private
-    FGlobal: Boolean;
-    FID: string;
-    FServer: TIPCServer;
-    FClient: TIPCClient;
-    FOnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage;
-    function GetIsClient: Boolean; override;
-    function GetIsServer: Boolean; override;
-    function GetStartResult: TSingleInstanceStart; override;
-    procedure SetGlobal(const aGlobal: Boolean);
-    procedure SetID(const aID: string);
-  protected
-    procedure DoServerReceivedCustomRequest(const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
-  public
-    constructor Create(aOwner: TComponent); override;
-  public
-    function Start: TSingleInstanceStart; override;
-    procedure Stop; override;
-
-    procedure ServerCheckMessages; override;
-    procedure ClientPostParams; override;
-  public
-    function ClientPostCustomRequest(const aMsgType: Integer; const aStream: TStream): Integer;
-    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream): Boolean; overload;
-    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
-    procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: Integer; const aStream: TStream);
-    function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: Integer): Boolean;
-  public
-    property ID: string read FID write SetID;
-    property Global: Boolean read FGlobal write SetGlobal;
-
-    property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
-  end;
-
 resourcestring
   SErrInvalidServerID = 'Invalid server ID "%s". Please use only alphanumerical characters and underlines.';
   SErrSetGlobalActive = 'You cannot change the global property when the server is active.';
@@ -809,284 +772,8 @@ begin
   FActive := False;
 end;
 
-Resourcestring
-  SErrSetSingleInstanceIDStarted = 'You cannot change the single instance ID when it''s been started.';
-  SErrSetSingleInstanceGlobalStarted = 'You cannot change the single instance global property when it''s been started.';
-  SErrStartSingleInstanceStarted = 'You cannot start single instance when it''s been already started.';
-  SErrSingleInstanceStartResultNotAvailable = 'Single instance hasn''t been started yet.';
-  SErrSingleInstanceNotClient = 'Current instance is not a client.';
-  SErrSingleInstanceNotServer = 'Current instance is not a server.';
-
-Const
-  MSGTYPE_CHECK = -1;
-  MSGTYPE_CHECKRESPONSE = -2;
-  MSGTYPE_PARAMS = -3;
-  MSGTYPE_WAITFORINSTANCES = -4;
-
-{ TAdvancedSingleInstance }
-
-constructor TAdvancedSingleInstance.Create(aOwner: TComponent);
-var
-  xID: RawByteString;
-  I: Integer;
-begin
-  inherited Create(aOwner);
-
-  xID := 'SI_'+ExtractFileName(ParamStr(0));
-  for I := 1 to Length(xID) do
-    case xID[I] of
-      'a'..'z', 'A'..'Z', '0'..'9', '_': begin end;
-    else
-      xID[I] := '_';
-    end;
-  ID := xID;
-end;
-
-function TAdvancedSingleInstance.ClientPeekCustomResponse(
-  const aStream: TStream; out outMsgType: Integer): Boolean;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.PeekResponse(aStream, outMsgType, TimeOutMessages);
-end;
-
-function TAdvancedSingleInstance.ClientPostCustomRequest(
-  const aMsgType: Integer; const aStream: TStream): Integer;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.PostRequest(aMsgType, aStream);
-end;
-
-procedure TAdvancedSingleInstance.ClientPostParams;
-var
-  xSL: TStringList;
-  xStringStream: TStringStream;
-  I: Integer;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  xSL := TStringList.Create;
-  try
-    for I := 0 to ParamCount do
-      xSL.Add(ParamStr(I));
-
-    xStringStream := TStringStream.Create(xSL.DelimitedText);
-    try
-      xStringStream.Position := 0;
-      FClient.PostRequest(MSGTYPE_PARAMS, xStringStream);
-    finally
-      xStringStream.Free;
-    end;
-  finally
-    xSL.Free;
-  end;
-end;
-
-function TAdvancedSingleInstance.ClientSendCustomRequest(
-  const aMsgType: Integer; const aStream: TStream): Boolean;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages);
-end;
-
-function TAdvancedSingleInstance.ClientSendCustomRequest(
-  const aMsgType: Integer; const aStream: TStream; out
-  outRequestID: Integer): Boolean;
-begin
-  if not Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
-
-  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages, outRequestID);
-end;
-
-procedure TAdvancedSingleInstance.DoServerReceivedCustomRequest(
-  const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
-begin
-  if Assigned(FOnServerReceivedCustomRequest) then
-    FOnServerReceivedCustomRequest(Self, aMsgID, aMsgType, aStream);
-end;
-
-function TAdvancedSingleInstance.GetIsClient: Boolean;
-begin
-  Result := Assigned(FClient);
-end;
-
-function TAdvancedSingleInstance.GetIsServer: Boolean;
-begin
-  Result := Assigned(FServer);
-end;
-
-function TAdvancedSingleInstance.GetStartResult: TSingleInstanceStart;
-begin
-  if not(Assigned(FServer) or Assigned(FClient)) then
-    raise ESingleInstance.Create(SErrSingleInstanceStartResultNotAvailable);
-
-  Result := inherited GetStartResult;
-end;
-
-procedure TAdvancedSingleInstance.ServerCheckMessages;
-var
-  xMsgID: Integer;
-  xMsgType: Integer;
-  xStream: TStream;
-  xStringStream: TStringStream;
-begin
-  if not Assigned(FServer) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
-
-  if not FServer.PeekRequest(xMsgID, xMsgType) then
-    Exit;
-
-  case xMsgType of
-    MSGTYPE_CHECK:
-    begin
-      FServer.DeleteRequest(xMsgID);
-      FServer.PostResponse(xMsgID, MSGTYPE_CHECKRESPONSE, nil);
-    end;
-    MSGTYPE_PARAMS:
-    begin
-      xStringStream := TStringStream.Create('');
-      try
-        FServer.ReadRequest(xMsgID, xStringStream);
-        DoServerReceivedParams(xStringStream.DataString);
-      finally
-        xStringStream.Free;
-      end;
-    end;
-    MSGTYPE_WAITFORINSTANCES:
-      FServer.DeleteRequest(xMsgID);
-  else
-    xStream := TMemoryStream.Create;
-    try
-      FServer.ReadRequest(xMsgID, xStream);
-      DoServerReceivedCustomRequest(xMsgID, xMsgType, xStream);
-    finally
-      xStream.Free;
-    end;
-  end;
-end;
-
-procedure TAdvancedSingleInstance.ServerPostCustomResponse(
-  const aRequestID: Integer; const aMsgType: Integer;
-  const aStream: TStream);
-begin
-  if not Assigned(FServer) then
-    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
-
-  FServer.PostResponse(aRequestID, aMsgType, aStream);
-end;
-
-procedure TAdvancedSingleInstance.SetGlobal(const aGlobal: Boolean);
-begin
-  if FGlobal = aGlobal then Exit;
-  if Assigned(FServer) or Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSetSingleInstanceGlobalStarted);
-  FGlobal := aGlobal;
-end;
-
-procedure TAdvancedSingleInstance.SetID(const aID: string);
-begin
-  if FID = aID then Exit;
-  if Assigned(FServer) or Assigned(FClient) then
-    raise ESingleInstance.Create(SErrSetSingleInstanceIDStarted);
-  FID := aID;
-end;
-
-function TAdvancedSingleInstance.Start: TSingleInstanceStart;
-  {$IFNDEF MSWINDOWS}
-  procedure UnixWorkaround(var bServerStarted: Boolean);
-  var
-    xWaitRequestID, xLastCount, xNewCount: Integer;
-    xClient: TIPCClient;
-  begin
-    //file locking workaround for UNIX systems -> the server can be started twice if 2 processes are started in parallel
-    //wait some time to see other clients
-    FServer.StopServer(False);
-    xClient := TIPCClient.Create(Self);
-    try
-      xClient.ServerID := FID;
-      xClient.Global := FGlobal;
-      xWaitRequestID := xClient.PostRequest(MSGTYPE_WAITFORINSTANCES, nil);
-      xLastCount := -1;
-      xNewCount := FServer.GetPendingRequestCount;
-      while xLastCount <> xNewCount do
-      begin
-        xLastCount := xNewCount;
-        Sleep(TimeOutWaitForInstances);
-        xNewCount := FServer.GetPendingRequestCount;
-      end;
-    finally
-      FreeAndNil(xClient);
-    end;
-
-    //find highest client that will be the server
-    if FServer.FindHighestPendingRequestId = xWaitRequestID then
-    begin
-      bServerStarted := FServer.StartServer(False);
-    end else
-    begin
-      //something went wrong, there are not-deleted waiting requests
-      //use random sleep as workaround and try to restart the server
-      Randomize;
-      Sleep(Random(($3F+PtrInt(GetProcessID)) and $3F));//limit to $3F (63)
-      bServerStarted := FServer.StartServer(False) and (FServer.GetPendingRequestCount > 0);
-    end;
-  end;
-  {$ENDIF}
-var
-  xStream: TStream;
-  xMsgType: Integer;
-  xServerStarted: Boolean;
-begin
-  if Assigned(FServer) or Assigned(FClient) then
-    raise ESingleInstance.Create(SErrStartSingleInstanceStarted);
-
-  FServer := TIPCServer.Create(Self);
-  FServer.ServerID := FID;
-  FServer.Global := FGlobal;
-  xServerStarted := FServer.StartServer(False);
-  if xServerStarted then
-  begin//this is single instance -> be server
-    Result := siServer;
-    {$IFNDEF MSWINDOWS}
-    UnixWorkaround(xServerStarted);
-    {$ENDIF}
-  end;
-  if not xServerStarted then
-  begin//instance found -> be client
-    FreeAndNil(FServer);
-    FClient := TIPCClient.Create(Self);
-    FClient.ServerID := FID;
-    FClient.Global := FGlobal;
-    FClient.PostRequest(MSGTYPE_CHECK, nil);
-    xStream := TMemoryStream.Create;
-    try
-      if FClient.PeekResponse(xStream, xMsgType, TimeOutMessages) then
-        Result := siClient
-      else
-        Result := siNotResponding;
-    finally
-      xStream.Free;
-    end;
-  end;
-  SetStartResult(Result);
-end;
-
-procedure TAdvancedSingleInstance.Stop;
-begin
-  FreeAndNil(FServer);
-  FreeAndNil(FClient);
-end;
-
 initialization
   InitCriticalSection(CreateUniqueRequestCritSec);
-  DefaultSingleInstanceClass:=TAdvancedSingleInstance;
 
 finalization
   DoneCriticalsection(CreateUniqueRequestCritSec);

packages/fcl-base/src/advancedsingleinstance.pas

@@ -0,0 +1,350 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2015 by Ondrej Pokorny
+
+    Unit implementing Single Instance functionality.
+
+    The order of message processing is not deterministic (if there are more
+    pending messages, the server won't process them in the order they have
+    been sent to the server.
+    SendRequest and PostRequest+PeekResponse sequences from 1 client are
+    blocking and processed in correct order.
+
+    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 AdvancedSingleInstance;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, AdvancedIPC, singleinstance;
+
+type
+
+  TSingleInstanceReceivedCustomMessage = procedure(Sender: TBaseSingleInstance; MsgID: Integer; MsgType: Integer; MsgData: TStream) of object;
+
+  TAdvancedSingleInstance = class(TBaseSingleInstance)
+  private
+    FGlobal: Boolean;
+    FID: string;
+    FServer: TIPCServer;
+    FClient: TIPCClient;
+    FOnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage;
+    procedure SetGlobal(const aGlobal: Boolean);
+    procedure SetID(const aID: string);
+  protected
+    procedure DoServerReceivedCustomRequest(const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
+    function GetIsClient: Boolean; override;
+    function GetIsServer: Boolean; override;
+    function GetStartResult: TSingleInstanceStart; override;
+  public
+    constructor Create(aOwner: TComponent); override;
+  public
+    function Start: TSingleInstanceStart; override;
+    procedure Stop; override;
+    procedure ServerCheckMessages; override;
+    procedure ClientPostParams; override;
+  public
+    function ClientPostCustomRequest(const aMsgType: Integer; const aStream: TStream): Integer;
+    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream): Boolean; overload;
+    function ClientSendCustomRequest(const aMsgType: Integer; const aStream: TStream; out outRequestID: Integer): Boolean; overload;
+    procedure ServerPostCustomResponse(const aRequestID: Integer; const aMsgType: Integer; const aStream: TStream);
+    function ClientPeekCustomResponse(const aStream: TStream; out outMsgType: Integer): Boolean;
+  public
+    property ID: string read FID write SetID;
+    property Global: Boolean read FGlobal write SetGlobal;
+
+    property OnServerReceivedCustomRequest: TSingleInstanceReceivedCustomMessage read FOnServerReceivedCustomRequest write FOnServerReceivedCustomRequest;
+  end;
+
+implementation
+
+Resourcestring
+  SErrSetSingleInstanceIDStarted = 'You cannot change the single instance ID when it''s been started.';
+  SErrSetSingleInstanceGlobalStarted = 'You cannot change the single instance global property when it''s been started.';
+  SErrStartSingleInstanceStarted = 'You cannot start single instance when it''s been already started.';
+  SErrSingleInstanceStartResultNotAvailable = 'Single instance hasn''t been started yet.';
+  SErrSingleInstanceNotClient = 'Current instance is not a client.';
+  SErrSingleInstanceNotServer = 'Current instance is not a server.';
+
+Const
+  MSGTYPE_CHECK = -1;
+  MSGTYPE_CHECKRESPONSE = -2;
+  MSGTYPE_PARAMS = -3;
+  MSGTYPE_WAITFORINSTANCES = -4;
+
+{ TAdvancedSingleInstance }
+
+constructor TAdvancedSingleInstance.Create(aOwner: TComponent);
+var
+  xID: RawByteString;
+  I: Integer;
+begin
+  inherited Create(aOwner);
+
+  xID := 'SI_'+ExtractFileName(ParamStr(0));
+  for I := 1 to Length(xID) do
+    case xID[I] of
+      'a'..'z', 'A'..'Z', '0'..'9', '_': begin end;
+    else
+      xID[I] := '_';
+    end;
+  ID := xID;
+end;
+
+function TAdvancedSingleInstance.ClientPeekCustomResponse(
+  const aStream: TStream; out outMsgType: Integer): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.PeekResponse(aStream, outMsgType, TimeOutMessages);
+end;
+
+function TAdvancedSingleInstance.ClientPostCustomRequest(
+  const aMsgType: Integer; const aStream: TStream): Integer;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.PostRequest(aMsgType, aStream);
+end;
+
+procedure TAdvancedSingleInstance.ClientPostParams;
+var
+  xSL: TStringList;
+  xStringStream: TStringStream;
+  I: Integer;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  xSL := TStringList.Create;
+  try
+    for I := 0 to ParamCount do
+      xSL.Add(ParamStr(I));
+
+    xStringStream := TStringStream.Create(xSL.DelimitedText);
+    try
+      xStringStream.Position := 0;
+      FClient.PostRequest(MSGTYPE_PARAMS, xStringStream);
+    finally
+      xStringStream.Free;
+    end;
+  finally
+    xSL.Free;
+  end;
+end;
+
+function TAdvancedSingleInstance.ClientSendCustomRequest(
+  const aMsgType: Integer; const aStream: TStream): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages);
+end;
+
+function TAdvancedSingleInstance.ClientSendCustomRequest(
+  const aMsgType: Integer; const aStream: TStream; out
+  outRequestID: Integer): Boolean;
+begin
+  if not Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotClient);
+
+  Result := FClient.SendRequest(aMsgType, aStream, TimeOutMessages, outRequestID);
+end;
+
+procedure TAdvancedSingleInstance.DoServerReceivedCustomRequest(
+  const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
+begin
+  if Assigned(FOnServerReceivedCustomRequest) then
+    FOnServerReceivedCustomRequest(Self, aMsgID, aMsgType, aStream);
+end;
+
+function TAdvancedSingleInstance.GetIsClient: Boolean;
+begin
+  Result := Assigned(FClient);
+end;
+
+function TAdvancedSingleInstance.GetIsServer: Boolean;
+begin
+  Result := Assigned(FServer);
+end;
+
+function TAdvancedSingleInstance.GetStartResult: TSingleInstanceStart;
+begin
+  if not(Assigned(FServer) or Assigned(FClient)) then
+    raise ESingleInstance.Create(SErrSingleInstanceStartResultNotAvailable);
+
+  Result := inherited GetStartResult;
+end;
+
+procedure TAdvancedSingleInstance.ServerCheckMessages;
+var
+  xMsgID: Integer;
+  xMsgType: Integer;
+  xStream: TStream;
+  xStringStream: TStringStream;
+begin
+  if not Assigned(FServer) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
+
+  if not FServer.PeekRequest(xMsgID, xMsgType) then
+    Exit;
+
+  case xMsgType of
+    MSGTYPE_CHECK:
+    begin
+      FServer.DeleteRequest(xMsgID);
+      FServer.PostResponse(xMsgID, MSGTYPE_CHECKRESPONSE, nil);
+    end;
+    MSGTYPE_PARAMS:
+    begin
+      xStringStream := TStringStream.Create('');
+      try
+        FServer.ReadRequest(xMsgID, xStringStream);
+        DoServerReceivedParams(xStringStream.DataString);
+      finally
+        xStringStream.Free;
+      end;
+    end;
+    MSGTYPE_WAITFORINSTANCES:
+      FServer.DeleteRequest(xMsgID);
+  else
+    xStream := TMemoryStream.Create;
+    try
+      FServer.ReadRequest(xMsgID, xStream);
+      DoServerReceivedCustomRequest(xMsgID, xMsgType, xStream);
+    finally
+      xStream.Free;
+    end;
+  end;
+end;
+
+procedure TAdvancedSingleInstance.ServerPostCustomResponse(
+  const aRequestID: Integer; const aMsgType: Integer;
+  const aStream: TStream);
+begin
+  if not Assigned(FServer) then
+    raise ESingleInstance.Create(SErrSingleInstanceNotServer);
+
+  FServer.PostResponse(aRequestID, aMsgType, aStream);
+end;
+
+procedure TAdvancedSingleInstance.SetGlobal(const aGlobal: Boolean);
+begin
+  if FGlobal = aGlobal then Exit;
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSetSingleInstanceGlobalStarted);
+  FGlobal := aGlobal;
+end;
+
+procedure TAdvancedSingleInstance.SetID(const aID: string);
+begin
+  if FID = aID then Exit;
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrSetSingleInstanceIDStarted);
+  FID := aID;
+end;
+
+function TAdvancedSingleInstance.Start: TSingleInstanceStart;
+  {$IFNDEF MSWINDOWS}
+  procedure UnixWorkaround(var bServerStarted: Boolean);
+  var
+    xWaitRequestID, xLastCount, xNewCount: Integer;
+    xClient: TIPCClient;
+  begin
+    //file locking workaround for UNIX systems -> the server can be started twice if 2 processes are started in parallel
+    //wait some time to see other clients
+    FServer.StopServer(False);
+    xClient := TIPCClient.Create(Self);
+    try
+      xClient.ServerID := FID;
+      xClient.Global := FGlobal;
+      xWaitRequestID := xClient.PostRequest(MSGTYPE_WAITFORINSTANCES, nil);
+      xLastCount := -1;
+      xNewCount := FServer.GetPendingRequestCount;
+      while xLastCount <> xNewCount do
+      begin
+        xLastCount := xNewCount;
+        Sleep(TimeOutWaitForInstances);
+        xNewCount := FServer.GetPendingRequestCount;
+      end;
+    finally
+      FreeAndNil(xClient);
+    end;
+
+    //find highest client that will be the server
+    if FServer.FindHighestPendingRequestId = xWaitRequestID then
+    begin
+      bServerStarted := FServer.StartServer(False);
+    end else
+    begin
+      //something went wrong, there are not-deleted waiting requests
+      //use random sleep as workaround and try to restart the server
+      Randomize;
+      Sleep(Random(($3F+PtrInt(GetProcessID)) and $3F));//limit to $3F (63)
+      bServerStarted := FServer.StartServer(False) and (FServer.GetPendingRequestCount > 0);
+    end;
+  end;
+  {$ENDIF}
+var
+  xStream: TStream;
+  xMsgType: Integer;
+  xServerStarted: Boolean;
+begin
+  if Assigned(FServer) or Assigned(FClient) then
+    raise ESingleInstance.Create(SErrStartSingleInstanceStarted);
+
+  FServer := TIPCServer.Create(Self);
+  FServer.ServerID := FID;
+  FServer.Global := FGlobal;
+  xServerStarted := FServer.StartServer(False);
+  if xServerStarted then
+  begin//this is single instance -> be server
+    Result := siServer;
+    {$IFNDEF MSWINDOWS}
+    UnixWorkaround(xServerStarted);
+    {$ENDIF}
+  end;
+  if not xServerStarted then
+  begin//instance found -> be client
+    FreeAndNil(FServer);
+    FClient := TIPCClient.Create(Self);
+    FClient.ServerID := FID;
+    FClient.Global := FGlobal;
+    FClient.PostRequest(MSGTYPE_CHECK, nil);
+    xStream := TMemoryStream.Create;
+    try
+      if FClient.PeekResponse(xStream, xMsgType, TimeOutMessages) then
+        Result := siClient
+      else
+        Result := siNotResponding;
+    finally
+      xStream.Free;
+    end;
+  end;
+  SetStartResult(Result);
+end;
+
+procedure TAdvancedSingleInstance.Stop;
+begin
+  FreeAndNil(FServer);
+  FreeAndNil(FClient);
+end;
+
+initialization
+  DefaultSingleInstanceClass:=TAdvancedSingleInstance;
+
+end.
+

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);
@@ -597,7 +597,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 +623,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

packages/fcl-db/src/base/dsparams.inc

@@ -257,14 +257,17 @@ begin
         if p^='*' then // /* */ comment
         begin
           Result := True;
-          repeat
-            Inc(p);
+          Inc(p);
+          while p^ <> #0 do
+          begin
             if p^='*' then // possible end of comment
             begin
               Inc(p);
               if p^='/' then Break; // end of comment
-            end;
-          until p^=#0;
+            end
+            else
+              Inc(p);
+          end;
           if p^='/' then Inc(p); // skip final /
         end;
       end;

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -357,6 +357,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 +503,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;

packages/fcl-db/tests/testbasics.pas

@@ -145,6 +145,8 @@ begin
   // Bracketed comment
   AssertEquals(     'select * from table where id=/*comment :c*/$1-$2',
     Params.ParseSQL('select * from table where id=/*comment :c*/:a-:b', True, True, True, psPostgreSQL));
+  AssertEquals(     'select * from table where id=/*comment :c**/$1-$2',
+    Params.ParseSQL('select * from table where id=/*comment :c**/:a-:b', True, True, True, psPostgreSQL));
   // Consecutive comments, with quote in second comment
   AssertEquals(     '--c1'#10'--c'''#10'select '':a'' from table where id=$1',
     Params.ParseSQL('--c1'#10'--c'''#10'select '':a'' from table where id=:id', True, True, True, psPostgreSQL));

packages/fcl-db/tests/toolsunit.pas

@@ -526,8 +526,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 +546,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]);

packages/fcl-image/src/ftfont.pp

@@ -59,7 +59,7 @@ type
   end;
 
 var
-  FontMgr : TFontManager;
+  FontMgr : TFontManager = nil;
 
 procedure InitEngine;
 procedure DoneEngine;
@@ -78,8 +78,7 @@ end;
 
 procedure DoneEngine;
 begin
-  if assigned (FontMgr) then
-    FontMgr.Free;
+  FreeAndNil(FontMgr);
 end;
 
 constructor TFreeTypeFont.Create;

packages/fcl-net/src/ssockets.pp

@@ -18,7 +18,8 @@ unit ssockets;
 interface
 
 uses
- SysUtils, Classes, ctypes, sockets;
+// This must be here, to prevent it from overriding the sockets definitions... :/
+  SysUtils, Classes, ctypes, sockets;
 
 type
 
@@ -111,6 +112,7 @@ type
 
   TSocketServer = Class(TObject)
   Private
+    FIdleTimeOut: Cardinal;
     FOnAcceptError: TOnAcceptError;
     FOnIdle : TNotifyEvent;
     FNonBlocking : Boolean;
@@ -139,6 +141,7 @@ type
     Function  SockToStream (ASocket : Longint) : TSocketStream;Virtual;Abstract;
     Procedure Close; Virtual;
     Procedure Abort;
+    Function RunIdleLoop : Boolean;
     function GetConnection: TSocketStream; virtual; abstract;
     Function HandleAcceptError(E : ESocketError) : TAcceptErrorAction;
     Property Handler : TSocketHandler Read FHandler;
@@ -166,6 +169,9 @@ type
     Property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress;
     // -1 means no linger. Any value >=0 sets linger on.
     Property Linger: Integer Read GetLinger Write Setlinger;
+    // Accept Timeout in milliseconds.
+    // If Different from 0, then there will be an idle loop before accepting new connections, Calling OnIdle if no new connection appeared in the specified timeout.
+    Property AcceptIdleTimeOut : Cardinal Read FIdleTimeOut Write FIdleTimeout;
   end;
 
   { TInetServer }
@@ -239,7 +245,10 @@ Implementation
 
 uses
 {$ifdef unix}
-  BaseUnix, Unix,
+  BaseUnix,Unix,
+{$endif}
+{$ifdef windows}
+  winsock2, windows,
 {$endif}
   resolve;
 
@@ -296,7 +305,8 @@ end;
 
 function TSocketHandler.Shutdown(BiDirectional: Boolean): boolean;
 begin
-  CheckSocket
+  CheckSocket ;
+  Result:=False;
 end;
 
 function TSocketHandler.Recv(Const Buffer; Count: Integer): Integer;
@@ -445,20 +455,20 @@ begin
   Result:=FHandler.Send(Buffer,Count);
 end;
 
-function TSocketStream.GetLocalAddress: TSockAddr;
+function TSocketStream.GetLocalAddress: sockets.TSockAddr;
 var
   len: LongInt;
 begin
-  len := SizeOf(TSockAddr);
+  len := SizeOf(sockets.TSockAddr);
   if fpGetSockName(Handle, @Result, @len) <> 0 then
     FillChar(Result, SizeOf(Result), 0);
 end;
 
-function TSocketStream.GetRemoteAddress: TSockAddr;
+function TSocketStream.GetRemoteAddress: sockets.TSockAddr;
 var
   len: LongInt;
 begin
-  len := SizeOf(TSockAddr);
+  len := SizeOf(sockets.TSockAddr);
   if fpGetPeerName(Handle, @Result, @len) <> 0 then
     FillChar(Result, SizeOf(Result), 0);
 end;
@@ -499,7 +509,7 @@ end;
     TSocketServer
   ---------------------------------------------------------------------}
 
-Constructor TSocketServer.Create(ASocket : Longint; AHandler : TSocketHandler);
+constructor TSocketServer.Create(ASocket: Longint; AHandler: TSocketHandler);
 
 begin
   FSocket:=ASocket;
@@ -510,7 +520,7 @@ begin
   FHandler:=AHandler;
 end;
 
-Destructor TSocketServer.Destroy;
+destructor TSocketServer.Destroy;
 
 begin
   Close;
@@ -518,7 +528,7 @@ begin
   Inherited;
 end;
 
-Procedure TSocketServer.Close;
+procedure TSocketServer.Close;
 
 begin
   If FSocket<>-1 Then
@@ -542,7 +552,40 @@ begin
 {$endif}
 end;
 
-Procedure TSocketServer.Listen;
+function TSocketServer.RunIdleLoop: Boolean;
+
+// Run Accept idle loop. Return True if there is a new connection waiting
+{$if defined(unix) or defined(windows)}
+var
+  FDS: TFDSet;
+  TimeV: TTimeVal;
+{$endif}
+begin
+  Repeat
+    Result:=False;
+{$if defined(unix) or defined(windows)}
+    TimeV.tv_usec := (AcceptIdleTimeout mod 1000) * 1000;
+    TimeV.tv_sec := AcceptIdleTimeout div 1000;
+{$endif}
+{$ifdef unix}
+    FDS := Default(TFDSet);
+    fpFD_Zero(FDS);
+    fpFD_Set(FSocket, FDS);
+    Result := fpSelect(FSocket + 1, @FDS, @FDS, @FDS, @TimeV) > 0;
+{$else}
+{$ifdef windows}
+    FDS := Default(TFDSet);
+    FD_Zero(FDS);
+    FD_Set(FSocket, FDS);
+    Result := Select(FSocket + 1, @FDS, @FDS, @FDS, @TimeV) > 0;
+{$endif}
+{$endif}
+    If not Result then
+      DoOnIdle;
+  Until Result or (Not FAccepting);
+end;
+
+procedure TSocketServer.Listen;
 
 begin
   If Not FBound then
@@ -551,7 +594,7 @@ begin
     Raise ESocketError.Create(seListenFailed,[FSocket,SocketError]);
 end;
 
-function TSocketServer.GetSockopt(ALevel, AOptName: cint; Var optval;
+function TSocketServer.GetSockopt(ALevel, AOptName: cint; var optval;
   var optlen: tsocklen): Boolean;
 begin
   Result:=fpGetSockOpt(FSocket,ALevel,AOptName,@optval,@optlen)<>-1;
@@ -589,7 +632,7 @@ begin
     FOnAcceptError(Self,FSocket,E,Result);
 end;
 
-Procedure TSocketServer.StartAccepting;
+procedure TSocketServer.StartAccepting;
 
 Var
  NoConnections : Integer;
@@ -602,7 +645,10 @@ begin
   Repeat
     Repeat
       Try
-        Stream:=GetConnection;
+        If (AcceptIdleTimeOut=0) or RunIdleLoop then
+          Stream:=GetConnection
+        else
+          Stream:=Nil;
         if Assigned(Stream) then
           begin
           Inc (NoConnections);
@@ -633,7 +679,7 @@ begin
     Abort;
 end;
 
-Procedure TSocketServer.DoOnIdle;
+procedure TSocketServer.DoOnIdle;
 
 begin
   If Assigned(FOnIdle) then
@@ -689,14 +735,14 @@ begin
     Result:=l.l_linger;
 end;
 
-Procedure TSocketServer.DoConnect(ASocket : TSocketStream);
+procedure TSocketServer.DoConnect(ASocket: TSocketStream);
 
 begin
   If Assigned(FOnConnect) Then
     FOnConnect(Self,ASocket);
 end;
 
-Function TSocketServer.DoConnectQuery(ASocket : Longint) : Boolean;
+function TSocketServer.DoConnectQuery(ASocket: longint): Boolean;
 
 begin
   Result:=True;
@@ -704,7 +750,7 @@ begin
     FOnConnectQuery(Self,ASocket,Result);
 end;
 
-Procedure TSocketServer.SetNonBlocking;
+procedure TSocketServer.SetNonBlocking;
 
 begin
 {$ifdef Unix}
@@ -812,8 +858,11 @@ begin
 {$endif}
   if (Result<0) or Not (FAccepting and FHandler.Accept) then
     begin
-    CloseSocket(Result);
-    Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError])
+    If (Result>=0) then
+      CloseSocket(Result);
+    // Do not raise an error if we've stopped accepting.
+    if FAccepting then
+      Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError])
     end;
 end;
 

packages/fcl-pdf/examples/testfppdf.lpr

@@ -21,7 +21,8 @@ uses
   fpimage,
   fpreadjpeg,
   fppdf,
-  fpparsettf;
+  fpparsettf,
+  typinfo;
 
 type
 
@@ -42,6 +43,7 @@ type
     procedure   SimpleImage(D: TPDFDocument; APage: integer);
     procedure   SimpleShapes(D: TPDFDocument; APage: integer);
     procedure   SampleMatrixTransform(D: TPDFDocument; APage: integer);
+    procedure   SampleLandscape(D: TPDFDocument; APage: integer);
   protected
     procedure   DoRun; override;
   public
@@ -81,7 +83,7 @@ begin
 
   Result.StartDocument;
   S := Result.Sections.AddSection; // we always need at least one section
-  lPageCount := 6;
+  lPageCount := 7;
   if Fpg <> -1 then
     lPageCount := 1;
   for i := 1 to lPageCount do
@@ -426,6 +428,42 @@ begin
   OutputSample;
 end;
 
+procedure TPDFTestApp.SampleLandscape(D: TPDFDocument; APage: integer);
+var
+  P: TPDFPage;
+  FtTitle: integer;
+
+    function PaperTypeToString(AEnum: TPDFPaperType): string;
+    begin
+      result := GetEnumName(TypeInfo(TPDFPaperType), Ord(AEnum));
+    end;
+
+    function PixelsToMM(AValue: integer): integer;
+    begin
+      Result := Round((AValue / 72) * 25.4);
+    end;
+
+begin
+  P:=D.Pages[APage];
+  P.Orientation := ppoLandscape;
+
+  // create the fonts to be used (use one of the 14 Adobe PDF standard fonts)
+  FtTitle := D.AddFont('Helvetica', clBlack);
+
+  { Page title }
+  P.SetFont(FtTitle,23);
+  P.SetColor(clBlack);
+  P.WriteText(25, 20, 'Landscape Page');
+
+  P.SetFont(FtTitle, 12);
+  P.WriteText(100, 80, 'Page PaperType:');
+  P.WriteText(145, 80, PaperTypeToString(P.PaperType));
+
+  P.WriteText(100, 90, 'Page Size:');
+  P.WriteText(145, 90, Format('%d x %d  (pixels)', [P.Paper.W, P.Paper.H]));
+  P.WriteText(145, 95, Format('%d x %d  (mm)', [PixelsToMM(P.Paper.W), PixelsToMM(P.Paper.H)]));
+end;
+
 { TPDFTestApp }
 
 procedure TPDFTestApp.DoRun;
@@ -474,9 +512,9 @@ begin
   if HasOption('p', '') then
   begin
     Fpg := StrToInt(GetOptionValue('p', ''));
-    if (Fpg < 1) or (Fpg > 5) then
+    if (Fpg < 1) or (Fpg > 7) then
     begin
-      Writeln('Error in -p parameter. Valid range is 1-5.');
+      Writeln('Error in -p parameter. Valid range is 1-7.');
       Writeln('');
       Terminate;
       Exit;
@@ -500,6 +538,7 @@ begin
       SimpleLinesRaw(FDoc, 3);
       SimpleImage(FDoc, 4);
       SampleMatrixTransform(FDoc, 5);
+      SampleLandscape(FDoc, 6);
     end
     else
     begin
@@ -510,6 +549,7 @@ begin
         4:  SimpleLinesRaw(FDoc, 0);
         5:  SimpleImage(FDoc, 0);
         6:  SampleMatrixTransform(FDoc, 0);
+        7:  SampleLandscape(FDoc, 0);
       end;
     end;
 
@@ -526,8 +566,8 @@ procedure TPDFTestApp.WriteHelp;
 begin
   writeln('Usage:');
   writeln('    -h          Show this help.');
-  writeln('    -p <n>      Generate only one page. Valid range is 1-5.' + LineEnding +
-          '                If this option is not specified, then all 5 pages are' + LineEnding +
+  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('    -f <0|1>    Toggle embedded font compression. A value of 0' + LineEnding +
           '                disables compression. A value of 1 enables compression.');

packages/fcl-pdf/fpmake.pp

@@ -23,7 +23,7 @@ begin
     P.Email := '';
     P.Description := 'PDF generating and TTF file info library';
     P.NeedLibC:= false;
-    P.OSes:=P.OSes-[embedded,win16,msdos];
+    P.OSes:=P.OSes-[embedded,win16,msdos,nativent];
     P.Dependencies.Add('rtl-objpas');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-image');

packages/fcl-pdf/src/fppdf.pp

@@ -14,7 +14,7 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit fppdf;
+unit fpPDF;
 
 {$mode objfpc}{$H+}
 
@@ -1560,6 +1560,7 @@ begin
   if FOrientation=AValue then Exit;
   FOrientation:=AValue;
   CalcPaperSize;
+  AdjustMatrix;
 end;
 
 procedure TPDFPage.CalcPaperSize;
@@ -1590,6 +1591,7 @@ begin
   if FPaperType=AValue then Exit;
   FPaperType:=AValue;
   CalcPaperSize;
+  AdjustMatrix;
 end;
 
 procedure TPDFPage.AddTextToLookupLists(AText: UTF8String);
@@ -2113,6 +2115,11 @@ function TPDFImageItem.Equals(AImage: TFPCustomImage): boolean;
 var
   x, y: Integer;
 begin
+  if AImage = nil then
+  begin
+    Result := False;
+    exit;
+  end;
   Result := True;
   for x := 0 to Image.Width-1 do
     for y := 0 to Image.Height-1 do

packages/fcl-pdf/src/fpttf.pp

@@ -72,6 +72,8 @@ type
     FDPI: integer;
     procedure   SearchForFonts(const AFontPath: String);
     procedure   SetDPI(AValue: integer);
+    { Set any / or \ path delimiters to the OS specific delimiter }
+    procedure   FixPathDelimiters;
   protected
     function    GetCount: integer; virtual;
     function    GetItem(AIndex: Integer): TFPFontCacheItem; virtual;
@@ -322,6 +324,14 @@ begin
   FDPI := AValue;
 end;
 
+procedure TFPFontCacheList.FixPathDelimiters;
+var
+  i: integer;
+begin
+  for i := 0 to FSearchPath.Count-1 do
+    FSearchPath[i] := SetDirSeparators(FSearchPath[i]);
+end;
+
 function TFPFontCacheList.GetCount: integer;
 begin
   Result := FList.Count;
@@ -360,6 +370,7 @@ begin
   if FSearchPath.Count < 1 then
     raise ETTF.Create(rsNoSearchPathDefined);
 
+  FixPathDelimiters;
   for i := 0 to FSearchPath.Count-1 do
   begin
     lPath := FSearchPath[i];

packages/fcl-process/examples/checkipcserver.lpi

@@ -0,0 +1,60 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="IPC Client"/>
+      <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="checkipcserver.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="checkipcserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../units/$(TargetCPU)-$(TargetOS)"/>
+      <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>

packages/fcl-process/examples/checkipcserver.lpr

@@ -0,0 +1,55 @@
+program checkipcserver;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp, simpleipc
+  { you can add units after this };
+
+type
+
+  { TSimpleIPCClientApp }
+
+  TSimpleIPCClientApp = class(TCustomApplication)
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+
+{ TSimpleIPCClientApp }
+
+procedure TSimpleIPCClientApp.DoRun;
+var
+  IPCClient: TSimpleIPCClient;
+begin
+  IPCClient := TSimpleIPCClient.Create(nil);
+  IPCClient.ServerID:= 'ipc_test_crash';
+
+  if IPCClient.ServerRunning then
+    WriteLn('Server is runnning')
+  else
+    WriteLn('Server is NOT runnning');
+
+  IPCClient.Destroy;
+  Terminate;
+end;
+
+constructor TSimpleIPCClientApp.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+var
+  Application: TSimpleIPCClientApp;
+begin
+  Application:=TSimpleIPCClientApp.Create(nil);
+  Application.Title:='IPC Client';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-process/examples/ipcclient.pp

@@ -2,16 +2,32 @@
 {$h+}
 program ipcclient;
 
-uses simpleipc;
+uses sysutils,simpleipc;
+
+Var
+  I,Count : Integer;
+  DoStop : Boolean;
 
 begin
+  Count:=1;
   With TSimpleIPCClient.Create(Nil) do
     try
       ServerID:='ipcserver';
       If (ParamCount>0) then
-        ServerInstance:=Paramstr(1);
+        begin
+        DoStop:=(ParamStr(1)='-s') or (paramstr(1)='--stop');
+        if DoStop then
+          ServerInstance:=Paramstr(2)
+        else  
+          ServerInstance:=Paramstr(1);
+        if (Not DoStop) and (ParamCount>1) then
+          Count:=StrToIntDef(ParamStr(2),1);  
+        end;  
       Active:=True;
-      SendStringMessage('Testmessage from client');
+      if DoStop then
+        SendStringMessage('stop')
+      else  for I:=1 to Count do
+        SendStringMessage(Format('Testmessage %d from client',[i]));
       Active:=False;
     finally
       Free;

packages/fcl-process/examples/ipcserver.lpi

@@ -6,7 +6,6 @@
       <Flags>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
-        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
@@ -29,6 +28,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="-t"/>
       </local>
     </RunParams>
     <Units Count="1">
@@ -44,6 +44,8 @@
       <Filename Value="ipcserver"/>
     </Target>
     <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../units/$(TargetCPU)-$(TargetOS)"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>

packages/fcl-process/examples/ipcserver.pp

@@ -5,31 +5,79 @@ program ipcserver;
 {$APPTYPE CONSOLE}
 
 uses
+  {$ifdef unix}cthreads,{$endif}
   SysUtils,
+  Classes,
   simpleipc;
 
+Type
+  TApp = Class(TObject)  
+    Srv : TSimpleIPCServer;
+    DoStop : Boolean;
+    Procedure MessageQueued(Sender : TObject);
+    procedure Run;
+    Procedure PrintMessage;
+  end;
+
+Procedure TApp.PrintMessage;
+
+Var
+  S : String;
+ 
+begin
+  S:=Srv.StringMessage;
+  Writeln('Received message : ',S);
+  DoStop:=DoStop or (S='stop');
+end;
+
+Procedure TApp.MessageQueued(Sender : TObject);
+
+begin
+  Srv.ReadMessage;
+  PrintMessage;
+end;
+
+
+Procedure TApp.Run;
+  
 Var
-  Srv : TSimpleIPCServer;
   S : String;
+  Threaded : Boolean;
 
 begin
   Srv:=TSimpleIPCServer.Create(Nil);
   Try
+    S:= ParamStr(1);
+    Threaded:=(S='-t') or (S='--threaded');
     Srv.ServerID:='ipcserver';
     Srv.Global:=True;
-    Srv.StartServer;
-    Writeln('Server started. Listening for messages');
+    if Threaded then
+      Srv.OnMessageQueued:=@MessageQueued;
+    Srv.StartServer(Threaded);
+    
+    Writeln('Server started. Listening for messages. Send "stop" message to stop server.');
     Repeat
-      If Srv.PeekMessage(1,True) then
+      If Threaded then
         begin
-        S:=Srv.StringMessage;
-        Writeln('Received message : ',S);
+        Sleep(10);
+        CheckSynchronize;
         end
+      else if Srv.PeekMessage(10,True) then
+        PrintMessage
       else
         Sleep(10);
-    Until CompareText(S,'stop')=0;
+    Until DoStop;
   Finally
     Srv.Free;
   end;
+end;
+
+begin
+  With TApp.Create do
+    try
+      Run
+    finally
+      Free;
+    end;    
 end.
 

packages/fcl-process/examples/simpleipcserver.lpi

@@ -0,0 +1,59 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="IPC Server"/>
+      <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="simpleipcserver.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="simpleipcserver"/>
+    </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>

packages/fcl-process/examples/simpleipcserver.lpr

@@ -0,0 +1,81 @@
+program simpleipcserver;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  BaseUnix,
+  {$ENDIF}
+  {$IFDEF windows}
+  Windows,
+  {$ENDIF}
+  Classes, SysUtils, CustApp, simpleipc, Crt;
+
+type
+
+  { TSimpleIPCServerApp }
+
+  TSimpleIPCServerApp = class(TCustomApplication)
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+
+{ TSimpleIPCServerApp }
+
+procedure TSimpleIPCServerApp.DoRun;
+var
+  IPCServer: TSimpleIPCServer;
+  Key: Char;
+  NullObj: TObject;
+begin
+  IPCServer := TSimpleIPCServer.Create(nil);
+  IPCServer.ServerID:='ipc_test_crash';
+  IPCServer.Global:=True;
+  IPCServer.StartServer;
+  NullObj := nil;
+
+  WriteLn('Server started');
+  WriteLn('  Press e to finish with an exception');
+  WriteLn('  Press t to terminate through OS api - ', {$IFDEF UNIX}'Kill'{$ELSE}'TerminateProcess'{$ENDIF});
+  WriteLn('  Press any other key to finish normally');
+  Key := ReadKey;
+
+  case Key of
+    'e':
+      begin
+        NullObj.AfterConstruction;
+      end;
+    't':
+      begin
+        {$ifdef unix}
+        FpKill(FpGetpid, 9);
+        {$endif}
+        {$ifdef windows}
+        TerminateProcess(GetCurrentProcess, 0);
+        {$endif}
+      end;
+  end;
+
+  IPCServer.Active:=False;
+  WriteLn('Server stopped');
+  IPCServer.Destroy;
+  Terminate;
+end;
+
+constructor TSimpleIPCServerApp.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+var
+  Application: TSimpleIPCServerApp;
+begin
+  Application:=TSimpleIPCServerApp.Create(nil);
+  Application.Title:='IPC Server';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-process/src/os2/simpleipc.inc

@@ -164,19 +164,13 @@ end;
 
 
 procedure TPipeServerComm.ReadMessage;
+
 var
   Hdr: TMsgHeader;
+  
 begin
-  FStream.ReadBuffer (Hdr, SizeOf (Hdr));
-  Owner.FMsgType := Hdr.MsgType;
-  if Hdr.MsgLen > 0 then
-    begin
-      Owner.FMsgData.Size:=0;
-      Owner.FMsgData.Seek (0, soFromBeginning);
-      Owner.FMsgData.CopyFrom (FStream, Hdr.MsgLen);
-    end
-  else
-    Owner.FMsgData.Size := 0;
+  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
+  PushMessage(Hdr,FStream);
 end;
 
 function TPipeServerComm.GetInstanceID: string;

packages/fcl-process/src/simpleipc.pp

@@ -20,11 +20,12 @@ unit simpleipc;
 interface
 
 uses
-  Classes, SysUtils;
+  Contnrs, Classes, SysUtils;
 
 Const
   MsgVersion = 1;
-  
+  DefaultThreadTimeOut = 50;
+
   //Message types
   mtUnknown = 0;
   mtString = 1;
@@ -33,7 +34,6 @@ type
   TIPCMessageOverflowAction = (ipcmoaNone, ipcmoaDiscardOld, ipcmoaDiscardNew, ipcmoaError);
 
 var
-  // Currently implemented only for Windows platform!
   DefaultIPCMessageOverflowAction: TIPCMessageOverflowAction = ipcmoaNone;
   DefaultIPCMessageQueueLimit: Integer = 0;
 
@@ -49,6 +49,36 @@ Type
   TSimpleIPCServer = class;
   TSimpleIPCClient = class;
 
+  TIPCServerMsg = class
+  strict private
+    FStream: TStream;
+    FMsgType: TMessageType;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property Stream: TStream read FStream;
+    property MsgType: TMessageType read FMsgType write FMsgType;
+  end;
+
+  TIPCServerMsgQueue = class
+  strict private
+    FList: TFPObjectList;
+    FMaxCount: Integer;
+    FMaxAction: TIPCMessageOverflowAction;
+    function GetCount: Integer;
+    procedure DeleteAndFree(Index: Integer);
+    function PrepareToPush: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure Push(AItem: TIPCServerMsg);
+    function Pop: TIPCServerMsg;
+    property Count: Integer read GetCount;
+    property MaxCount: Integer read FMaxCount write FMaxCount;
+    property MaxAction: TIPCMessageOverflowAction read FMaxAction write FMaxAction;
+  end;
+
   { TIPCServerComm }
   
   TIPCServerComm = Class(TObject)
@@ -57,14 +87,16 @@ Type
   Protected  
     Function  GetInstanceID : String; virtual; abstract;
     Procedure DoError(const Msg : String; const Args : Array of const);
-    Procedure SetMsgType(AMsgType: TMessageType); 
-    Function MsgData : TStream;
+    Procedure PushMessage(Const Hdr : TMsgHeader; AStream : TStream);
+    Procedure PushMessage(Msg : TIPCServerMsg);
   Public
     Constructor Create(AOwner : TSimpleIPCServer); virtual;
     Property Owner : TSimpleIPCServer read FOwner;
     Procedure StartServer; virtual; Abstract;
     Procedure StopServer;virtual; Abstract;
+    // May push messages on the queue
     Function  PeekMessage(TimeOut : Integer) : Boolean;virtual; Abstract;
+    // Must put message on the queue.
     Procedure ReadMessage ;virtual; Abstract;
     Property InstanceID : String read GetInstanceID;
   end;
@@ -93,24 +125,46 @@ Type
 
   { TSimpleIPCServer }
 
+  TMessageQueueEvent = Procedure(Sender : TObject; Msg : TIPCServerMsg) of object;
+
   TSimpleIPCServer = Class(TSimpleIPC)
-  private
+  protected
+  Private
+    FOnMessageError: TMessageQueueEvent;
+    FOnMessageQueued: TNotifyEvent;
+    FQueue : TIPCServerMsgQueue;
     FGlobal: Boolean;
     FOnMessage: TNotifyEvent;
     FMsgType: TMessageType;
     FMsgData : TStream;
+    FThreadTimeOut: Integer;
+    FThread : TThread;
+    FLock : TRTLCriticalSection;
+    FErrMsg : TIPCServerMsg;
+    procedure DoMessageQueued;
+    procedure DoMessageError;
     function GetInstanceID: String;
+    function GetMaxAction: TIPCMessageOverflowAction;
+    function GetMaxQueue: Integer;
     function GetStringMessage: String;
     procedure SetGlobal(const AValue: Boolean);
+    procedure SetMaxAction(AValue: TIPCMessageOverflowAction);
+    procedure SetMaxQueue(AValue: Integer);
   Protected
     FIPCComm: TIPCServerComm;
+    procedure StartThread; virtual;
+    procedure StopThread; virtual;
     Function CommClass : TIPCServerCommClass; virtual;
+    Procedure PushMessage(Msg : TIPCServerMsg); virtual;
+    function PopMessage: Boolean; virtual;
     Procedure Activate; override;
     Procedure Deactivate; override;
+    Property Queue : TIPCServerMsgQueue Read FQueue;
+    Property Thread : TThread Read FThread;
   Public
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
-    Procedure StartServer;
+    Procedure StartServer(Threaded : Boolean = False);
     Procedure StopServer;
     Function PeekMessage(TimeOut : Integer; DoReadMessage : Boolean): Boolean;
     Procedure ReadMessage;
@@ -120,8 +174,18 @@ Type
     Property  MsgData : TStream Read FMsgData;
     Property  InstanceID : String Read GetInstanceID;
   Published
+    Property ThreadTimeOut : Integer Read FThreadTimeOut Write FThreadTimeOut;
     Property Global : Boolean Read FGlobal Write SetGlobal;
+    // Called during ReadMessage
     Property OnMessage : TNotifyEvent Read FOnMessage Write FOnMessage;
+    // Called when a message is pushed on the queue.
+    Property OnMessageQueued : TNotifyEvent Read FOnMessageQueued Write FOnMessageQueued;
+    // Called when the queue overflows and  MaxAction = ipcmoaError.
+    Property OnMessageError : TMessageQueueEvent Read FOnMessageError Write FOnMessageError;
+    // Maximum number of messages to keep in the queue
+    property MaxQueue: Integer read GetMaxQueue write SetMaxQueue;
+    // What to do when the queue overflows
+    property MaxAction: TIPCMessageOverflowAction read GetMaxAction write SetMaxAction;
   end;
 
 
@@ -194,6 +258,103 @@ implementation
 
 {$i simpleipc.inc}
 
+Resourcestring
+  SErrMessageQueueOverflow = 'Message queue overflow (limit %s)';
+
+{ ---------------------------------------------------------------------
+    TIPCServerMsg
+  ---------------------------------------------------------------------}
+
+
+constructor TIPCServerMsg.Create;
+begin
+  FMsgType := 0;
+  FStream := TMemoryStream.Create;
+end;
+
+destructor TIPCServerMsg.Destroy;
+begin
+  FStream.Free;
+end;
+
+{ ---------------------------------------------------------------------
+    TIPCServerMsgQueue
+  ---------------------------------------------------------------------}
+
+constructor TIPCServerMsgQueue.Create;
+begin
+  FMaxCount := DefaultIPCMessageQueueLimit;
+  FMaxAction := DefaultIPCMessageOverflowAction;
+  FList := TFPObjectList.Create(False); // FreeObjects = False!
+end;
+
+destructor TIPCServerMsgQueue.Destroy;
+begin
+  Clear;
+  FList.Free;
+end;
+
+procedure TIPCServerMsgQueue.Clear;
+begin
+  while FList.Count > 0 do
+    DeleteAndFree(FList.Count - 1);
+end;
+
+procedure TIPCServerMsgQueue.DeleteAndFree(Index: Integer);
+begin
+  FList[Index].Free; // Free objects manually!
+  FList.Delete(Index);
+end;
+
+function TIPCServerMsgQueue.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TIPCServerMsgQueue.PrepareToPush: Boolean;
+begin
+  Result := True;
+  case FMaxAction of
+    ipcmoaDiscardOld:
+      begin
+        while (FList.Count >= FMaxCount) do
+          DeleteAndFree(FList.Count - 1);
+      end;
+    ipcmoaDiscardNew:
+      begin
+        Result := (FList.Count < FMaxCount);
+      end;
+    ipcmoaError:
+      begin
+        if (FList.Count >= FMaxCount) then
+          // Caller is expected to catch this exception, so not using Owner.DoError()
+          raise EIPCError.CreateFmt(SErrMessageQueueOverflow, [IntToStr(FMaxCount)]);
+      end;
+  end;
+end;
+
+procedure TIPCServerMsgQueue.Push(AItem: TIPCServerMsg);
+begin
+  if PrepareToPush then
+    FList.Insert(0, AItem);
+end;
+
+function TIPCServerMsgQueue.Pop: TIPCServerMsg;
+var
+  Index: Integer;
+begin
+  Index := FList.Count - 1;
+  if Index >= 0 then
+  begin
+    // Caller is responsible for freeing the object.
+    Result := TIPCServerMsg(FList[Index]);
+    FList.Delete(Index);
+  end
+  else
+    Result := nil;
+end;
+
+
 { ---------------------------------------------------------------------
     TIPCServerComm
   ---------------------------------------------------------------------}
@@ -203,22 +364,33 @@ begin
   FOwner:=AOWner;
 end;
 
-Procedure TIPCServerComm.DoError(const Msg : String; const Args : Array of const);
+procedure TIPCServerComm.DoError(const Msg: String; const Args: array of const);
 
 begin
   FOwner.DoError(Msg,Args);
-end;  
+end;
 
-Function TIPCServerComm.MsgData : TStream;
+procedure TIPCServerComm.PushMessage(const Hdr: TMsgHeader; AStream: TStream);
+
+Var
+  M : TIPCServerMsg;
 
 begin
-  Result:=FOwner.FMsgData;
+  M:=TIPCServerMsg.Create;
+  try
+    M.MsgType:=Hdr.MsgType;
+    if Hdr.MsgLen>0 then
+      M.Stream.CopyFrom(AStream,Hdr.MsgLen);
+  except
+    M.Free;
+    Raise;
+  end;
+  PushMessage(M);
 end;
 
-Procedure TIPCServerComm.SetMsgType(AMsgType: TMessageType); 
-
+procedure TIPCServerComm.PushMessage(Msg: TIPCServerMsg);
 begin
-  Fowner.FMsgType:=AMsgType;
+  FOwner.PushMessage(Msg);
 end;
 
 { ---------------------------------------------------------------------
@@ -314,11 +486,14 @@ begin
   FActive:=False;
   FBusy:=False;
   FMsgData:=TStringStream.Create('');
+  FQueue:=TIPCServerMsgQueue.Create;
+  FThreadTimeOut:=DefaultThreadTimeOut;
 end;
 
 destructor TSimpleIPCServer.Destroy;
 begin
   Active:=False;
+  FreeAndNil(FQueue);
   FreeAndNil(FMsgData);
   inherited Destroy;
 end;
@@ -332,11 +507,31 @@ begin
     end;
 end;
 
+procedure TSimpleIPCServer.SetMaxAction(AValue: TIPCMessageOverflowAction);
+begin
+  FQueue.MaxAction:=AValue;
+end;
+
+procedure TSimpleIPCServer.SetMaxQueue(AValue: Integer);
+begin
+  FQueue.MaxCount:=AValue;
+end;
+
 function TSimpleIPCServer.GetInstanceID: String;
 begin
   Result:=FIPCComm.InstanceID;
 end;
 
+function TSimpleIPCServer.GetMaxAction: TIPCMessageOverflowAction;
+begin
+  Result:=FQueue.MaxAction;
+end;
+
+function TSimpleIPCServer.GetMaxQueue: Integer;
+begin
+  Result:=FQueue.MaxCount;
+end;
+
 
 function TSimpleIPCServer.GetStringMessage: String;
 begin
@@ -344,7 +539,7 @@ begin
 end;
 
 
-procedure TSimpleIPCServer.StartServer;
+procedure TSimpleIPCServer.StartServer(Threaded : Boolean = False);
 begin
   if Not Assigned(FIPCComm) then
     begin
@@ -354,47 +549,135 @@ begin
     FIPCComm.StartServer;
     end;
   FActive:=True;
+  If Threaded then
+    StartThread;
+end;
+
+Type
+
+  { TServerThread }
+
+  TServerThread = Class(TThread)
+  private
+    FServer: TSimpleIPCServer;
+    FThreadTimeout: Integer;
+  Public
+    Constructor Create(AServer : TSimpleIPCServer; ATimeout : integer);
+    procedure Execute; override;
+    Property Server : TSimpleIPCServer Read FServer;
+    Property ThreadTimeout : Integer Read FThreadTimeout;
+  end;
+
+{ TServerThread }
+
+constructor TServerThread.Create(AServer: TSimpleIPCServer; ATimeout: integer);
+begin
+  FServer:=AServer;
+  FThreadTimeout:=ATimeOut;
+  Inherited Create(False);
+end;
+
+procedure TServerThread.Execute;
+begin
+  While Not Terminated do
+    FServer.PeekMessage(ThreadTimeout,False);
+end;
+
+procedure TSimpleIPCServer.StartThread;
+
+begin
+  InitCriticalSection(FLock);
+  FThread:=TServerThread.Create(Self,ThreadTimeOut);
+end;
+
+procedure TSimpleIPCServer.StopThread;
+
+begin
+  if Assigned(FThread) then
+    begin
+    FThread.Terminate;
+    FThread.WaitFor;
+    FreeAndNil(FThread);
+    DoneCriticalSection(FLock);
+    end;
 end;
 
 procedure TSimpleIPCServer.StopServer;
 begin
+  StopThread;
   If Assigned(FIPCComm) then
     begin
     FIPCComm.StopServer;
     FreeAndNil(FIPCComm);
     end;
+  FQueue.Clear;
   FActive:=False;
 end;
 
 // TimeOut values:
-//   >  0  -- number of milliseconds to wait
+//   >  0  -- Number of milliseconds to wait
 //   =  0  -- return immediately
 //   = -1  -- wait infinitely
 //   < -1  -- wait infinitely (force to -1)
 function TSimpleIPCServer.PeekMessage(TimeOut: Integer; DoReadMessage: Boolean): Boolean;
 begin
   CheckActive;
-  if TimeOut < -1 then
-    TimeOut := -1;
-  FBusy:=True;
-  Try
-    Result:=FIPCComm.PeekMessage(Timeout);
-  Finally
-    FBusy:=False;
-  end;
+  Result:=Queue.Count>0;
+  If Not Result then
+    begin
+    if TimeOut < -1 then
+      TimeOut := -1;
+    FBusy:=True;
+    Try
+      Result:=FIPCComm.PeekMessage(Timeout);
+    Finally
+      FBusy:=False;
+    end;
+    end;
   If Result then
     If DoReadMessage then
       Readmessage;
 end;
 
+function TSimpleIPCServer.PopMessage: Boolean;
+
+var
+  MsgItem: TIPCServerMsg;
+  DoLock : Boolean;
+
+begin
+  DoLock:=Assigned(FThread);
+  if DoLock then
+    EnterCriticalsection(Flock);
+  try
+    MsgItem:=FQueue.Pop;
+  finally
+    LeaveCriticalsection(FLock);
+  end;
+  Result:=Assigned(MsgItem);
+  if Result then
+    try
+      FMsgType := MsgItem.MsgType;
+      MsgItem.Stream.Position := 0;
+      FMsgData.Size := 0;
+      FMsgData.CopyFrom(MsgItem.Stream, MsgItem.Stream.Size);
+    finally
+      MsgItem.Free;
+    end;
+end;
+
 procedure TSimpleIPCServer.ReadMessage;
+
 begin
   CheckActive;
   FBusy:=True;
   Try
-    FIPCComm.ReadMessage;
-    If Assigned(FOnMessage) then
-      FOnMessage(Self);
+    if (FQueue.Count=0) then
+      // Readmessage pushes a message to the queue
+      FIPCComm.ReadMessage;
+    if PopMessage then
+      If Assigned(FOnMessage) then
+        FOnMessage(Self);
   Finally
     FBusy:=False;
   end;
@@ -416,6 +699,55 @@ begin
 end;
 
 
+procedure TSimpleIPCServer.DoMessageQueued;
+
+begin
+  if Assigned(FOnMessageQueued) then
+    FOnMessageQueued(Self);
+end;
+
+procedure TSimpleIPCServer.DoMessageError;
+begin
+  try
+    if Assigned(FOnMessageQueued) then
+      FOnMessageError(Self,FErrMsg);
+  finally
+    FreeAndNil(FErrMsg)
+  end;
+end;
+
+procedure TSimpleIPCServer.PushMessage(Msg: TIPCServerMsg);
+
+Var
+  DoLock : Boolean;
+
+begin
+  try
+    DoLock:=Assigned(FThread);
+    If DoLock then
+      EnterCriticalsection(FLock);
+    try
+      Queue.Push(Msg);
+    finally
+      If DoLock then
+        LeaveCriticalsection(FLock);
+    end;
+    if DoLock then
+      TThread.Synchronize(FThread,@DoMessageQueued)
+    else
+      DoMessageQueued;
+  except
+    On E : Exception do
+      FErrMsg:=Msg;
+  end;
+  if Assigned(FErrMsg) then
+    if DoLock then
+      TThread.Synchronize(FThread,@DoMessageError)
+    else
+      DoMessageQueued;
+
+end;
+
 
 
 { ---------------------------------------------------------------------

packages/fcl-process/src/unix/simpleipc.inc

@@ -26,10 +26,6 @@ uses sysutils, classes, simpleipc, baseunix;
 uses baseunix;
 {$endif}
 
-{$DEFINE OSNEEDIPCINITDONE}
-
-
-
 
 ResourceString
   SErrFailedToCreatePipe = 'Failed to create named pipe: %s';
@@ -58,57 +54,6 @@ Type
 implementation
 {$endif}
 
-Var
-  SocketFiles : TStringList;
-
-Procedure IPCInit;
-
-begin
-end;
-
-Procedure IPCDone;
-
-Var
-  I : integer;
-  
-begin
-  if Assigned(SocketFiles) then
-    try
-      For I:=0 to SocketFiles.Count-1 do
-        DeleteFile(SocketFiles[i]);
-    finally  
-      FreeAndNil(SocketFiles);  
-    end;  
-end;
-
-
-Procedure RegisterSocketFile(Const AFileName : String);
-
-begin
-  If Not Assigned(SocketFiles) then
-    begin
-    SocketFiles:=TStringList.Create;
-    SocketFiles.Sorted:=True;
-    end;
-  SocketFiles.Add(AFileName);  
-end;
-
-Procedure UnRegisterSocketFile(Const AFileName : String);
-
-Var
-  I : Integer;
-begin
-  If Assigned(SocketFiles) then
-    begin
-    I:=SocketFiles.IndexOf(AFileName);  
-    If (I<>-1) then
-      SocketFiles.Delete(I);
-    If (SocketFiles.Count=0) then
-      FreeAndNil(SocketFiles);
-    end;
-end;
-
-
 constructor TPipeClientComm.Create(AOWner: TSimpleIPCClient);
 begin
   inherited Create(AOWner);
@@ -140,7 +85,6 @@ procedure TPipeClientComm.SendMessage(MsgType : TMessagetype; AStream: TStream);
 
 Var
   Hdr : TMsgHeader;
-  P,L,Count : Integer;
 
 begin
   Hdr.Version:=MsgVersion;
@@ -180,10 +124,15 @@ end;
   ---------------------------------------------------------------------}
 
 Type
+
+  { TPipeServerComm }
+
   TPipeServerComm = Class(TIPCServerComm)
   Private
     FFileName: String;
     FStream: TFileStream;
+  Protected
+    Procedure DoReadMessage; virtual;
   Public
     Constructor Create(AOWner : TSimpleIPCServer); override;
     Procedure StartServer; override;
@@ -195,6 +144,16 @@ Type
     Property Stream : TFileStream Read FStream;
   end;
 
+procedure TPipeServerComm.DoReadMessage;
+
+Var
+  Hdr : TMsgHeader;
+
+begin
+  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
+  PushMessage(Hdr,FStream);
+end;
+
 constructor TPipeServerComm.Create(AOWner: TSimpleIPCServer);
 begin
   inherited Create(AOWner);
@@ -218,12 +177,10 @@ begin
     If (fpmkFifo(FFileName,438)<>0) then
       DoError(SErrFailedToCreatePipe,[FFileName]);
   FStream:=TFileStream.Create(FFileName,fmOpenReadWrite+fmShareDenyNone,Rights[Owner.Global]);
-  RegisterSocketFile(FFileName);
 end;
 
 procedure TPipeServerComm.StopServer;
 begin
-  UnregisterSocketFile(FFileName);
   FreeAndNil(FStream);
   if Not DeleteFile(FFileName) then
     DoError(SErrFailedtoRemovePipe,[FFileName]);
@@ -237,40 +194,33 @@ Var
 begin
   fpfd_zero(FDS);
   fpfd_set(FStream.Handle,FDS);
-  Result:=fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0;
+  Result:=False;
+  While fpSelect(FStream.Handle+1,@FDS,Nil,Nil,TimeOut)>0 do
+    begin
+    DoReadMessage;
+    Result:=True;
+    end;
 end;
 
 procedure TPipeServerComm.ReadMessage;
 
-Var
-  L,P,Count : Integer;
-  Hdr : TMsgHeader;
-  M : TStream;
 begin
-  FStream.ReadBuffer(Hdr,SizeOf(Hdr));
-  SetMsgType(Hdr.MsgType);
-  Count:=Hdr.MsgLen;
-  M:=MsgData;
-  if count > 0 then
-    begin
-    M.Size:=0;
-    M.Seek(0,soFrombeginning);
-    M.CopyFrom(FStream,Count);
-    end
-  else
-    M.Size := 0;
+  DoReadMessage;
 end;
 
+
 function TPipeServerComm.GetInstanceID: String;
 begin
   Result:=IntToStr(fpGetPID);
 end;
 
+
 { ---------------------------------------------------------------------
     Set TSimpleIPCClient / TSimpleIPCServer defaults.
   ---------------------------------------------------------------------}
+
 {$ifndef ipcunit}
-Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
+function TSimpleIPCServer.CommClass: TIPCServerCommClass;
 
 begin
   if (DefaultIPCServerClass<>Nil) then
@@ -288,10 +238,6 @@ begin
 end;
 
 {$else ipcunit}
-initialization
-  IPCInit;
-  
-Finalization
-  IPCDone;  
+
 end.
 {$endif}

packages/fcl-process/src/winall/simpleipc.inc

@@ -14,7 +14,7 @@
 
  **********************************************************************}
 
-uses Windows,messages,contnrs;
+uses Windows,messages;
 
 const
   MsgWndClassName: WideString = 'FPCMsgWindowCls';
@@ -22,7 +22,6 @@ const
 resourcestring
   SErrFailedToRegisterWindowClass = 'Failed to register message window class';
   SErrFailedToCreateWindow = 'Failed to create message window %s';
-  SErrMessageQueueOverflow = 'Message queue overflow (limit %s)';
 
 var
   MsgWindowClass: TWndClassW = (
@@ -38,43 +37,12 @@ var
     lpszClassName: nil);
 
 type
-  TWinMsgServerMsg = class
-  strict private
-    FStream: TStream;
-    FMsgType: TMessageType;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    property Stream: TStream read FStream;
-    property MsgType: TMessageType read FMsgType write FMsgType;
-  end;
-
-  TWinMsgServerMsgQueue = class
-  strict private
-    FList: TFPObjectList;
-    FMaxCount: Integer;
-    FMaxAction: TIPCMessageOverflowAction;
-    function GetCount: Integer;
-    procedure DeleteAndFree(Index: Integer);
-    function PrepareToPush: Boolean;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    procedure Clear;
-    procedure Push(AItem: TWinMsgServerMsg);
-    function Pop: TWinMsgServerMsg;
-    property Count: Integer read GetCount;
-    property MaxCount: Integer read FMaxCount write FMaxCount;
-    property MaxAction: TIPCMessageOverflowAction read FMaxAction write FMaxAction;
-  end;
-
   TWinMsgServerComm = Class(TIPCServerComm)
   strict private
     FHWND : HWND;
     FWindowName : String;
     FWndProcException: Boolean;
     FWndProcExceptionMsg: String;
-    FMsgQueue: TWinMsgServerMsgQueue;
     function AllocateHWnd(const aWindowName: WideString) : HWND;
     procedure ProcessMessages;
     procedure ProcessMessagesWait(TimeOut: Integer);
@@ -97,95 +65,6 @@ type
     Property WindowName : String Read FWindowName;
   end;
 
-  { ---------------------------------------------------------------------
-      TWinMsgServerMsg / TWinMsgServerMsgQueue
-    ---------------------------------------------------------------------}
-
-constructor TWinMsgServerMsg.Create;
-begin
-  FMsgType := 0;
-  FStream := TMemoryStream.Create;
-end;
-
-destructor TWinMsgServerMsg.Destroy;
-begin
-  FStream.Free;
-end;
-
-
-constructor TWinMsgServerMsgQueue.Create;
-begin
-  FMaxCount := DefaultIPCMessageQueueLimit;
-  FMaxAction := DefaultIPCMessageOverflowAction;
-  FList := TFPObjectList.Create(False); // FreeObjects = False!
-end;
-
-destructor TWinMsgServerMsgQueue.Destroy;
-begin
-  Clear;
-  FList.Free;
-end;
-
-procedure TWinMsgServerMsgQueue.Clear;
-begin
-  while FList.Count > 0 do
-    DeleteAndFree(FList.Count - 1);
-end;
-
-procedure TWinMsgServerMsgQueue.DeleteAndFree(Index: Integer);
-begin
-  FList[Index].Free; // Free objects manually!
-  FList.Delete(Index);
-end;
-
-function TWinMsgServerMsgQueue.GetCount: Integer;
-begin
-  Result := FList.Count;
-end;
-
-function TWinMsgServerMsgQueue.PrepareToPush: Boolean;
-begin
-  Result := True;
-  case FMaxAction of
-    ipcmoaDiscardOld:
-      begin
-        while (FList.Count >= FMaxCount) do
-          DeleteAndFree(FList.Count - 1);
-      end;
-    ipcmoaDiscardNew:
-      begin
-        Result := (FList.Count < FMaxCount);
-      end;
-    ipcmoaError:
-      begin
-        if (FList.Count >= FMaxCount) then
-          // Caller is expected to catch this exception, so not using Owner.DoError()
-          raise EIPCError.CreateFmt(SErrMessageQueueOverflow, [IntToStr(FMaxCount)]);
-      end;
-  end;
-end;
-
-procedure TWinMsgServerMsgQueue.Push(AItem: TWinMsgServerMsg);
-begin
-  if PrepareToPush then
-    FList.Insert(0, AItem);
-end;
-
-function TWinMsgServerMsgQueue.Pop: TWinMsgServerMsg;
-var
-  Index: Integer;
-begin
-  Index := FList.Count - 1;
-  if Index >= 0 then
-  begin
-    // Caller is responsible for freeing the object.
-    Result := TWinMsgServerMsg(FList[Index]);
-    FList.Delete(Index);
-  end
-  else
-    Result := nil;
-end;
-
 { ---------------------------------------------------------------------
     MsgWndProc
   ---------------------------------------------------------------------}
@@ -257,13 +136,11 @@ begin
     FWindowName := FWindowName+'_'+InstanceID;
   FWndProcException := False;
   FWndProcExceptionMsg := '';
-  FMsgQueue := TWinMsgServerMsgQueue.Create;
 end;
 
 destructor TWinMsgServerComm.Destroy;
 begin
   StopServer;
-  FMsgQueue.Free;
   inherited;
 end;
 
@@ -275,7 +152,6 @@ end;
 
 procedure TWinMsgServerComm.StopServer;
 begin
-  FMsgQueue.Clear;
   if FHWND <> 0 then
   begin
     DestroyWindow(FHWND);
@@ -304,12 +180,12 @@ end;
 
 function TWinMsgServerComm.HaveQueuedMessages: Boolean; inline;
 begin
-  Result := (FMsgQueue.Count > 0);
+  Result := (Owner.Queue.Count > 0);
 end;
 
 function TWinMsgServerComm.CountQueuedMessages: Integer; inline;
 begin
-  Result := FMsgQueue.Count;
+  Result := Owner.Queue.Count;
 end;
 
 procedure TWinMsgServerComm.HandlePostedMessage(const Msg: TMsg); inline;
@@ -397,10 +273,11 @@ end;
 procedure TWinMsgServerComm.ReadMsgData(var Msg: TMsg);
 var
   CDS: PCopyDataStruct;
-  MsgItem: TWinMsgServerMsg;
+  MsgItem: TIPCServerMsg;
+
 begin
   CDS := PCopyDataStruct(Msg.lParam);
-  MsgItem := TWinMsgServerMsg.Create;
+  MsgItem := TIPCServerMsg.Create;
   try
     MsgItem.MsgType := CDS^.dwData;
     MsgItem.Stream.WriteBuffer(CDS^.lpData^,CDS^.cbData);
@@ -409,7 +286,7 @@ begin
     // Caller is expected to catch this exception, so not using Owner.DoError()
     raise;
   end;
-  FMsgQueue.Push(MsgItem);
+  PushMessage(MsgItem);
 end;
 
 function TWinMsgServerComm.TryReadMsgData(var Msg: TMsg; out Error: String): Boolean;
@@ -426,21 +303,8 @@ begin
 end;
 
 procedure TWinMsgServerComm.ReadMessage;
-var
-  MsgItem: TWinMsgServerMsg;
 begin
-  MsgItem := FMsgQueue.Pop;
-  if Assigned(MsgItem) then
-  try
-    // Load message from the queue into the owner's message data.
-    MsgItem.Stream.Position := 0;
-    Owner.FMsgData.Size := 0;
-    Owner.FMsgType := MsgItem.MsgType;
-    Owner.FMsgData.CopyFrom(MsgItem.Stream, MsgItem.Stream.Size);
-  finally
-    // We are responsible for freeing the message from the queue.
-    MsgItem.Free;
-  end;
+  // Do nothing, PeekMessages has pushed messages to the queue.
 end;
 
 function TWinMsgServerComm.GetInstanceID: String;
@@ -451,7 +315,7 @@ end;
 { ---------------------------------------------------------------------
     TWinMsgClientComm
   ---------------------------------------------------------------------}
-  
+
 Type
   TWinMsgClientComm = Class(TIPCClientComm)
   Private
@@ -544,7 +408,7 @@ Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
 begin
   if (DefaultIPCServerClass<>Nil) then
     Result:=DefaultIPCServerClass
-  else  
+  else
     Result:=TWinMsgServerComm;
 end;
 
@@ -553,7 +417,7 @@ Function TSimpleIPCClient.CommClass : TIPCClientCommClass;
 begin
   if (DefaultIPCClientClass<>Nil) then
     Result:=DefaultIPCClientClass
-  else  
+  else
     Result:=TWinMsgClientComm;
 end;
 

packages/fcl-web/examples/httpclient/httpget.pas

@@ -92,6 +92,10 @@ begin
       OnPassword:=@DoPassword;
       OnDataReceived:=@DoProgress;
       OnHeaders:=@DoHeaders;
+      { Set this if you want to try a proxy.
+      Proxy.Host:='195.207.46.20';
+      Proxy.Port:=8080;
+      }
       Get(ParamStr(1),ParamStr(2));
     finally
       Free;

packages/fcl-web/examples/httpserver/simplehttpserver.pas

@@ -7,7 +7,7 @@ uses
   {$IFDEF UNIX}{$IFDEF UseCThreads}
   cthreads,
   {$ENDIF}{$ENDIF}
-  sysutils, Classes, fphttpserver, fpmimetypes;
+  sysutils, Classes, fphttpserver, fpmimetypes, wmecho;
 
 Type
 
@@ -21,13 +21,16 @@ Type
     FMimeTypesFile: String;
     procedure SetBaseDir(const AValue: String);
   Protected
+    Procedure DoIdle(Sender : TObject);
     procedure CheckMimeLoaded;
+
     Property MimeLoaded : Boolean Read FMimeLoaded;
   public
     procedure HandleRequest(Var ARequest: TFPHTTPConnectionRequest;
                             Var AResponse : TFPHTTPConnectionResponse); override;
     Property BaseDir : String Read FBaseDir Write SetBaseDir;
     Property MimeTypesFile : String Read FMimeTypesFile Write FMimeTypesFile;
+
   end;
 
 Var
@@ -42,6 +45,11 @@ begin
     FBaseDir:=IncludeTrailingPathDelimiter(FBaseDir);
 end;
 
+procedure TTestHTTPServer.DoIdle(Sender: TObject);
+begin
+  Writeln('Idle, waiting for connections');
+end;
+
 procedure TTestHTTPServer.CheckMimeLoaded;
 begin
   If (Not MimeLoaded) and (MimeTypesFile<>'') then
@@ -98,6 +106,8 @@ begin
 {$endif}
     Serv.Threaded:=False;
     Serv.Port:=8080;
+    Serv.AcceptIdleTimeout:=1000;
+    Serv.OnAcceptIdle:[email protected];
     Serv.Active:=True;
   finally
     Serv.Free;

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

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

@@ -42,6 +42,28 @@ Type
   // Use this to set up a socket handler. UseSSL is true if protocol was https
   TGetSocketHandlerEvent = Procedure (Sender : TObject; Const UseSSL : Boolean; Out AHandler : TSocketHandler) of object;
 
+  TFPCustomHTTPClient = Class;
+
+  { TProxyData }
+
+  TProxyData = Class (TPersistent)
+  private
+    FHost: string;
+    FPassword: String;
+    FPort: Word;
+    FUserName: String;
+    FHTTPClient : TFPCustomHTTPClient;
+  Protected
+    Function GetProxyHeaders : String; virtual;
+    Property HTTPClient : TFPCustomHTTPClient Read FHTTPClient;
+  Public
+    Procedure Assign(Source: TPersistent); override;
+    Property Host: string Read FHost Write FHost;
+    Property Port: Word Read FPort Write FPort;
+    Property UserName : String Read FUserName Write FUserName;
+    Property Password : String Read FPassword Write FPassword;
+  end;
+
   { TFPCustomHTTPClient }
   TFPCustomHTTPClient = Class(TComponent)
   private
@@ -68,14 +90,21 @@ Type
     FBuffer : Ansistring;
     FUserName: String;
     FOnGetSocketHandler : TGetSocketHandlerEvent;
+    FProxy : TProxyData;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
     function GetCookies: TStrings;
+    function GetProxy: TProxyData;
     Procedure ResetResponse;
     Procedure SetCookies(const AValue: TStrings);
+    procedure SetProxy(AValue: TProxyData);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
   protected
+    // 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.
+    Function CreateProxyData : TProxyData;
     // Called whenever data is read.
     Procedure DoDataRead; virtual;
     // Parse response status line. Saves status text and protocol, returns numerical code. Exception if invalid line.
@@ -241,6 +270,8 @@ Type
     // Called On redirect. Dest URL can be edited.
     // If The DEST url is empty on return, the method is aborted (with redirect status).
     Property OnRedirect : TRedirectEvent Read FOnRedirect Write FOnRedirect;
+    // Proxy support
+    Property Proxy : TProxyData Read GetProxy Write SetProxy;
     // Authentication.
     // When set, they override the credentials found in the URI.
     // They also override any Authenticate: header in Requestheaders.
@@ -255,11 +286,12 @@ Type
     Property OnHeaders : TNotifyEvent Read FOnHeaders Write FOnHeaders;
     // Called to create socket handler. If not set, or Nil is returned, a standard socket handler is created.
     Property OnGetSocketHandler : TGetSocketHandlerEvent Read FOnGetSocketHandler Write FOnGetSocketHandler;
+
   end;
 
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
-  Public
+  Published
     Property IOTimeout;
     Property RequestHeaders;
     Property RequestBody;
@@ -278,6 +310,7 @@ Type
     Property OnDataReceived;
     Property OnHeaders;
     Property OnGetSocketHandler;
+    Property Proxy;
   end;
 
   EHTTPClient = Class(EHTTP);
@@ -381,6 +414,33 @@ begin
   SetLength(Result, P-Pchar(Result));
 end;
 
+{ TProxyData }
+
+function TProxyData.GetProxyHeaders: String;
+begin
+  Result:='';
+  if (UserName<>'') then
+   Result:='Proxy-Authorization: Basic ' + EncodeStringBase64(UserName+':'+UserName);
+end;
+
+procedure TProxyData.Assign(Source: TPersistent);
+
+Var
+  D : TProxyData;
+
+begin
+  if Source is TProxyData then
+    begin
+    D:=Source as TProxyData;
+    Host:=D.Host;
+    Port:=D.Port;
+    UserName:=D.UserName;
+    Password:=D.Password;
+    end
+  else
+    inherited Assign(Source);
+end;
+
 { TFPCustomHTTPClient }
 
 procedure TFPCustomHTTPClient.SetRequestHeaders(const AValue: TStrings);
@@ -397,6 +457,16 @@ begin
     FSocket.IOTimeout:=AValue;
 end;
 
+function TFPCustomHTTPClient.ProxyActive: Boolean;
+begin
+  Result:=Assigned(FProxy) and (FProxy.Host<>'') and (FProxy.Port>0);
+end;
+
+function TFPCustomHTTPClient.CreateProxyData: TProxyData;
+begin
+  Result:=TProxyData.Create;
+end;
+
 procedure TFPCustomHTTPClient.DoDataRead;
 begin
   If Assigned(FOnDataReceived) Then
@@ -437,6 +507,12 @@ begin
   Result:=D+URI.Document;
   if (URI.Params<>'') then
     Result:=Result+'?'+URI.Params;
+  if ProxyActive then
+    begin
+    if URI.Port>0 then
+      Result:=':'+IntToStr(URI.Port)+Result;
+    Result:=URI.Protocol+'://'+URI.Host+Result;
+    end;
 end;
 
 function TFPCustomHTTPClient.GetSocketHandler(const UseSSL: Boolean): TSocketHandler;
@@ -494,7 +570,7 @@ end;
 procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
 
 Var
-  UN,PW,S,L : String;
+  PH,UN,PW,S,L : String;
   I : Integer;
 
 begin
@@ -513,6 +589,12 @@ begin
     If I<>-1 then
       RequestHeaders.Delete(i);
     end;
+  if Assigned(FProxy) and (FProxy.Host<>'') then
+    begin
+    PH:=FProxy.GetProxyHeaders;
+    if (PH<>'') then
+      S:=S+PH+CRLF;
+    end;
   S:=S+'Host: '+URI.Host;
   If (URI.Port<>0) then
     S:=S+':'+IntToStr(URI.Port);
@@ -773,12 +855,28 @@ begin
   Result:=FCookies;
 end;
 
+function TFPCustomHTTPClient.GetProxy: TProxyData;
+begin
+  If not Assigned(FProxy) then
+    begin
+    FProxy:=CreateProxyData;
+    FProxy.FHTTPClient:=Self;
+    end;
+  Result:=FProxy;
+end;
+
 procedure TFPCustomHTTPClient.SetCookies(const AValue: TStrings);
 begin
   if GetCookies=AValue then exit;
   GetCookies.Assign(AValue);
 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);
 
@@ -951,7 +1049,8 @@ procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
 
 Var
   URI : TURI;
-  P : String;
+  P,CHost : String;
+  CPort : Word;
 
 begin
   ResetResponse;
@@ -959,7 +1058,17 @@ begin
   p:=LowerCase(URI.Protocol);
   If Not ((P='http') or (P='https')) then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
-  ConnectToServer(URI.Host,URI.Port,P='https');
+  if ProxyActive then
+    begin
+    CHost:=Proxy.Host;
+    CPort:=Proxy.Port;
+    end
+  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);
@@ -981,6 +1090,7 @@ end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
+  FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
   FreeAndNil(FRequestHeaders);

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

@@ -101,8 +101,10 @@ Type
 
   TFPCustomHttpServer = Class(TComponent)
   Private
+    FAcceptIdleTimeout: Cardinal;
     FAdminMail: string;
     FAdminName: string;
+    FOnAcceptIdle: TNotifyEvent;
     FOnAllowConnect: TConnectQuery;
     FOnRequest: THTTPServerRequestHandler;
     FOnRequestError: TRequestErrorHandler;
@@ -116,7 +118,9 @@ Type
     FThreaded: Boolean;
     FConnectionCount : Integer;
     function GetActive: Boolean;
+    procedure SetAcceptIdleTimeout(AValue: Cardinal);
     procedure SetActive(const AValue: Boolean);
+    procedure SetIdle(AValue: TNotifyEvent);
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
     procedure SetAddress(const AValue: string);
     procedure SetPort(const AValue: Word);
@@ -175,6 +179,10 @@ Type
     Property OnRequest : THTTPServerRequestHandler Read FOnRequest Write FOnRequest;
     // Called when an unexpected error occurs during handling of the request. Sender is the TFPHTTPConnection.
     Property OnRequestError : TRequestErrorHandler Read FOnRequestError Write FOnRequestError;
+    // Called when there are no connections waiting.
+    Property OnAcceptIdle : TNotifyEvent Read FOnAcceptIdle Write SetIdle;
+    // If >0, when no new connection appeared after timeout, OnAcceptIdle is called.
+    Property AcceptIdleTimeout : Cardinal Read FAcceptIdleTimeout Write SetAcceptIdleTimeout;
   published
     //aditional server information
     property AdminMail: string read FAdminMail write FAdminMail;
@@ -192,6 +200,8 @@ Type
     property Threaded;
     Property OnRequest;
     Property OnRequestError;
+    Property OnAcceptIdle;
+    Property AcceptIdleTimeout;
   end;
 
   EHTTPServer = Class(EHTTP);
@@ -638,9 +648,17 @@ begin
     Result:=Assigned(FServer);
 end;
 
+procedure TFPCustomHttpServer.SetAcceptIdleTimeout(AValue: Cardinal);
+begin
+  if FAcceptIdleTimeout=AValue then Exit;
+  FAcceptIdleTimeout:=AValue;
+  If Assigned(FServer) then
+    FServer.AcceptIdleTimeOut:=AValue;
+end;
+
 procedure TFPCustomHttpServer.StopServerSocket;
 begin
-  FServer.StopAccepting(True);
+  FServer.StopAccepting(False);
 end;
 
 procedure TFPCustomHttpServer.SetActive(const AValue: Boolean);
@@ -659,6 +677,13 @@ begin
       StopServerSocket;
 end;
 
+procedure TFPCustomHttpServer.SetIdle(AValue: TNotifyEvent);
+begin
+  FOnAcceptIdle:=AValue;
+  if Assigned(FServer) then
+    FServer.OnIdle:=AValue;
+end;
+
 procedure TFPCustomHttpServer.SetOnAllowConnect(const AValue: TConnectQuery);
 begin
   if FOnAllowConnect=AValue then exit;
@@ -771,6 +796,8 @@ begin
   FServer.OnConnectQuery:=OnAllowConnect;
   FServer.OnConnect:=@DOConnect;
   FServer.OnAcceptError:=@DoAcceptError;
+  FServer.OnIdle:=OnAcceptIdle;
+  FServer.AcceptIdleTimeOut:=AcceptIdleTimeout;
 end;
 
 procedure TFPCustomHttpServer.StartServerSocket;
@@ -800,7 +827,7 @@ begin
   FServerBanner := 'Freepascal';
 end;
 
-Procedure TFPCustomHttpServer.WaitForRequests;
+procedure TFPCustomHttpServer.WaitForRequests;
 
 Var
   FLastCount,ACount : Integer;

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;

packages/googleapi/examples/generator/googleapiconv.pp

@@ -54,7 +54,9 @@ Type
 
   TGoogleAPIConverter = CLass(TCustomApplication)
   private
+    FDownloadOnly: Boolean;
     FKeepJSON: Boolean;
+    FUnitPrefix: String;
     FVerbose: Boolean;
     procedure ConversionLog(Sender: TObject; LogType: TCodegenLogType; const Msg: String);
     procedure CreateFPMake(FileName: String; L: TAPIEntries);
@@ -71,6 +73,8 @@ Type
     Procedure DoRun; override;
     Property KeepJSON : Boolean Read FKeepJSON Write FKeepJSON;
     Property Verbose : Boolean Read FVerbose Write FVerbose;
+    Property DownloadOnly : Boolean Read FDownloadOnly Write FDownloadOnly;
+    Property UnitPrefix : String Read FUnitPrefix Write FUnitPrefix;
   end;
 
 { TAPIEntries }
@@ -85,19 +89,21 @@ begin
   Result:=Add as TAPIEntry;
 end;
 
-constructor TGoogleAPIConverter.Create(AOwner: TComponent);
+Constructor TGoogleAPIConverter.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   StopOnException:=True;
   TDiscoveryJSONToPas.RegisterAllObjects;
+  UnitPrefix:='google';
 end;
 
-destructor TGoogleAPIConverter.Destroy;
+Destructor TGoogleAPIConverter.Destroy;
 begin
   inherited Destroy;
 end;
 
-function TGoogleAPIConverter.HttpGetJSON(const URL: String; Response: TStream): Boolean;
+Function TGoogleAPIConverter.HttpGetJSON(Const URL: String; Response: TStream
+  ): Boolean;
 
 Var
   Webclient : TAbstractWebClient;
@@ -116,6 +122,7 @@ begin
   try
     Req:=WebClient.CreateRequest;
     Req.ResponseContent:=Response;
+    ConversionLog(Self,cltInfo,'Downloading: '+URL);
     Resp:=WebClient.ExecuteRequest('GET',URL,Req);
     Result:=(Resp<>Nil);
   finally
@@ -155,6 +162,10 @@ begin
   Writeln('-u --url=URL               URL to download the REST description from.');
   Writeln('-v --serviceversion=v      Service version to download the REST description for.');
   Writeln('-V --verbose               Write some diagnostic messages');
+  Writeln('-k --keepjson              Keep the downloaded JSON files');
+  Writeln('-d --onlydownload          Just download the files, do not actually convert.');
+  Writeln('                           Only effective if -k or --keepjson is also specified.');
+  Writeln('-f --unitprefix            Prefix for generated unit names. Default is "google"');
   Writeln('If the outputfilename is empty and cannot be determined, an error is returned');
   Halt(Ord(Msg<>''));
 end;
@@ -355,7 +366,7 @@ begin
       if AllVersions or O.Get('preferred',false) then
         begin
         RU:=O.get('discoveryRestUrl');
-        LFN:=O.get('name');
+        LFN:=UnitPrefix+O.get('name');
         if AllVersions then
           LFN:=LFN+'_'+StringReplace(O.get('version'),'.','',[rfReplaceAll]);
         if (OFN='') then
@@ -377,33 +388,37 @@ begin
           RS.Position:=0;
           U:=UL.AddEntry;
           U.FileName:=LFN;
-          DoConversion(RS,U);
+          if not DownloadOnly then
+            DoConversion(RS,U);
         finally
           RS.Free;
         end;
         end;
       end;
-    if HasOption('R','register') then
-      RegisterUnit(GetOptionValue('R','register'),UL);
-    if HasOption('m','fpmake') then
-      CreateFpMake(GetOptionValue('m','fpmake'),UL);
+    if not DownloadOnly then
+      begin
+      if HasOption('R','register') then
+        RegisterUnit(GetOptionValue('R','register'),UL);
+      if HasOption('m','fpmake') then
+        CreateFpMake(GetOptionValue('m','fpmake'),UL);
+      end;
     if HasOption('I','icon') then
       For I:=0 to UL.Count-1 do
         DownloadIcon(UL[i]);
-
   finally
     UL.Free;
     D.Free;
   end;
 end;
 
-procedure TGoogleAPIConverter.DoRun;
+Procedure TGoogleAPIConverter.DoRun;
 
 Const
-  MyO : Array[1..19] of ansistring
+  MyO : Array[1..21] of ansistring
       =  ('help','input:','output:','extraunits:','baseclass:','classprefix:',
           'url:','service:','serviceversion:','resourcesuffix:','license:',
-          'All','all','register','icon','fpmake:','timestamp','verbose','keepjson');
+          'All','all','register','icon','fpmake:','timestamp','verbose','keepjson',
+          'onlydownload','unitprefix');
 
 Var
   O,NonOpts : TStrings;
@@ -419,7 +434,7 @@ begin
   try
     O:=TStringList.Create;
     For S in MyO do O.Add(S);
-    S:=Checkoptions('hi:o:e:b:p:u:s:v:r:L:aAR:Im:tVk',O,TStrings(Nil),NonOpts,True);
+    S:=Checkoptions('hi:o:e:b:p:u:s:v:r:L:aAR:Im:tVkdf',O,TStrings(Nil),NonOpts,True);
     if NonOpts.Count>0 then
       IFN:=NonOpts[0];
     if NonOpts.Count>1 then
@@ -430,6 +445,10 @@ begin
   end;
   FVerbose:=HasOption('V','verbose');
   FKeepJSON:=HasOption('k','keepjson');
+  if HasOption('f','unitprefix') then
+    UnitPrefix:=GetOptionValue('f','unitprefix');
+  If FKeepJSON Then
+    FDownLoadOnly:=HasOption('d','onlydownload');
   if (S<>'') or HasOption('h','help') then
     Usage(S);
   DoAllServices:=HasOption('a','all') or HasOption('A','All');
@@ -455,7 +474,7 @@ begin
     if (IFN<>'') then
       OFN:=ChangeFileExt(IFN,'.pp')
     else if getOptionValue('s','service')<>'' then
-      OFN:='google'+getOptionValue('s','service')+'.pp';
+      OFN:=UnitPrefix+getOptionValue('s','service')+'.pp';
   if (OFN='') and Not DoAllServices then
     Usage('Need an output filename');
   if DoAllServices then
@@ -480,15 +499,16 @@ begin
     else
       JS:=TFileStream.Create(IFN,fmOpenRead or fmShareDenyWrite);
     try
-      APIEntry:=TAPIEntry.Create(Nil);
-      try
-        APIEntry.FileName:=OFN;
-        DoConversion(JS,APIEntry);
-        if HasOption('I','icon') then
-          DownloadIcon(APIEntry);
-      finally
-        APIEntry.Free;
-      end;
+      if not DownLoadOnly then
+        APIEntry:=TAPIEntry.Create(Nil);
+        try
+          APIEntry.FileName:=OFN;
+          DoConversion(JS,APIEntry);
+          if HasOption('I','icon') then
+            DownloadIcon(APIEntry);
+        finally
+          APIEntry.Free;
+        end;
     finally
       JS.Free;
     end;
@@ -517,7 +537,7 @@ begin
     end;
 end;
 
-procedure TGoogleAPIConverter.DoConversion(JS: TStream; AEntry: TAPIEntry);
+Procedure TGoogleAPIConverter.DoConversion(JS: TStream; AEntry: TAPIEntry);
 
 Var
   L: String;

packages/googleapi/fpmake.pp

@@ -82,8 +82,8 @@ begin
     T:=StdDep(P.Targets.AddUnit('googlefreebase.pp'));
     T:=StdDep(P.Targets.AddUnit('googlefusiontables.pp'));
     T:=StdDep(P.Targets.AddUnit('googlegames.pp'));
-    T:=StdDep(P.Targets.AddUnit('googlegamesConfiguration.pp'));
-    T:=StdDep(P.Targets.AddUnit('googlegamesManagement.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlegamesconfiguration.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlegamesmanagement.pp'));
     T:=StdDep(P.Targets.AddUnit('googlegan.pp'));
     T:=StdDep(P.Targets.AddUnit('googlegenomics.pp'));
     T:=StdDep(P.Targets.AddUnit('googlegmail.pp'));
@@ -97,15 +97,15 @@ begin
     T:=StdDep(P.Targets.AddUnit('googleoauth2.pp'));
     T:=StdDep(P.Targets.AddUnit('googlepagespeedonline.pp'));
     T:=StdDep(P.Targets.AddUnit('googleplus.pp'));
-    T:=StdDep(P.Targets.AddUnit('googleplusDomains.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleplusdomains.pp'));
     T:=StdDep(P.Targets.AddUnit('googleprediction.pp'));
     T:=StdDep(P.Targets.AddUnit('googlepubsub.pp'));
-    T:=StdDep(P.Targets.AddUnit('googleqpxExpress.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleqpxexpress.pp'));
     T:=StdDep(P.Targets.AddUnit('googlereplicapool.pp'));
     T:=StdDep(P.Targets.AddUnit('googlereplicapoolupdater.pp'));
     T:=StdDep(P.Targets.AddUnit('googlereseller.pp'));
     T:=StdDep(P.Targets.AddUnit('googleresourceviews.pp'));
-    T:=StdDep(P.Targets.AddUnit('googlesiteVerification.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlesiteverification.pp'));
     T:=StdDep(P.Targets.AddUnit('googlespectrum.pp'));
     T:=StdDep(P.Targets.AddUnit('googlesqladmin.pp'));
     T:=StdDep(P.Targets.AddUnit('googlestorage.pp'));
@@ -117,10 +117,41 @@ begin
     T:=StdDep(P.Targets.AddUnit('googlewebfonts.pp'));
     T:=StdDep(P.Targets.AddUnit('googlewebmasters.pp'));
     T:=StdDep(P.Targets.AddUnit('googleyoutube.pp'));
-    T:=StdDep(P.Targets.AddUnit('googleyoutubeAnalytics.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleyoutubeanalytics.pp'));
     T:=StdDep(P.Targets.AddUnit('googlecloudlatencytest.pp'));
     T:=StdDep(P.Targets.AddUnit('googlecloudsearch.pp'));
     T:=StdDep(P.Targets.AddUnit('googlelogging.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleacceleratedmobilepageurl.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleadexchangebuyer2.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleanalyticsreporting.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleappengine.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleclassroom.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlecloudbilling.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlecloudbuild.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleclouddebugger.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleclouderrorreporting.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlecloudresourcemanager.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlecloudtrace.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleclouduseraccounts.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleconsumersurveys.pp'));
+    T:=StdDep(P.Targets.AddUnit('googledataproc.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlefirebaserules.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleiam.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlekgsearch.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlemonitoring.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlepartners.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlepeople.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleplaymoviespartner.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleproximitybeacon.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleruntimeconfig.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlesafebrowsing.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlescript.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleserviceregistry.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlesheets.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlestoragetransfer.pp'));
+    T:=StdDep(P.Targets.AddUnit('googletoolresults.pp'));
+    T:=StdDep(P.Targets.AddUnit('googlevision.pp'));
+    T:=StdDep(P.Targets.AddUnit('googleyoutubereporting.pp'));
     end;
 end;
 

packages/googleapi/src/googleacceleratedmobilepageurl.pp

@@ -0,0 +1,493 @@
+unit googleacceleratedmobilepageurl;
+{$MODE objfpc}
+{$H+}
+
+interface
+
+uses sysutils, classes, googleservice, restbase, googlebase;
+
+type
+  
+  //Top-level schema types
+  TAmpUrl = Class;
+  TAmpUrlError = Class;
+  TBatchGetAmpUrlsRequest = Class;
+  TBatchGetAmpUrlsResponse = Class;
+  TAmpUrlArray = Array of TAmpUrl;
+  TAmpUrlErrorArray = Array of TAmpUrlError;
+  TBatchGetAmpUrlsRequestArray = Array of TBatchGetAmpUrlsRequest;
+  TBatchGetAmpUrlsResponseArray = Array of TBatchGetAmpUrlsResponse;
+  //Anonymous types, using auto-generated names
+  TBatchGetAmpUrlsResponseTypeurlErrorsArray = Array of TAmpUrlError;
+  TBatchGetAmpUrlsResponseTypeampUrlsArray = Array of TAmpUrl;
+  
+  { --------------------------------------------------------------------
+    TAmpUrl
+    --------------------------------------------------------------------}
+  
+  TAmpUrl = Class(TGoogleBaseObject)
+  Private
+    FampUrl : String;
+    ForiginalUrl : String;
+    FcdnAmpUrl : String;
+  Protected
+    //Property setters
+    Procedure SetampUrl(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetoriginalUrl(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetcdnAmpUrl(AIndex : Integer; const AValue : String); virtual;
+  Public
+  Published
+    Property ampUrl : String Index 0 Read FampUrl Write SetampUrl;
+    Property originalUrl : String Index 8 Read ForiginalUrl Write SetoriginalUrl;
+    Property cdnAmpUrl : String Index 16 Read FcdnAmpUrl Write SetcdnAmpUrl;
+  end;
+  TAmpUrlClass = Class of TAmpUrl;
+  
+  { --------------------------------------------------------------------
+    TAmpUrlError
+    --------------------------------------------------------------------}
+  
+  TAmpUrlError = Class(TGoogleBaseObject)
+  Private
+    ForiginalUrl : String;
+    FerrorCode : String;
+    FerrorMessage : String;
+  Protected
+    //Property setters
+    Procedure SetoriginalUrl(AIndex : Integer; const AValue : String); virtual;
+    Procedure SeterrorCode(AIndex : Integer; const AValue : String); virtual;
+    Procedure SeterrorMessage(AIndex : Integer; const AValue : String); virtual;
+  Public
+  Published
+    Property originalUrl : String Index 0 Read ForiginalUrl Write SetoriginalUrl;
+    Property errorCode : String Index 8 Read FerrorCode Write SeterrorCode;
+    Property errorMessage : String Index 16 Read FerrorMessage Write SeterrorMessage;
+  end;
+  TAmpUrlErrorClass = Class of TAmpUrlError;
+  
+  { --------------------------------------------------------------------
+    TBatchGetAmpUrlsRequest
+    --------------------------------------------------------------------}
+  
+  TBatchGetAmpUrlsRequest = Class(TGoogleBaseObject)
+  Private
+    Furls : TStringArray;
+  Protected
+    //Property setters
+    Procedure Seturls(AIndex : Integer; const AValue : TStringArray); virtual;
+    //2.6.4. bug workaround
+    {$IFDEF VER2_6}
+    Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
+    {$ENDIF VER2_6}
+  Public
+  Published
+    Property urls : TStringArray Index 0 Read Furls Write Seturls;
+  end;
+  TBatchGetAmpUrlsRequestClass = Class of TBatchGetAmpUrlsRequest;
+  
+  { --------------------------------------------------------------------
+    TBatchGetAmpUrlsResponse
+    --------------------------------------------------------------------}
+  
+  TBatchGetAmpUrlsResponse = Class(TGoogleBaseObject)
+  Private
+    FurlErrors : TBatchGetAmpUrlsResponseTypeurlErrorsArray;
+    FampUrls : TBatchGetAmpUrlsResponseTypeampUrlsArray;
+  Protected
+    //Property setters
+    Procedure SeturlErrors(AIndex : Integer; const AValue : TBatchGetAmpUrlsResponseTypeurlErrorsArray); virtual;
+    Procedure SetampUrls(AIndex : Integer; const AValue : TBatchGetAmpUrlsResponseTypeampUrlsArray); virtual;
+    //2.6.4. bug workaround
+    {$IFDEF VER2_6}
+    Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
+    {$ENDIF VER2_6}
+  Public
+  Published
+    Property urlErrors : TBatchGetAmpUrlsResponseTypeurlErrorsArray Index 0 Read FurlErrors Write SeturlErrors;
+    Property ampUrls : TBatchGetAmpUrlsResponseTypeampUrlsArray Index 8 Read FampUrls Write SetampUrls;
+  end;
+  TBatchGetAmpUrlsResponseClass = Class of TBatchGetAmpUrlsResponse;
+  
+  { --------------------------------------------------------------------
+    TAmpUrlsResource
+    --------------------------------------------------------------------}
+  
+  TAmpUrlsResource = Class(TGoogleResource)
+  Public
+    Class Function ResourceName : String; override;
+    Class Function DefaultAPI : TGoogleAPIClass; override;
+    Function BatchGet(aBatchGetAmpUrlsRequest : TBatchGetAmpUrlsRequest) : TBatchGetAmpUrlsResponse;
+  end;
+  
+  
+  { --------------------------------------------------------------------
+    TAcceleratedmobilepageurlAPI
+    --------------------------------------------------------------------}
+  
+  TAcceleratedmobilepageurlAPI = Class(TGoogleAPI)
+  Private
+    FAmpUrlsInstance : TAmpUrlsResource;
+    Function GetAmpUrlsInstance : TAmpUrlsResource;virtual;
+  Public
+    //Override class functions with API info
+    Class Function APIName : String; override;
+    Class Function APIVersion : String; override;
+    Class Function APIRevision : String; override;
+    Class Function APIID : String; override;
+    Class Function APITitle : String; override;
+    Class Function APIDescription : String; override;
+    Class Function APIOwnerDomain : String; override;
+    Class Function APIOwnerName : String; override;
+    Class Function APIIcon16 : String; override;
+    Class Function APIIcon32 : String; override;
+    Class Function APIdocumentationLink : String; override;
+    Class Function APIrootUrl : string; override;
+    Class Function APIbasePath : string;override;
+    Class Function APIbaseURL : String;override;
+    Class Function APIProtocol : string;override;
+    Class Function APIservicePath : string;override;
+    Class Function APIbatchPath : String;override;
+    Class Function APIAuthScopes : TScopeInfoArray;override;
+    Class Function APINeedsAuth : Boolean;override;
+    Class Procedure RegisterAPIResources; override;
+    //Add create function for resources
+    Function CreateAmpUrlsResource(AOwner : TComponent) : TAmpUrlsResource;virtual;overload;
+    Function CreateAmpUrlsResource : TAmpUrlsResource;virtual;overload;
+    //Add default on-demand instances for resources
+    Property AmpUrlsResource : TAmpUrlsResource Read GetAmpUrlsInstance;
+  end;
+
+implementation
+
+
+{ --------------------------------------------------------------------
+  TAmpUrl
+  --------------------------------------------------------------------}
+
+
+Procedure TAmpUrl.SetampUrl(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FampUrl=AValue) then exit;
+  FampUrl:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TAmpUrl.SetoriginalUrl(AIndex : Integer; const AValue : String); 
+
+begin
+  If (ForiginalUrl=AValue) then exit;
+  ForiginalUrl:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TAmpUrl.SetcdnAmpUrl(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FcdnAmpUrl=AValue) then exit;
+  FcdnAmpUrl:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+
+
+{ --------------------------------------------------------------------
+  TAmpUrlError
+  --------------------------------------------------------------------}
+
+
+Procedure TAmpUrlError.SetoriginalUrl(AIndex : Integer; const AValue : String); 
+
+begin
+  If (ForiginalUrl=AValue) then exit;
+  ForiginalUrl:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TAmpUrlError.SeterrorCode(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FerrorCode=AValue) then exit;
+  FerrorCode:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TAmpUrlError.SeterrorMessage(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FerrorMessage=AValue) then exit;
+  FerrorMessage:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+
+
+{ --------------------------------------------------------------------
+  TBatchGetAmpUrlsRequest
+  --------------------------------------------------------------------}
+
+
+Procedure TBatchGetAmpUrlsRequest.Seturls(AIndex : Integer; const AValue : TStringArray); 
+
+begin
+  If (Furls=AValue) then exit;
+  Furls:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+//2.6.4. bug workaround
+{$IFDEF VER2_6}
+Procedure TBatchGetAmpUrlsRequest.SetArrayLength(Const AName : String; ALength : Longint); 
+
+begin
+  Case AName of
+  'urls' : SetLength(Furls,ALength);
+  else
+    Inherited SetArrayLength(AName,ALength);
+  end;
+end;
+{$ENDIF VER2_6}
+
+
+
+
+{ --------------------------------------------------------------------
+  TBatchGetAmpUrlsResponse
+  --------------------------------------------------------------------}
+
+
+Procedure TBatchGetAmpUrlsResponse.SeturlErrors(AIndex : Integer; const AValue : TBatchGetAmpUrlsResponseTypeurlErrorsArray); 
+
+begin
+  If (FurlErrors=AValue) then exit;
+  FurlErrors:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TBatchGetAmpUrlsResponse.SetampUrls(AIndex : Integer; const AValue : TBatchGetAmpUrlsResponseTypeampUrlsArray); 
+
+begin
+  If (FampUrls=AValue) then exit;
+  FampUrls:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+//2.6.4. bug workaround
+{$IFDEF VER2_6}
+Procedure TBatchGetAmpUrlsResponse.SetArrayLength(Const AName : String; ALength : Longint); 
+
+begin
+  Case AName of
+  'urlerrors' : SetLength(FurlErrors,ALength);
+  'ampurls' : SetLength(FampUrls,ALength);
+  else
+    Inherited SetArrayLength(AName,ALength);
+  end;
+end;
+{$ENDIF VER2_6}
+
+
+
+
+{ --------------------------------------------------------------------
+  TAmpUrlsResource
+  --------------------------------------------------------------------}
+
+
+Class Function TAmpUrlsResource.ResourceName : String;
+
+begin
+  Result:='ampUrls';
+end;
+
+Class Function TAmpUrlsResource.DefaultAPI : TGoogleAPIClass;
+
+begin
+  Result:=TacceleratedmobilepageurlAPI;
+end;
+
+Function TAmpUrlsResource.BatchGet(aBatchGetAmpUrlsRequest : TBatchGetAmpUrlsRequest) : TBatchGetAmpUrlsResponse;
+
+Const
+  _HTTPMethod = 'POST';
+  _Path       = 'v1/ampUrls:batchGet';
+  _Methodid   = 'acceleratedmobilepageurl.ampUrls.batchGet';
+
+begin
+  Result:=ServiceCall(_HTTPMethod,_Path,'',aBatchGetAmpUrlsRequest,TBatchGetAmpUrlsResponse) as TBatchGetAmpUrlsResponse;
+end;
+
+
+
+{ --------------------------------------------------------------------
+  TAcceleratedmobilepageurlAPI
+  --------------------------------------------------------------------}
+
+Class Function TAcceleratedmobilepageurlAPI.APIName : String;
+
+begin
+  Result:='acceleratedmobilepageurl';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIVersion : String;
+
+begin
+  Result:='v1';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIRevision : String;
+
+begin
+  Result:='20160518';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIID : String;
+
+begin
+  Result:='acceleratedmobilepageurl:v1';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APITitle : String;
+
+begin
+  Result:='Accelerated Mobile Page (AMP) URL API';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIDescription : String;
+
+begin
+  Result:='This API contains a single method, [batchGet](/amp/cache/reference/acceleratedmobilepageurl/rest/v1/ampUrls/batchGet). Call this method to retrieve the AMP URL (and equivalent AMP Cache URL) for given public URL(s). For more information, see [Link to AMP Content](/amp/cache/use-amp-url).';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIOwnerDomain : String;
+
+begin
+  Result:='google.com';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIOwnerName : String;
+
+begin
+  Result:='Google';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIIcon16 : String;
+
+begin
+  Result:='http://www.google.com/images/icons/product/search-16.gif';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIIcon32 : String;
+
+begin
+  Result:='http://www.google.com/images/icons/product/search-32.gif';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIdocumentationLink : String;
+
+begin
+  Result:='https://developers.google.com/amp/cache/';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIrootUrl : string;
+
+begin
+  Result:='https://acceleratedmobilepageurl.googleapis.com/';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIbasePath : string;
+
+begin
+  Result:='';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIbaseURL : String;
+
+begin
+  Result:='https://acceleratedmobilepageurl.googleapis.com/';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIProtocol : string;
+
+begin
+  Result:='rest';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIservicePath : string;
+
+begin
+  Result:='';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIbatchPath : String;
+
+begin
+  Result:='batch';
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APIAuthScopes : TScopeInfoArray;
+
+begin
+  SetLength(Result,0);
+  
+end;
+
+Class Function TAcceleratedmobilepageurlAPI.APINeedsAuth : Boolean;
+
+begin
+  Result:=False;
+end;
+
+Class Procedure TAcceleratedmobilepageurlAPI.RegisterAPIResources;
+
+begin
+  TAmpUrl.RegisterObject;
+  TAmpUrlError.RegisterObject;
+  TBatchGetAmpUrlsRequest.RegisterObject;
+  TBatchGetAmpUrlsResponse.RegisterObject;
+end;
+
+
+Function TAcceleratedmobilepageurlAPI.GetAmpUrlsInstance : TAmpUrlsResource;
+
+begin
+  if (FAmpUrlsInstance=Nil) then
+    FAmpUrlsInstance:=CreateAmpUrlsResource;
+  Result:=FAmpUrlsInstance;
+end;
+
+Function TAcceleratedmobilepageurlAPI.CreateAmpUrlsResource : TAmpUrlsResource;
+
+begin
+  Result:=CreateAmpUrlsResource(Self);
+end;
+
+
+Function TAcceleratedmobilepageurlAPI.CreateAmpUrlsResource(AOwner : TComponent) : TAmpUrlsResource;
+
+begin
+  Result:=TAmpUrlsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+initialization
+  TAcceleratedmobilepageurlAPI.RegisterAPI;
+end.

packages/googleapi/src/googleadexchangebuyer2.pp

@@ -0,0 +1,1252 @@
+unit googleadexchangebuyer2;
+{$MODE objfpc}
+{$H+}
+
+interface
+
+uses sysutils, classes, googleservice, restbase, googlebase;
+
+type
+  
+  //Top-level schema types
+  TClientUser = Class;
+  TClientUserInvitation = Class;
+  TListClientUserInvitationsResponse = Class;
+  TListClientUsersResponse = Class;
+  TClient = Class;
+  TListClientsResponse = Class;
+  TClientUserArray = Array of TClientUser;
+  TClientUserInvitationArray = Array of TClientUserInvitation;
+  TListClientUserInvitationsResponseArray = Array of TListClientUserInvitationsResponse;
+  TListClientUsersResponseArray = Array of TListClientUsersResponse;
+  TClientArray = Array of TClient;
+  TListClientsResponseArray = Array of TListClientsResponse;
+  //Anonymous types, using auto-generated names
+  TListClientUserInvitationsResponseTypeinvitationsArray = Array of TClientUserInvitation;
+  TListClientUsersResponseTypeusersArray = Array of TClientUser;
+  TListClientsResponseTypeclientsArray = Array of TClient;
+  
+  { --------------------------------------------------------------------
+    TClientUser
+    --------------------------------------------------------------------}
+  
+  TClientUser = Class(TGoogleBaseObject)
+  Private
+    Femail : String;
+    FclientAccountId : String;
+    Fstatus : String;
+    FuserId : String;
+  Protected
+    //Property setters
+    Procedure Setemail(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetclientAccountId(AIndex : Integer; const AValue : String); virtual;
+    Procedure Setstatus(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetuserId(AIndex : Integer; const AValue : String); virtual;
+  Public
+  Published
+    Property email : String Index 0 Read Femail Write Setemail;
+    Property clientAccountId : String Index 8 Read FclientAccountId Write SetclientAccountId;
+    Property status : String Index 16 Read Fstatus Write Setstatus;
+    Property userId : String Index 24 Read FuserId Write SetuserId;
+  end;
+  TClientUserClass = Class of TClientUser;
+  
+  { --------------------------------------------------------------------
+    TClientUserInvitation
+    --------------------------------------------------------------------}
+  
+  TClientUserInvitation = Class(TGoogleBaseObject)
+  Private
+    Femail : String;
+    FclientAccountId : String;
+    FinvitationId : String;
+  Protected
+    //Property setters
+    Procedure Setemail(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetclientAccountId(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetinvitationId(AIndex : Integer; const AValue : String); virtual;
+  Public
+  Published
+    Property email : String Index 0 Read Femail Write Setemail;
+    Property clientAccountId : String Index 8 Read FclientAccountId Write SetclientAccountId;
+    Property invitationId : String Index 16 Read FinvitationId Write SetinvitationId;
+  end;
+  TClientUserInvitationClass = Class of TClientUserInvitation;
+  
+  { --------------------------------------------------------------------
+    TListClientUserInvitationsResponse
+    --------------------------------------------------------------------}
+  
+  TListClientUserInvitationsResponse = Class(TGoogleBaseObject)
+  Private
+    FnextPageToken : String;
+    Finvitations : TListClientUserInvitationsResponseTypeinvitationsArray;
+  Protected
+    //Property setters
+    Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
+    Procedure Setinvitations(AIndex : Integer; const AValue : TListClientUserInvitationsResponseTypeinvitationsArray); virtual;
+    //2.6.4. bug workaround
+    {$IFDEF VER2_6}
+    Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
+    {$ENDIF VER2_6}
+  Public
+  Published
+    Property nextPageToken : String Index 0 Read FnextPageToken Write SetnextPageToken;
+    Property invitations : TListClientUserInvitationsResponseTypeinvitationsArray Index 8 Read Finvitations Write Setinvitations;
+  end;
+  TListClientUserInvitationsResponseClass = Class of TListClientUserInvitationsResponse;
+  
+  { --------------------------------------------------------------------
+    TListClientUsersResponse
+    --------------------------------------------------------------------}
+  
+  TListClientUsersResponse = Class(TGoogleBaseObject)
+  Private
+    Fusers : TListClientUsersResponseTypeusersArray;
+    FnextPageToken : String;
+  Protected
+    //Property setters
+    Procedure Setusers(AIndex : Integer; const AValue : TListClientUsersResponseTypeusersArray); virtual;
+    Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
+    //2.6.4. bug workaround
+    {$IFDEF VER2_6}
+    Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
+    {$ENDIF VER2_6}
+  Public
+  Published
+    Property users : TListClientUsersResponseTypeusersArray Index 0 Read Fusers Write Setusers;
+    Property nextPageToken : String Index 8 Read FnextPageToken Write SetnextPageToken;
+  end;
+  TListClientUsersResponseClass = Class of TListClientUsersResponse;
+  
+  { --------------------------------------------------------------------
+    TClient
+    --------------------------------------------------------------------}
+  
+  TClient = Class(TGoogleBaseObject)
+  Private
+    FvisibleToSeller : boolean;
+    Fstatus : String;
+    FentityType : String;
+    Frole : String;
+    FclientName : String;
+    FclientAccountId : String;
+    FentityId : String;
+    FentityName : String;
+  Protected
+    //Property setters
+    Procedure SetvisibleToSeller(AIndex : Integer; const AValue : boolean); virtual;
+    Procedure Setstatus(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetentityType(AIndex : Integer; const AValue : String); virtual;
+    Procedure Setrole(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetclientName(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetclientAccountId(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetentityId(AIndex : Integer; const AValue : String); virtual;
+    Procedure SetentityName(AIndex : Integer; const AValue : String); virtual;
+  Public
+  Published
+    Property visibleToSeller : boolean Index 0 Read FvisibleToSeller Write SetvisibleToSeller;
+    Property status : String Index 8 Read Fstatus Write Setstatus;
+    Property entityType : String Index 16 Read FentityType Write SetentityType;
+    Property role : String Index 24 Read Frole Write Setrole;
+    Property clientName : String Index 32 Read FclientName Write SetclientName;
+    Property clientAccountId : String Index 40 Read FclientAccountId Write SetclientAccountId;
+    Property entityId : String Index 48 Read FentityId Write SetentityId;
+    Property entityName : String Index 56 Read FentityName Write SetentityName;
+  end;
+  TClientClass = Class of TClient;
+  
+  { --------------------------------------------------------------------
+    TListClientsResponse
+    --------------------------------------------------------------------}
+  
+  TListClientsResponse = Class(TGoogleBaseObject)
+  Private
+    FnextPageToken : String;
+    Fclients : TListClientsResponseTypeclientsArray;
+  Protected
+    //Property setters
+    Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
+    Procedure Setclients(AIndex : Integer; const AValue : TListClientsResponseTypeclientsArray); virtual;
+    //2.6.4. bug workaround
+    {$IFDEF VER2_6}
+    Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
+    {$ENDIF VER2_6}
+  Public
+  Published
+    Property nextPageToken : String Index 0 Read FnextPageToken Write SetnextPageToken;
+    Property clients : TListClientsResponseTypeclientsArray Index 8 Read Fclients Write Setclients;
+  end;
+  TListClientsResponseClass = Class of TListClientsResponse;
+  
+  { --------------------------------------------------------------------
+    TAccountsClientsUsersResource
+    --------------------------------------------------------------------}
+  
+  
+  //Optional query Options for TAccountsClientsUsersResource, method List
+  
+  TAccountsClientsUsersListOptions = Record
+    pageSize : integer;
+    pageToken : String;
+  end;
+  
+  TAccountsClientsUsersResource = Class(TGoogleResource)
+  Public
+    Class Function ResourceName : String; override;
+    Class Function DefaultAPI : TGoogleAPIClass; override;
+    Function Update(clientAccountId: string; userId: string; accountId: string; aClientUser : TClientUser) : TClientUser;
+    Function Get(clientAccountId: string; userId: string; accountId: string) : TClientUser;
+    Function List(clientAccountId: string; accountId: string; AQuery : string  = '') : TListClientUsersResponse;
+    Function List(clientAccountId: string; accountId: string; AQuery : TAccountsClientsUserslistOptions) : TListClientUsersResponse;
+  end;
+  
+  
+  { --------------------------------------------------------------------
+    TAccountsClientsInvitationsResource
+    --------------------------------------------------------------------}
+  
+  
+  //Optional query Options for TAccountsClientsInvitationsResource, method List
+  
+  TAccountsClientsInvitationsListOptions = Record
+    pageSize : integer;
+    pageToken : String;
+  end;
+  
+  TAccountsClientsInvitationsResource = Class(TGoogleResource)
+  Public
+    Class Function ResourceName : String; override;
+    Class Function DefaultAPI : TGoogleAPIClass; override;
+    Function Create(clientAccountId: string; accountId: string; aClientUserInvitation : TClientUserInvitation) : TClientUserInvitation;overload;
+    Function Get(clientAccountId: string; invitationId: string; accountId: string) : TClientUserInvitation;
+    Function List(clientAccountId: string; accountId: string; AQuery : string  = '') : TListClientUserInvitationsResponse;
+    Function List(clientAccountId: string; accountId: string; AQuery : TAccountsClientsInvitationslistOptions) : TListClientUserInvitationsResponse;
+  end;
+  
+  
+  { --------------------------------------------------------------------
+    TAccountsClientsResource
+    --------------------------------------------------------------------}
+  
+  
+  //Optional query Options for TAccountsClientsResource, method List
+  
+  TAccountsClientsListOptions = Record
+    pageSize : integer;
+    pageToken : String;
+  end;
+  
+  TAccountsClientsResource = Class(TGoogleResource)
+  Private
+    FUsersInstance : TAccountsClientsUsersResource;
+    FInvitationsInstance : TAccountsClientsInvitationsResource;
+    Function GetUsersInstance : TAccountsClientsUsersResource;virtual;
+    Function GetInvitationsInstance : TAccountsClientsInvitationsResource;virtual;
+  Public
+    Class Function ResourceName : String; override;
+    Class Function DefaultAPI : TGoogleAPIClass; override;
+    Function Update(clientAccountId: string; accountId: string; aClient : TClient) : TClient;
+    Function Get(clientAccountId: string; accountId: string) : TClient;
+    Function Create(accountId: string; aClient : TClient) : TClient;overload;
+    Function List(accountId: string; AQuery : string  = '') : TListClientsResponse;
+    Function List(accountId: string; AQuery : TAccountsClientslistOptions) : TListClientsResponse;
+    Function CreateUsersResource(AOwner : TComponent) : TAccountsClientsUsersResource;virtual;overload;
+    Function CreateUsersResource : TAccountsClientsUsersResource;virtual;overload;
+    Function CreateInvitationsResource(AOwner : TComponent) : TAccountsClientsInvitationsResource;virtual;overload;
+    Function CreateInvitationsResource : TAccountsClientsInvitationsResource;virtual;overload;
+    Property UsersResource : TAccountsClientsUsersResource Read GetUsersInstance;
+    Property InvitationsResource : TAccountsClientsInvitationsResource Read GetInvitationsInstance;
+  end;
+  
+  
+  { --------------------------------------------------------------------
+    TAccountsResource
+    --------------------------------------------------------------------}
+  
+  TAccountsResource = Class(TGoogleResource)
+  Private
+    FClientsUsersInstance : TAccountsClientsUsersResource;
+    FClientsInvitationsInstance : TAccountsClientsInvitationsResource;
+    FClientsInstance : TAccountsClientsResource;
+    Function GetClientsUsersInstance : TAccountsClientsUsersResource;virtual;
+    Function GetClientsInvitationsInstance : TAccountsClientsInvitationsResource;virtual;
+    Function GetClientsInstance : TAccountsClientsResource;virtual;
+  Public
+    Class Function ResourceName : String; override;
+    Class Function DefaultAPI : TGoogleAPIClass; override;
+    Function CreateClientsUsersResource(AOwner : TComponent) : TAccountsClientsUsersResource;virtual;overload;
+    Function CreateClientsUsersResource : TAccountsClientsUsersResource;virtual;overload;
+    Function CreateClientsInvitationsResource(AOwner : TComponent) : TAccountsClientsInvitationsResource;virtual;overload;
+    Function CreateClientsInvitationsResource : TAccountsClientsInvitationsResource;virtual;overload;
+    Function CreateClientsResource(AOwner : TComponent) : TAccountsClientsResource;virtual;overload;
+    Function CreateClientsResource : TAccountsClientsResource;virtual;overload;
+    Property ClientsUsersResource : TAccountsClientsUsersResource Read GetClientsUsersInstance;
+    Property ClientsInvitationsResource : TAccountsClientsInvitationsResource Read GetClientsInvitationsInstance;
+    Property ClientsResource : TAccountsClientsResource Read GetClientsInstance;
+  end;
+  
+  
+  { --------------------------------------------------------------------
+    TAdexchangebuyer2API
+    --------------------------------------------------------------------}
+  
+  TAdexchangebuyer2API = Class(TGoogleAPI)
+  Private
+    FAccountsClientsUsersInstance : TAccountsClientsUsersResource;
+    FAccountsClientsInvitationsInstance : TAccountsClientsInvitationsResource;
+    FAccountsClientsInstance : TAccountsClientsResource;
+    FAccountsInstance : TAccountsResource;
+    Function GetAccountsClientsUsersInstance : TAccountsClientsUsersResource;virtual;
+    Function GetAccountsClientsInvitationsInstance : TAccountsClientsInvitationsResource;virtual;
+    Function GetAccountsClientsInstance : TAccountsClientsResource;virtual;
+    Function GetAccountsInstance : TAccountsResource;virtual;
+  Public
+    //Override class functions with API info
+    Class Function APIName : String; override;
+    Class Function APIVersion : String; override;
+    Class Function APIRevision : String; override;
+    Class Function APIID : String; override;
+    Class Function APITitle : String; override;
+    Class Function APIDescription : String; override;
+    Class Function APIOwnerDomain : String; override;
+    Class Function APIOwnerName : String; override;
+    Class Function APIIcon16 : String; override;
+    Class Function APIIcon32 : String; override;
+    Class Function APIdocumentationLink : String; override;
+    Class Function APIrootUrl : string; override;
+    Class Function APIbasePath : string;override;
+    Class Function APIbaseURL : String;override;
+    Class Function APIProtocol : string;override;
+    Class Function APIservicePath : string;override;
+    Class Function APIbatchPath : String;override;
+    Class Function APIAuthScopes : TScopeInfoArray;override;
+    Class Function APINeedsAuth : Boolean;override;
+    Class Procedure RegisterAPIResources; override;
+    //Add create function for resources
+    Function CreateAccountsClientsUsersResource(AOwner : TComponent) : TAccountsClientsUsersResource;virtual;overload;
+    Function CreateAccountsClientsUsersResource : TAccountsClientsUsersResource;virtual;overload;
+    Function CreateAccountsClientsInvitationsResource(AOwner : TComponent) : TAccountsClientsInvitationsResource;virtual;overload;
+    Function CreateAccountsClientsInvitationsResource : TAccountsClientsInvitationsResource;virtual;overload;
+    Function CreateAccountsClientsResource(AOwner : TComponent) : TAccountsClientsResource;virtual;overload;
+    Function CreateAccountsClientsResource : TAccountsClientsResource;virtual;overload;
+    Function CreateAccountsResource(AOwner : TComponent) : TAccountsResource;virtual;overload;
+    Function CreateAccountsResource : TAccountsResource;virtual;overload;
+    //Add default on-demand instances for resources
+    Property AccountsClientsUsersResource : TAccountsClientsUsersResource Read GetAccountsClientsUsersInstance;
+    Property AccountsClientsInvitationsResource : TAccountsClientsInvitationsResource Read GetAccountsClientsInvitationsInstance;
+    Property AccountsClientsResource : TAccountsClientsResource Read GetAccountsClientsInstance;
+    Property AccountsResource : TAccountsResource Read GetAccountsInstance;
+  end;
+
+implementation
+
+
+{ --------------------------------------------------------------------
+  TClientUser
+  --------------------------------------------------------------------}
+
+
+Procedure TClientUser.Setemail(AIndex : Integer; const AValue : String); 
+
+begin
+  If (Femail=AValue) then exit;
+  Femail:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClientUser.SetclientAccountId(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FclientAccountId=AValue) then exit;
+  FclientAccountId:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClientUser.Setstatus(AIndex : Integer; const AValue : String); 
+
+begin
+  If (Fstatus=AValue) then exit;
+  Fstatus:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClientUser.SetuserId(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FuserId=AValue) then exit;
+  FuserId:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+
+
+{ --------------------------------------------------------------------
+  TClientUserInvitation
+  --------------------------------------------------------------------}
+
+
+Procedure TClientUserInvitation.Setemail(AIndex : Integer; const AValue : String); 
+
+begin
+  If (Femail=AValue) then exit;
+  Femail:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClientUserInvitation.SetclientAccountId(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FclientAccountId=AValue) then exit;
+  FclientAccountId:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClientUserInvitation.SetinvitationId(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FinvitationId=AValue) then exit;
+  FinvitationId:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+
+
+{ --------------------------------------------------------------------
+  TListClientUserInvitationsResponse
+  --------------------------------------------------------------------}
+
+
+Procedure TListClientUserInvitationsResponse.SetnextPageToken(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FnextPageToken=AValue) then exit;
+  FnextPageToken:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TListClientUserInvitationsResponse.Setinvitations(AIndex : Integer; const AValue : TListClientUserInvitationsResponseTypeinvitationsArray); 
+
+begin
+  If (Finvitations=AValue) then exit;
+  Finvitations:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+//2.6.4. bug workaround
+{$IFDEF VER2_6}
+Procedure TListClientUserInvitationsResponse.SetArrayLength(Const AName : String; ALength : Longint); 
+
+begin
+  Case AName of
+  'invitations' : SetLength(Finvitations,ALength);
+  else
+    Inherited SetArrayLength(AName,ALength);
+  end;
+end;
+{$ENDIF VER2_6}
+
+
+
+
+{ --------------------------------------------------------------------
+  TListClientUsersResponse
+  --------------------------------------------------------------------}
+
+
+Procedure TListClientUsersResponse.Setusers(AIndex : Integer; const AValue : TListClientUsersResponseTypeusersArray); 
+
+begin
+  If (Fusers=AValue) then exit;
+  Fusers:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TListClientUsersResponse.SetnextPageToken(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FnextPageToken=AValue) then exit;
+  FnextPageToken:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+//2.6.4. bug workaround
+{$IFDEF VER2_6}
+Procedure TListClientUsersResponse.SetArrayLength(Const AName : String; ALength : Longint); 
+
+begin
+  Case AName of
+  'users' : SetLength(Fusers,ALength);
+  else
+    Inherited SetArrayLength(AName,ALength);
+  end;
+end;
+{$ENDIF VER2_6}
+
+
+
+
+{ --------------------------------------------------------------------
+  TClient
+  --------------------------------------------------------------------}
+
+
+Procedure TClient.SetvisibleToSeller(AIndex : Integer; const AValue : boolean); 
+
+begin
+  If (FvisibleToSeller=AValue) then exit;
+  FvisibleToSeller:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.Setstatus(AIndex : Integer; const AValue : String); 
+
+begin
+  If (Fstatus=AValue) then exit;
+  Fstatus:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.SetentityType(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FentityType=AValue) then exit;
+  FentityType:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.Setrole(AIndex : Integer; const AValue : String); 
+
+begin
+  If (Frole=AValue) then exit;
+  Frole:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.SetclientName(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FclientName=AValue) then exit;
+  FclientName:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.SetclientAccountId(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FclientAccountId=AValue) then exit;
+  FclientAccountId:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.SetentityId(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FentityId=AValue) then exit;
+  FentityId:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TClient.SetentityName(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FentityName=AValue) then exit;
+  FentityName:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+
+
+{ --------------------------------------------------------------------
+  TListClientsResponse
+  --------------------------------------------------------------------}
+
+
+Procedure TListClientsResponse.SetnextPageToken(AIndex : Integer; const AValue : String); 
+
+begin
+  If (FnextPageToken=AValue) then exit;
+  FnextPageToken:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+
+Procedure TListClientsResponse.Setclients(AIndex : Integer; const AValue : TListClientsResponseTypeclientsArray); 
+
+begin
+  If (Fclients=AValue) then exit;
+  Fclients:=AValue;
+  MarkPropertyChanged(AIndex);
+end;
+
+
+//2.6.4. bug workaround
+{$IFDEF VER2_6}
+Procedure TListClientsResponse.SetArrayLength(Const AName : String; ALength : Longint); 
+
+begin
+  Case AName of
+  'clients' : SetLength(Fclients,ALength);
+  else
+    Inherited SetArrayLength(AName,ALength);
+  end;
+end;
+{$ENDIF VER2_6}
+
+
+
+
+{ --------------------------------------------------------------------
+  TAccountsClientsUsersResource
+  --------------------------------------------------------------------}
+
+
+Class Function TAccountsClientsUsersResource.ResourceName : String;
+
+begin
+  Result:='users';
+end;
+
+Class Function TAccountsClientsUsersResource.DefaultAPI : TGoogleAPIClass;
+
+begin
+  Result:=Tadexchangebuyer2API;
+end;
+
+Function TAccountsClientsUsersResource.Update(clientAccountId: string; userId: string; accountId: string; aClientUser : TClientUser) : TClientUser;
+
+Const
+  _HTTPMethod = 'PUT';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}/users/{userId}';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.users.update';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'userId',userId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',aClientUser,TClientUser) as TClientUser;
+end;
+
+Function TAccountsClientsUsersResource.Get(clientAccountId: string; userId: string; accountId: string) : TClientUser;
+
+Const
+  _HTTPMethod = 'GET';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}/users/{userId}';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.users.get';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'userId',userId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',Nil,TClientUser) as TClientUser;
+end;
+
+Function TAccountsClientsUsersResource.List(clientAccountId: string; accountId: string; AQuery : string = '') : TListClientUsersResponse;
+
+Const
+  _HTTPMethod = 'GET';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}/users';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.users.list';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,AQuery,Nil,TListClientUsersResponse) as TListClientUsersResponse;
+end;
+
+
+Function TAccountsClientsUsersResource.List(clientAccountId: string; accountId: string; AQuery : TAccountsClientsUserslistOptions) : TListClientUsersResponse;
+
+Var
+  _Q : String;
+
+begin
+  _Q:='';
+  AddToQuery(_Q,'pageSize',AQuery.pageSize);
+  AddToQuery(_Q,'pageToken',AQuery.pageToken);
+  Result:=List(clientAccountId,accountId,_Q);
+end;
+
+
+
+{ --------------------------------------------------------------------
+  TAccountsClientsInvitationsResource
+  --------------------------------------------------------------------}
+
+
+Class Function TAccountsClientsInvitationsResource.ResourceName : String;
+
+begin
+  Result:='invitations';
+end;
+
+Class Function TAccountsClientsInvitationsResource.DefaultAPI : TGoogleAPIClass;
+
+begin
+  Result:=Tadexchangebuyer2API;
+end;
+
+Function TAccountsClientsInvitationsResource.Create(clientAccountId: string; accountId: string; aClientUserInvitation : TClientUserInvitation) : TClientUserInvitation;
+
+Const
+  _HTTPMethod = 'POST';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}/invitations';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.invitations.create';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',aClientUserInvitation,TClientUserInvitation) as TClientUserInvitation;
+end;
+
+Function TAccountsClientsInvitationsResource.Get(clientAccountId: string; invitationId: string; accountId: string) : TClientUserInvitation;
+
+Const
+  _HTTPMethod = 'GET';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}/invitations/{invitationId}';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.invitations.get';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'invitationId',invitationId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',Nil,TClientUserInvitation) as TClientUserInvitation;
+end;
+
+Function TAccountsClientsInvitationsResource.List(clientAccountId: string; accountId: string; AQuery : string = '') : TListClientUserInvitationsResponse;
+
+Const
+  _HTTPMethod = 'GET';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}/invitations';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.invitations.list';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,AQuery,Nil,TListClientUserInvitationsResponse) as TListClientUserInvitationsResponse;
+end;
+
+
+Function TAccountsClientsInvitationsResource.List(clientAccountId: string; accountId: string; AQuery : TAccountsClientsInvitationslistOptions) : TListClientUserInvitationsResponse;
+
+Var
+  _Q : String;
+
+begin
+  _Q:='';
+  AddToQuery(_Q,'pageSize',AQuery.pageSize);
+  AddToQuery(_Q,'pageToken',AQuery.pageToken);
+  Result:=List(clientAccountId,accountId,_Q);
+end;
+
+
+
+{ --------------------------------------------------------------------
+  TAccountsClientsResource
+  --------------------------------------------------------------------}
+
+
+Class Function TAccountsClientsResource.ResourceName : String;
+
+begin
+  Result:='clients';
+end;
+
+Class Function TAccountsClientsResource.DefaultAPI : TGoogleAPIClass;
+
+begin
+  Result:=Tadexchangebuyer2API;
+end;
+
+Function TAccountsClientsResource.Update(clientAccountId: string; accountId: string; aClient : TClient) : TClient;
+
+Const
+  _HTTPMethod = 'PUT';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.update';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',aClient,TClient) as TClient;
+end;
+
+Function TAccountsClientsResource.Get(clientAccountId: string; accountId: string) : TClient;
+
+Const
+  _HTTPMethod = 'GET';
+  _Path       = 'v2beta1/accounts/{accountId}/clients/{clientAccountId}';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.get';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['clientAccountId',clientAccountId,'accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',Nil,TClient) as TClient;
+end;
+
+Function TAccountsClientsResource.Create(accountId: string; aClient : TClient) : TClient;
+
+Const
+  _HTTPMethod = 'POST';
+  _Path       = 'v2beta1/accounts/{accountId}/clients';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.create';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,'',aClient,TClient) as TClient;
+end;
+
+Function TAccountsClientsResource.List(accountId: string; AQuery : string = '') : TListClientsResponse;
+
+Const
+  _HTTPMethod = 'GET';
+  _Path       = 'v2beta1/accounts/{accountId}/clients';
+  _Methodid   = 'adexchangebuyer2.accounts.clients.list';
+
+Var
+  _P : String;
+
+begin
+  _P:=SubstitutePath(_Path,['accountId',accountId]);
+  Result:=ServiceCall(_HTTPMethod,_P,AQuery,Nil,TListClientsResponse) as TListClientsResponse;
+end;
+
+
+Function TAccountsClientsResource.List(accountId: string; AQuery : TAccountsClientslistOptions) : TListClientsResponse;
+
+Var
+  _Q : String;
+
+begin
+  _Q:='';
+  AddToQuery(_Q,'pageSize',AQuery.pageSize);
+  AddToQuery(_Q,'pageToken',AQuery.pageToken);
+  Result:=List(accountId,_Q);
+end;
+
+
+
+Function TAccountsClientsResource.GetUsersInstance : TAccountsClientsUsersResource;
+
+begin
+  if (FUsersInstance=Nil) then
+    FUsersInstance:=CreateUsersResource;
+  Result:=FUsersInstance;
+end;
+
+Function TAccountsClientsResource.CreateUsersResource : TAccountsClientsUsersResource;
+
+begin
+  Result:=CreateUsersResource(Self);
+end;
+
+
+Function TAccountsClientsResource.CreateUsersResource(AOwner : TComponent) : TAccountsClientsUsersResource;
+
+begin
+  Result:=TAccountsClientsUsersResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+Function TAccountsClientsResource.GetInvitationsInstance : TAccountsClientsInvitationsResource;
+
+begin
+  if (FInvitationsInstance=Nil) then
+    FInvitationsInstance:=CreateInvitationsResource;
+  Result:=FInvitationsInstance;
+end;
+
+Function TAccountsClientsResource.CreateInvitationsResource : TAccountsClientsInvitationsResource;
+
+begin
+  Result:=CreateInvitationsResource(Self);
+end;
+
+
+Function TAccountsClientsResource.CreateInvitationsResource(AOwner : TComponent) : TAccountsClientsInvitationsResource;
+
+begin
+  Result:=TAccountsClientsInvitationsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+{ --------------------------------------------------------------------
+  TAccountsResource
+  --------------------------------------------------------------------}
+
+
+Class Function TAccountsResource.ResourceName : String;
+
+begin
+  Result:='accounts';
+end;
+
+Class Function TAccountsResource.DefaultAPI : TGoogleAPIClass;
+
+begin
+  Result:=Tadexchangebuyer2API;
+end;
+
+
+
+Function TAccountsResource.GetClientsUsersInstance : TAccountsClientsUsersResource;
+
+begin
+  if (FClientsUsersInstance=Nil) then
+    FClientsUsersInstance:=CreateClientsUsersResource;
+  Result:=FClientsUsersInstance;
+end;
+
+Function TAccountsResource.CreateClientsUsersResource : TAccountsClientsUsersResource;
+
+begin
+  Result:=CreateClientsUsersResource(Self);
+end;
+
+
+Function TAccountsResource.CreateClientsUsersResource(AOwner : TComponent) : TAccountsClientsUsersResource;
+
+begin
+  Result:=TAccountsClientsUsersResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+Function TAccountsResource.GetClientsInvitationsInstance : TAccountsClientsInvitationsResource;
+
+begin
+  if (FClientsInvitationsInstance=Nil) then
+    FClientsInvitationsInstance:=CreateClientsInvitationsResource;
+  Result:=FClientsInvitationsInstance;
+end;
+
+Function TAccountsResource.CreateClientsInvitationsResource : TAccountsClientsInvitationsResource;
+
+begin
+  Result:=CreateClientsInvitationsResource(Self);
+end;
+
+
+Function TAccountsResource.CreateClientsInvitationsResource(AOwner : TComponent) : TAccountsClientsInvitationsResource;
+
+begin
+  Result:=TAccountsClientsInvitationsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+Function TAccountsResource.GetClientsInstance : TAccountsClientsResource;
+
+begin
+  if (FClientsInstance=Nil) then
+    FClientsInstance:=CreateClientsResource;
+  Result:=FClientsInstance;
+end;
+
+Function TAccountsResource.CreateClientsResource : TAccountsClientsResource;
+
+begin
+  Result:=CreateClientsResource(Self);
+end;
+
+
+Function TAccountsResource.CreateClientsResource(AOwner : TComponent) : TAccountsClientsResource;
+
+begin
+  Result:=TAccountsClientsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+{ --------------------------------------------------------------------
+  TAdexchangebuyer2API
+  --------------------------------------------------------------------}
+
+Class Function TAdexchangebuyer2API.APIName : String;
+
+begin
+  Result:='adexchangebuyer2';
+end;
+
+Class Function TAdexchangebuyer2API.APIVersion : String;
+
+begin
+  Result:='v2beta1';
+end;
+
+Class Function TAdexchangebuyer2API.APIRevision : String;
+
+begin
+  Result:='20160519';
+end;
+
+Class Function TAdexchangebuyer2API.APIID : String;
+
+begin
+  Result:='adexchangebuyer2:v2beta1';
+end;
+
+Class Function TAdexchangebuyer2API.APITitle : String;
+
+begin
+  Result:='Ad Exchange Buyer API II';
+end;
+
+Class Function TAdexchangebuyer2API.APIDescription : String;
+
+begin
+  Result:='Accesses the latest features for managing Ad Exchange accounts and Real-Time Bidding configurations.';
+end;
+
+Class Function TAdexchangebuyer2API.APIOwnerDomain : String;
+
+begin
+  Result:='google.com';
+end;
+
+Class Function TAdexchangebuyer2API.APIOwnerName : String;
+
+begin
+  Result:='Google';
+end;
+
+Class Function TAdexchangebuyer2API.APIIcon16 : String;
+
+begin
+  Result:='http://www.google.com/images/icons/product/search-16.gif';
+end;
+
+Class Function TAdexchangebuyer2API.APIIcon32 : String;
+
+begin
+  Result:='http://www.google.com/images/icons/product/search-32.gif';
+end;
+
+Class Function TAdexchangebuyer2API.APIdocumentationLink : String;
+
+begin
+  Result:='https://developers.google.com/ad-exchange/buyer-rest/guides/client-access/';
+end;
+
+Class Function TAdexchangebuyer2API.APIrootUrl : string;
+
+begin
+  Result:='https://adexchangebuyer.googleapis.com/';
+end;
+
+Class Function TAdexchangebuyer2API.APIbasePath : string;
+
+begin
+  Result:='';
+end;
+
+Class Function TAdexchangebuyer2API.APIbaseURL : String;
+
+begin
+  Result:='https://adexchangebuyer.googleapis.com/';
+end;
+
+Class Function TAdexchangebuyer2API.APIProtocol : string;
+
+begin
+  Result:='rest';
+end;
+
+Class Function TAdexchangebuyer2API.APIservicePath : string;
+
+begin
+  Result:='';
+end;
+
+Class Function TAdexchangebuyer2API.APIbatchPath : String;
+
+begin
+  Result:='batch';
+end;
+
+Class Function TAdexchangebuyer2API.APIAuthScopes : TScopeInfoArray;
+
+begin
+  SetLength(Result,1);
+  Result[0].Name:='https://www.googleapis.com/auth/adexchange.buyer';
+  Result[0].Description:='Manage your Ad Exchange buyer account configuration';
+  
+end;
+
+Class Function TAdexchangebuyer2API.APINeedsAuth : Boolean;
+
+begin
+  Result:=True;
+end;
+
+Class Procedure TAdexchangebuyer2API.RegisterAPIResources;
+
+begin
+  TClientUser.RegisterObject;
+  TClientUserInvitation.RegisterObject;
+  TListClientUserInvitationsResponse.RegisterObject;
+  TListClientUsersResponse.RegisterObject;
+  TClient.RegisterObject;
+  TListClientsResponse.RegisterObject;
+end;
+
+
+Function TAdexchangebuyer2API.GetAccountsClientsUsersInstance : TAccountsClientsUsersResource;
+
+begin
+  if (FAccountsClientsUsersInstance=Nil) then
+    FAccountsClientsUsersInstance:=CreateAccountsClientsUsersResource;
+  Result:=FAccountsClientsUsersInstance;
+end;
+
+Function TAdexchangebuyer2API.CreateAccountsClientsUsersResource : TAccountsClientsUsersResource;
+
+begin
+  Result:=CreateAccountsClientsUsersResource(Self);
+end;
+
+
+Function TAdexchangebuyer2API.CreateAccountsClientsUsersResource(AOwner : TComponent) : TAccountsClientsUsersResource;
+
+begin
+  Result:=TAccountsClientsUsersResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+Function TAdexchangebuyer2API.GetAccountsClientsInvitationsInstance : TAccountsClientsInvitationsResource;
+
+begin
+  if (FAccountsClientsInvitationsInstance=Nil) then
+    FAccountsClientsInvitationsInstance:=CreateAccountsClientsInvitationsResource;
+  Result:=FAccountsClientsInvitationsInstance;
+end;
+
+Function TAdexchangebuyer2API.CreateAccountsClientsInvitationsResource : TAccountsClientsInvitationsResource;
+
+begin
+  Result:=CreateAccountsClientsInvitationsResource(Self);
+end;
+
+
+Function TAdexchangebuyer2API.CreateAccountsClientsInvitationsResource(AOwner : TComponent) : TAccountsClientsInvitationsResource;
+
+begin
+  Result:=TAccountsClientsInvitationsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+Function TAdexchangebuyer2API.GetAccountsClientsInstance : TAccountsClientsResource;
+
+begin
+  if (FAccountsClientsInstance=Nil) then
+    FAccountsClientsInstance:=CreateAccountsClientsResource;
+  Result:=FAccountsClientsInstance;
+end;
+
+Function TAdexchangebuyer2API.CreateAccountsClientsResource : TAccountsClientsResource;
+
+begin
+  Result:=CreateAccountsClientsResource(Self);
+end;
+
+
+Function TAdexchangebuyer2API.CreateAccountsClientsResource(AOwner : TComponent) : TAccountsClientsResource;
+
+begin
+  Result:=TAccountsClientsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+Function TAdexchangebuyer2API.GetAccountsInstance : TAccountsResource;
+
+begin
+  if (FAccountsInstance=Nil) then
+    FAccountsInstance:=CreateAccountsResource;
+  Result:=FAccountsInstance;
+end;
+
+Function TAdexchangebuyer2API.CreateAccountsResource : TAccountsResource;
+
+begin
+  Result:=CreateAccountsResource(Self);
+end;
+
+
+Function TAdexchangebuyer2API.CreateAccountsResource(AOwner : TComponent) : TAccountsResource;
+
+begin
+  Result:=TAccountsResource.Create(AOwner);
+  Result.API:=Self.API;
+end;
+
+
+
+initialization
+  TAdexchangebuyer2API.RegisterAPI;
+end.

packages/googleapi/src/googleadexchangeseller.pp

@@ -1,19 +1,4 @@
 unit googleadexchangeseller;
-{
-   **********************************************************************
-      This file is part of the Free Component Library (FCL)
-      Copyright (c) 2015 The free pascal 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.
-  
-   **********************************************************************
-}
-//Generated on: 16-5-15 08:52:57
 {$MODE objfpc}
 {$H+}
 
@@ -107,7 +92,7 @@ type
   Protected
     //Property setters
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setitems(AIndex : Integer; AValue : TAccountsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TAccountsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -136,11 +121,11 @@ type
     FsupportsReporting : boolean;
   Protected
     //Property setters
-    Procedure SetarcOptIn(AIndex : Integer; AValue : boolean); virtual;
+    Procedure SetarcOptIn(AIndex : Integer; const AValue : boolean); virtual;
     Procedure Setid(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetproductCode(AIndex : Integer; const AValue : String); virtual;
-    Procedure SetsupportsReporting(AIndex : Integer; AValue : boolean); virtual;
+    Procedure SetsupportsReporting(AIndex : Integer; const AValue : boolean); virtual;
   Public
   Published
     Property arcOptIn : boolean Index 0 Read FarcOptIn Write SetarcOptIn;
@@ -164,7 +149,7 @@ type
   Protected
     //Property setters
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setitems(AIndex : Integer; AValue : TAdClientsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TAdClientsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -219,7 +204,7 @@ type
     Fkind : String;
   Protected
     //Property setters
-    Procedure Setitems(AIndex : Integer; AValue : TAlertsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TAlertsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
@@ -274,7 +259,7 @@ type
     Procedure Setid(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure Setname(AIndex : Integer; const AValue : String); virtual;
-    Procedure SettargetingInfo(AIndex : Integer; AValue : TCustomChannelTypetargetingInfo); virtual;
+    Procedure SettargetingInfo(AIndex : Integer; const AValue : TCustomChannelTypetargetingInfo); virtual;
   Public
   Published
     Property code : String Index 0 Read Fcode Write Setcode;
@@ -298,7 +283,7 @@ type
   Protected
     //Property setters
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setitems(AIndex : Integer; AValue : TCustomChannelsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TCustomChannelsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -324,7 +309,7 @@ type
     Fkind : String;
   Protected
     //Property setters
-    Procedure Setitems(AIndex : Integer; AValue : TMetadataTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TMetadataTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
@@ -384,7 +369,7 @@ type
     Fkind : String;
   Protected
     //Property setters
-    Procedure Setitems(AIndex : Integer; AValue : TPreferredDealsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TPreferredDealsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
@@ -435,13 +420,13 @@ type
     Fwarnings : TStringArray;
   Protected
     //Property setters
-    Procedure Setaverages(AIndex : Integer; AValue : TStringArray); virtual;
-    Procedure Setheaders(AIndex : Integer; AValue : TReportTypeheadersArray); virtual;
+    Procedure Setaverages(AIndex : Integer; const AValue : TStringArray); virtual;
+    Procedure Setheaders(AIndex : Integer; const AValue : TReportTypeheadersArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setrows(AIndex : Integer; AValue : TReportTyperowsArray); virtual;
+    Procedure Setrows(AIndex : Integer; const AValue : TReportTyperowsArray); virtual;
     Procedure SettotalMatchedRows(AIndex : Integer; const AValue : String); virtual;
-    Procedure Settotals(AIndex : Integer; AValue : TStringArray); virtual;
-    Procedure Setwarnings(AIndex : Integer; AValue : TStringArray); virtual;
+    Procedure Settotals(AIndex : Integer; const AValue : TStringArray); virtual;
+    Procedure Setwarnings(AIndex : Integer; const AValue : TStringArray); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
     Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
@@ -473,13 +458,13 @@ type
     FsupportedProducts : TStringArray;
   Protected
     //Property setters
-    Procedure SetcompatibleDimensions(AIndex : Integer; AValue : TStringArray); virtual;
-    Procedure SetcompatibleMetrics(AIndex : Integer; AValue : TStringArray); virtual;
+    Procedure SetcompatibleDimensions(AIndex : Integer; const AValue : TStringArray); virtual;
+    Procedure SetcompatibleMetrics(AIndex : Integer; const AValue : TStringArray); virtual;
     Procedure Setid(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
-    Procedure SetrequiredDimensions(AIndex : Integer; AValue : TStringArray); virtual;
-    Procedure SetrequiredMetrics(AIndex : Integer; AValue : TStringArray); virtual;
-    Procedure SetsupportedProducts(AIndex : Integer; AValue : TStringArray); virtual;
+    Procedure SetrequiredDimensions(AIndex : Integer; const AValue : TStringArray); virtual;
+    Procedure SetrequiredMetrics(AIndex : Integer; const AValue : TStringArray); virtual;
+    Procedure SetsupportedProducts(AIndex : Integer; const AValue : TStringArray); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
     Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
@@ -531,7 +516,7 @@ type
   Protected
     //Property setters
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setitems(AIndex : Integer; AValue : TSavedReportsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TSavedReportsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -582,7 +567,7 @@ type
   Protected
     //Property setters
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setitems(AIndex : Integer; AValue : TUrlChannelsTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TUrlChannelsTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -1022,7 +1007,7 @@ end;
 
 
 
-Procedure TAccounts.Setitems(AIndex : Integer; AValue : TAccountsTypeitemsArray); 
+Procedure TAccounts.Setitems(AIndex : Integer; const AValue : TAccountsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -1072,7 +1057,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TAdClient.SetarcOptIn(AIndex : Integer; AValue : boolean); 
+Procedure TAdClient.SetarcOptIn(AIndex : Integer; const AValue : boolean); 
 
 begin
   If (FarcOptIn=AValue) then exit;
@@ -1112,7 +1097,7 @@ end;
 
 
 
-Procedure TAdClient.SetsupportsReporting(AIndex : Integer; AValue : boolean); 
+Procedure TAdClient.SetsupportsReporting(AIndex : Integer; const AValue : boolean); 
 
 begin
   If (FsupportsReporting=AValue) then exit;
@@ -1139,7 +1124,7 @@ end;
 
 
 
-Procedure TAdClients.Setitems(AIndex : Integer; AValue : TAdClientsTypeitemsArray); 
+Procedure TAdClients.Setitems(AIndex : Integer; const AValue : TAdClientsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -1257,7 +1242,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TAlerts.Setitems(AIndex : Integer; AValue : TAlertsTypeitemsArray); 
+Procedure TAlerts.Setitems(AIndex : Integer; const AValue : TAlertsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -1384,7 +1369,7 @@ end;
 
 
 
-Procedure TCustomChannel.SettargetingInfo(AIndex : Integer; AValue : TCustomChannelTypetargetingInfo); 
+Procedure TCustomChannel.SettargetingInfo(AIndex : Integer; const AValue : TCustomChannelTypetargetingInfo); 
 
 begin
   If (FtargetingInfo=AValue) then exit;
@@ -1411,7 +1396,7 @@ end;
 
 
 
-Procedure TCustomChannels.Setitems(AIndex : Integer; AValue : TCustomChannelsTypeitemsArray); 
+Procedure TCustomChannels.Setitems(AIndex : Integer; const AValue : TCustomChannelsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -1461,7 +1446,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TMetadata.Setitems(AIndex : Integer; AValue : TMetadataTypeitemsArray); 
+Procedure TMetadata.Setitems(AIndex : Integer; const AValue : TMetadataTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -1588,7 +1573,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TPreferredDeals.Setitems(AIndex : Integer; AValue : TPreferredDealsTypeitemsArray); 
+Procedure TPreferredDeals.Setitems(AIndex : Integer; const AValue : TPreferredDealsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -1676,7 +1661,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TReport.Setaverages(AIndex : Integer; AValue : TStringArray); 
+Procedure TReport.Setaverages(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (Faverages=AValue) then exit;
@@ -1686,7 +1671,7 @@ end;
 
 
 
-Procedure TReport.Setheaders(AIndex : Integer; AValue : TReportTypeheadersArray); 
+Procedure TReport.Setheaders(AIndex : Integer; const AValue : TReportTypeheadersArray); 
 
 begin
   If (Fheaders=AValue) then exit;
@@ -1706,7 +1691,7 @@ end;
 
 
 
-Procedure TReport.Setrows(AIndex : Integer; AValue : TReportTyperowsArray); 
+Procedure TReport.Setrows(AIndex : Integer; const AValue : TReportTyperowsArray); 
 
 begin
   If (Frows=AValue) then exit;
@@ -1726,7 +1711,7 @@ end;
 
 
 
-Procedure TReport.Settotals(AIndex : Integer; AValue : TStringArray); 
+Procedure TReport.Settotals(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (Ftotals=AValue) then exit;
@@ -1736,7 +1721,7 @@ end;
 
 
 
-Procedure TReport.Setwarnings(AIndex : Integer; AValue : TStringArray); 
+Procedure TReport.Setwarnings(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (Fwarnings=AValue) then exit;
@@ -1770,7 +1755,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TReportingMetadataEntry.SetcompatibleDimensions(AIndex : Integer; AValue : TStringArray); 
+Procedure TReportingMetadataEntry.SetcompatibleDimensions(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FcompatibleDimensions=AValue) then exit;
@@ -1780,7 +1765,7 @@ end;
 
 
 
-Procedure TReportingMetadataEntry.SetcompatibleMetrics(AIndex : Integer; AValue : TStringArray); 
+Procedure TReportingMetadataEntry.SetcompatibleMetrics(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FcompatibleMetrics=AValue) then exit;
@@ -1810,7 +1795,7 @@ end;
 
 
 
-Procedure TReportingMetadataEntry.SetrequiredDimensions(AIndex : Integer; AValue : TStringArray); 
+Procedure TReportingMetadataEntry.SetrequiredDimensions(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FrequiredDimensions=AValue) then exit;
@@ -1820,7 +1805,7 @@ end;
 
 
 
-Procedure TReportingMetadataEntry.SetrequiredMetrics(AIndex : Integer; AValue : TStringArray); 
+Procedure TReportingMetadataEntry.SetrequiredMetrics(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FrequiredMetrics=AValue) then exit;
@@ -1830,7 +1815,7 @@ end;
 
 
 
-Procedure TReportingMetadataEntry.SetsupportedProducts(AIndex : Integer; AValue : TStringArray); 
+Procedure TReportingMetadataEntry.SetsupportedProducts(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FsupportedProducts=AValue) then exit;
@@ -1911,7 +1896,7 @@ end;
 
 
 
-Procedure TSavedReports.Setitems(AIndex : Integer; AValue : TSavedReportsTypeitemsArray); 
+Procedure TSavedReports.Setitems(AIndex : Integer; const AValue : TSavedReportsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -2008,7 +1993,7 @@ end;
 
 
 
-Procedure TUrlChannels.Setitems(AIndex : Integer; AValue : TUrlChannelsTypeitemsArray); 
+Procedure TUrlChannels.Setitems(AIndex : Integer; const AValue : TUrlChannelsTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -2910,7 +2895,7 @@ end;
 Class Function TAdexchangesellerAPI.APIRevision : String;
 
 begin
-  Result:='20150401';
+  Result:='20160513';
 end;
 
 Class Function TAdexchangesellerAPI.APIID : String;
@@ -2964,7 +2949,7 @@ end;
 Class Function TAdexchangesellerAPI.APIrootUrl : string;
 
 begin
-  Result:='https://www.googleapis.com:443/';
+  Result:='https://www.googleapis.com/';
 end;
 
 Class Function TAdexchangesellerAPI.APIbasePath : string;
@@ -2976,7 +2961,7 @@ end;
 Class Function TAdexchangesellerAPI.APIbaseURL : String;
 
 begin
-  Result:='https://www.googleapis.com:443/adexchangeseller/v2.0/';
+  Result:='https://www.googleapis.com/adexchangeseller/v2.0/';
 end;
 
 Class Function TAdexchangesellerAPI.APIProtocol : string;

packages/googleapi/src/googleadmin.pp

@@ -1,19 +1,4 @@
 unit googleadmin;
-{
-   **********************************************************************
-      This file is part of the Free Component Library (FCL)
-      Copyright (c) 2015 The free pascal 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.
-  
-   **********************************************************************
-}
-//Generated on: 16-5-15 08:52:57
 {$MODE objfpc}
 {$H+}
 
@@ -67,7 +52,7 @@ type
   Protected
     //Property setters
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setitems(AIndex : Integer; AValue : TActivitiesTypeitemsArray); virtual;
+    Procedure Setitems(AIndex : Integer; const AValue : TActivitiesTypeitemsArray); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -122,10 +107,10 @@ type
     Fvalue : String;
   Protected
     //Property setters
-    Procedure SetboolValue(AIndex : Integer; AValue : boolean); virtual;
+    Procedure SetboolValue(AIndex : Integer; const AValue : boolean); virtual;
     Procedure SetintValue(AIndex : Integer; const AValue : String); virtual;
-    Procedure SetmultiIntValue(AIndex : Integer; AValue : TStringArray); virtual;
-    Procedure SetmultiValue(AIndex : Integer; AValue : TStringArray); virtual;
+    Procedure SetmultiIntValue(AIndex : Integer; const AValue : TStringArray); virtual;
+    Procedure SetmultiValue(AIndex : Integer; const AValue : TStringArray); virtual;
     Procedure Setname(AIndex : Integer; const AValue : String); virtual;
     Procedure Setvalue(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -156,7 +141,7 @@ type
     Class Function ExportPropertyName(Const AName : String) : string; override;
     //Property setters
     Procedure Setname(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setparameters(AIndex : Integer; AValue : TActivityTypeeventsItemTypeparametersArray); virtual;
+    Procedure Setparameters(AIndex : Integer; const AValue : TActivityTypeeventsItemTypeparametersArray); virtual;
     Procedure Set_type(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
@@ -184,7 +169,7 @@ type
     //Property setters
     Procedure SetapplicationName(AIndex : Integer; const AValue : String); virtual;
     Procedure SetcustomerId(AIndex : Integer; const AValue : String); virtual;
-    Procedure Settime(AIndex : Integer; AValue : TDatetime); virtual;
+    Procedure Settime(AIndex : Integer; const AValue : TDatetime); virtual;
     Procedure SetuniqueQualifier(AIndex : Integer; const AValue : String); virtual;
   Public
   Published
@@ -210,10 +195,10 @@ type
     FownerDomain : String;
   Protected
     //Property setters
-    Procedure Setactor(AIndex : Integer; AValue : TActivityTypeactor); virtual;
+    Procedure Setactor(AIndex : Integer; const AValue : TActivityTypeactor); virtual;
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setevents(AIndex : Integer; AValue : TActivityTypeeventsArray); virtual;
-    Procedure Setid(AIndex : Integer; AValue : TActivityTypeid); virtual;
+    Procedure Setevents(AIndex : Integer; const AValue : TActivityTypeeventsArray); virtual;
+    Procedure Setid(AIndex : Integer; const AValue : TActivityTypeid); virtual;
     Procedure SetipAddress(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetownerDomain(AIndex : Integer; const AValue : String); virtual;
@@ -270,8 +255,8 @@ type
     Procedure Setexpiration(AIndex : Integer; const AValue : String); virtual;
     Procedure Setid(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setparams(AIndex : Integer; AValue : TChannelTypeparams); virtual;
-    Procedure Setpayload(AIndex : Integer; AValue : boolean); virtual;
+    Procedure Setparams(AIndex : Integer; const AValue : TChannelTypeparams); virtual;
+    Procedure Setpayload(AIndex : Integer; const AValue : boolean); virtual;
     Procedure SetresourceId(AIndex : Integer; const AValue : String); virtual;
     Procedure SetresourceUri(AIndex : Integer; const AValue : String); virtual;
     Procedure Settoken(AIndex : Integer; const AValue : String); virtual;
@@ -345,10 +330,10 @@ type
     FstringValue : String;
   Protected
     //Property setters
-    Procedure SetboolValue(AIndex : Integer; AValue : boolean); virtual;
-    Procedure SetdatetimeValue(AIndex : Integer; AValue : TDatetime); virtual;
+    Procedure SetboolValue(AIndex : Integer; const AValue : boolean); virtual;
+    Procedure SetdatetimeValue(AIndex : Integer; const AValue : TDatetime); virtual;
     Procedure SetintValue(AIndex : Integer; const AValue : String); virtual;
-    Procedure SetmsgValue(AIndex : Integer; AValue : TUsageReportTypeparametersItemTypemsgValueArray); virtual;
+    Procedure SetmsgValue(AIndex : Integer; const AValue : TUsageReportTypeparametersItemTypemsgValueArray); virtual;
     Procedure Setname(AIndex : Integer; const AValue : String); virtual;
     Procedure SetstringValue(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
@@ -380,10 +365,10 @@ type
   Protected
     //Property setters
     Procedure Setdate(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setentity(AIndex : Integer; AValue : TUsageReportTypeentity); virtual;
+    Procedure Setentity(AIndex : Integer; const AValue : TUsageReportTypeentity); virtual;
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setparameters(AIndex : Integer; AValue : TUsageReportTypeparametersArray); virtual;
+    Procedure Setparameters(AIndex : Integer; const AValue : TUsageReportTypeparametersArray); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
     Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
@@ -429,7 +414,7 @@ type
   Protected
     //Property setters
     Procedure Setcode(AIndex : Integer; const AValue : String); virtual;
-    Procedure Setdata(AIndex : Integer; AValue : TUsageReportsTypewarningsItemTypedataArray); virtual;
+    Procedure Setdata(AIndex : Integer; const AValue : TUsageReportsTypewarningsItemTypedataArray); virtual;
     Procedure Setmessage(AIndex : Integer; const AValue : String); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
@@ -459,8 +444,8 @@ type
     Procedure Setetag(AIndex : Integer; const AValue : String); virtual;
     Procedure Setkind(AIndex : Integer; const AValue : String); virtual;
     Procedure SetnextPageToken(AIndex : Integer; const AValue : String); virtual;
-    Procedure SetusageReports(AIndex : Integer; AValue : TUsageReportsTypeusageReportsArray); virtual;
-    Procedure Setwarnings(AIndex : Integer; AValue : TUsageReportsTypewarningsArray); virtual;
+    Procedure SetusageReports(AIndex : Integer; const AValue : TUsageReportsTypeusageReportsArray); virtual;
+    Procedure Setwarnings(AIndex : Integer; const AValue : TUsageReportsTypewarningsArray); virtual;
     //2.6.4. bug workaround
     {$IFDEF VER2_6}
     Procedure SetArrayLength(Const AName : String; ALength : Longint); override;
@@ -646,7 +631,7 @@ end;
 
 
 
-Procedure TActivities.Setitems(AIndex : Integer; AValue : TActivitiesTypeitemsArray); 
+Procedure TActivities.Setitems(AIndex : Integer; const AValue : TActivitiesTypeitemsArray); 
 
 begin
   If (Fitems=AValue) then exit;
@@ -743,7 +728,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TActivityTypeeventsItemTypeparametersItem.SetboolValue(AIndex : Integer; AValue : boolean); 
+Procedure TActivityTypeeventsItemTypeparametersItem.SetboolValue(AIndex : Integer; const AValue : boolean); 
 
 begin
   If (FboolValue=AValue) then exit;
@@ -763,7 +748,7 @@ end;
 
 
 
-Procedure TActivityTypeeventsItemTypeparametersItem.SetmultiIntValue(AIndex : Integer; AValue : TStringArray); 
+Procedure TActivityTypeeventsItemTypeparametersItem.SetmultiIntValue(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FmultiIntValue=AValue) then exit;
@@ -773,7 +758,7 @@ end;
 
 
 
-Procedure TActivityTypeeventsItemTypeparametersItem.SetmultiValue(AIndex : Integer; AValue : TStringArray); 
+Procedure TActivityTypeeventsItemTypeparametersItem.SetmultiValue(AIndex : Integer; const AValue : TStringArray); 
 
 begin
   If (FmultiValue=AValue) then exit;
@@ -834,7 +819,7 @@ end;
 
 
 
-Procedure TActivityTypeeventsItem.Setparameters(AIndex : Integer; AValue : TActivityTypeeventsItemTypeparametersArray); 
+Procedure TActivityTypeeventsItem.Setparameters(AIndex : Integer; const AValue : TActivityTypeeventsItemTypeparametersArray); 
 
 begin
   If (Fparameters=AValue) then exit;
@@ -905,7 +890,7 @@ end;
 
 
 
-Procedure TActivityTypeid.Settime(AIndex : Integer; AValue : TDatetime); 
+Procedure TActivityTypeid.Settime(AIndex : Integer; const AValue : TDatetime); 
 
 begin
   If (Ftime=AValue) then exit;
@@ -932,7 +917,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TActivity.Setactor(AIndex : Integer; AValue : TActivityTypeactor); 
+Procedure TActivity.Setactor(AIndex : Integer; const AValue : TActivityTypeactor); 
 
 begin
   If (Factor=AValue) then exit;
@@ -952,7 +937,7 @@ end;
 
 
 
-Procedure TActivity.Setevents(AIndex : Integer; AValue : TActivityTypeeventsArray); 
+Procedure TActivity.Setevents(AIndex : Integer; const AValue : TActivityTypeeventsArray); 
 
 begin
   If (Fevents=AValue) then exit;
@@ -962,7 +947,7 @@ end;
 
 
 
-Procedure TActivity.Setid(AIndex : Integer; AValue : TActivityTypeid); 
+Procedure TActivity.Setid(AIndex : Integer; const AValue : TActivityTypeid); 
 
 begin
   If (Fid=AValue) then exit;
@@ -1075,7 +1060,7 @@ end;
 
 
 
-Procedure TChannel.Setparams(AIndex : Integer; AValue : TChannelTypeparams); 
+Procedure TChannel.Setparams(AIndex : Integer; const AValue : TChannelTypeparams); 
 
 begin
   If (Fparams=AValue) then exit;
@@ -1085,7 +1070,7 @@ end;
 
 
 
-Procedure TChannel.Setpayload(AIndex : Integer; AValue : boolean); 
+Procedure TChannel.Setpayload(AIndex : Integer; const AValue : boolean); 
 
 begin
   If (Fpayload=AValue) then exit;
@@ -1224,7 +1209,7 @@ end;
   --------------------------------------------------------------------}
 
 
-Procedure TUsageReportTypeparametersItem.SetboolValue(AIndex : Integer; AValue : boolean); 
+Procedure TUsageReportTypeparametersItem.SetboolValue(AIndex : Integer; const AValue : boolean); 
 
 begin
   If (FboolValue=AValue) then exit;
@@ -1234,7 +1219,7 @@ end;
 
 
 
-Procedure TUsageReportTypeparametersItem.SetdatetimeValue(AIndex : Integer; AValue : TDatetime); 
+Procedure TUsageReportTypeparametersItem.SetdatetimeValue(AIndex : Integer; const AValue : TDatetime); 
 
 begin
   If (FdatetimeValue=AValue) then exit;
@@ -1254,7 +1239,7 @@ end;
 
 
 
-Procedure TUsageReportTypeparametersItem.SetmsgValue(AIndex : Integer; AValue : TUsageReportTypeparametersItemTypemsgValueArray); 
+Procedure TUsageReportTypeparametersItem.SetmsgValue(AIndex : Integer; const AValue : TUsageReportTypeparametersItemTypemsgValueArray); 
 
 begin
   If (FmsgValue=AValue) then exit;
@@ -1314,7 +1299,7 @@ end;
 
 
 
-Procedure TUsageReport.Setentity(AIndex : Integer; AValue : TUsageReportTypeentity); 
+Procedure TUsageReport.Setentity(AIndex : Integer; const AValue : TUsageReportTypeentity); 
 
 begin
   If (Fentity=AValue) then exit;
@@ -1344,7 +1329,7 @@ end;
 
 
 
-Procedure TUsageReport.Setparameters(AIndex : Integer; AValue : TUsageReportTypeparametersArray); 
+Procedure TUsageReport.Setparameters(AIndex : Integer; const AValue : TUsageReportTypeparametersArray); 
 
 begin
   If (Fparameters=AValue) then exit;
@@ -1411,7 +1396,7 @@ end;
 
 
 
-Procedure TUsageReportsTypewarningsItem.Setdata(AIndex : Integer; AValue : TUsageReportsTypewarningsItemTypedataArray); 
+Procedure TUsageReportsTypewarningsItem.Setdata(AIndex : Integer; const AValue : TUsageReportsTypewarningsItemTypedataArray); 
 
 begin
   If (Fdata=AValue) then exit;
@@ -1481,7 +1466,7 @@ end;
 
 
 
-Procedure TUsageReports.SetusageReports(AIndex : Integer; AValue : TUsageReportsTypeusageReportsArray); 
+Procedure TUsageReports.SetusageReports(AIndex : Integer; const AValue : TUsageReportsTypeusageReportsArray); 
 
 begin
   If (FusageReports=AValue) then exit;
@@ -1491,7 +1476,7 @@ end;
 
 
 
-Procedure TUsageReports.Setwarnings(AIndex : Integer; AValue : TUsageReportsTypewarningsArray); 
+Procedure TUsageReports.Setwarnings(AIndex : Integer; const AValue : TUsageReportsTypewarningsArray); 
 
 begin
   If (Fwarnings=AValue) then exit;
@@ -1751,7 +1736,7 @@ end;
 Class Function TAdminAPI.APIRevision : String;
 
 begin
-  Result:='20150429';
+  Result:='20151113';
 end;
 
 Class Function TAdminAPI.APIID : String;
@@ -1805,7 +1790,7 @@ end;
 Class Function TAdminAPI.APIrootUrl : string;
 
 begin
-  Result:='https://www.googleapis.com:443/';
+  Result:='https://www.googleapis.com/';
 end;
 
 Class Function TAdminAPI.APIbasePath : string;
@@ -1817,7 +1802,7 @@ end;
 Class Function TAdminAPI.APIbaseURL : String;
 
 begin
-  Result:='https://www.googleapis.com:443/admin/reports/v1/';
+  Result:='https://www.googleapis.com/admin/reports/v1/';
 end;
 
 Class Function TAdminAPI.APIProtocol : string;