Преглед изворни кода

* synchronised with trunk till r40942

git-svn-id: branches/debug_eh@40943 -
Jonas Maebe пре 6 година
родитељ
комит
b3a8543a56
100 измењених фајлова са 10074 додато и 4286 уклоњено
  1. 15 10
      .gitattributes
  2. 5 0
      compiler/aopt.pas
  3. 27 1
      compiler/aoptobj.pas
  4. 0 2
      compiler/arm/agarmgas.pas
  5. 1 3
      compiler/arm/aoptcpu.pas
  6. 4 10
      compiler/avr/aoptcpu.pas
  7. 22 22
      compiler/avr/cgcpu.pas
  8. 9 2
      compiler/defcmp.pas
  9. 1 0
      compiler/hlcg2ll.pas
  10. 12 0
      compiler/msg/errore.msg
  11. 3 2
      compiler/msgidx.inc
  12. 382 372
      compiler/msgtxt.inc
  13. 0 18
      compiler/ncgmem.pas
  14. 1 1
      compiler/ncgset.pas
  15. 7 1
      compiler/ncgutil.pas
  16. 0 7
      compiler/nflw.pas
  17. 1 1
      compiler/nld.pas
  18. 0 73
      compiler/nmem.pas
  19. 0 2
      compiler/node.pas
  20. 20 0
      compiler/nutils.pas
  21. 2 0
      compiler/ogomf.pas
  22. 1 1
      compiler/optconstprop.pas
  23. 0 1
      compiler/optutils.pas
  24. 0 1
      compiler/pass_2.pas
  25. 43 7
      compiler/pexpr.pas
  26. 4 1
      compiler/pparautl.pas
  27. 1 1
      compiler/ppu.pas
  28. 1 3
      compiler/pstatmnt.pas
  29. 16 14
      compiler/psub.pas
  30. 0 1
      compiler/psystem.pas
  31. 1 1
      compiler/rautils.pas
  32. 3 7
      compiler/sparcgen/aoptcpu.pas
  33. 3 1
      compiler/symconst.pas
  34. 1 1
      compiler/systems.pas
  35. 4 3
      compiler/systems/i_haiku.pas
  36. 6 0
      compiler/systems/t_linux.pas
  37. 12 6
      compiler/utils/fpc.pp
  38. 2 1
      compiler/utils/ppuutils/ppudump.pp
  39. 25 57
      compiler/x86/aoptx86.pas
  40. 1 1
      compiler/x86/cpubase.pas
  41. 2 0
      packages/fcl-js/src/jswriter.pp
  42. 8 3
      packages/fcl-passrc/src/pasresolveeval.pas
  43. 465 279
      packages/fcl-passrc/src/pasresolver.pp
  44. 11 7
      packages/fcl-passrc/src/pastree.pp
  45. 161 115
      packages/fcl-passrc/src/pparser.pp
  46. 121 14
      packages/fcl-passrc/tests/tcexprparser.pas
  47. 45 0
      packages/fcl-passrc/tests/tcgenerics.pp
  48. 333 69
      packages/fcl-passrc/tests/tcresolver.pas
  49. 8 0
      packages/fcl-passrc/tests/tctypeparser.pas
  50. 1 0
      packages/fcl-res/src/coffwriter.pp
  51. 9 2
      packages/fcl-web/examples/httpclient/httpget.pas
  52. 9 1
      packages/fcl-web/examples/simpleserver/simpleserver.pas
  53. 4 1
      packages/fcl-web/fpmake.pp
  54. 1 1
      packages/fcl-xml/src/xmlutils.pp
  55. 6 3
      packages/fv/src/drivers.pas
  56. 1 1
      packages/fv/src/editors.pas
  57. 1 1
      packages/fv/src/statuses.pas
  58. 1 1
      packages/fv/src/validate.pas
  59. 2691 0
      packages/gnutls/Makefile
  60. 102 0
      packages/gnutls/Makefile.fpc
  61. 155 0
      packages/gnutls/examples/httpget.pp
  62. 50 0
      packages/gnutls/examples/privkey.pp
  63. 344 0
      packages/gnutls/examples/srvcacert.pp
  64. 5 1
      packages/gnutls/fpmake.pp
  65. 1122 51
      packages/gnutls/src/gnutls.pp
  66. 604 0
      packages/gnutls/src/gnutlssockets.pp
  67. 164 336
      packages/graph/src/go32v2/graph.pp
  68. 114 195
      packages/graph/src/go32v2/vesa.inc
  69. 104 33
      packages/graph/src/inc/fills.inc
  70. 117 41
      packages/graph/src/inc/graph.inc
  71. 18 11
      packages/graph/src/inc/graphh.inc
  72. 3 1
      packages/graph/src/inc/modes.inc
  73. 250 383
      packages/graph/src/msdos/graph.pp
  74. 43 59
      packages/graph/src/msdos/vesa.inc
  75. 683 69
      packages/graph/src/ptcgraph/ptcgraph.pp
  76. 21 6
      packages/ide/fpide.pas
  77. 1 0
      packages/ide/fpmwnd.inc
  78. 14 1
      packages/ide/weditor.pas
  79. 192 180
      packages/openssl/src/openssl.pas
  80. 276 140
      packages/pastojs/src/fppas2js.pp
  81. 10 2
      packages/pastojs/src/pas2jscompiler.pp
  82. 31 17
      packages/pastojs/src/pas2jsfiler.pp
  83. 2 1
      packages/pastojs/src/pas2jsfscompiler.pp
  84. 36 1
      packages/pastojs/tests/tcfiler.pas
  85. 968 368
      packages/pastojs/tests/tcmodules.pas
  86. 10 9
      packages/pastojs/tests/tcoptimizations.pas
  87. 2 2
      packages/rtl-console/src/unix/crt.pp
  88. 1 1
      packages/rtl-console/src/win/keyboard.pp
  89. 1 1
      packages/rtl-extra/src/unix/ipc.pp
  90. 1 1
      rtl/darwin/x86/x86hnd.inc
  91. 1 1
      rtl/embedded/Makefile
  92. 1 0
      rtl/embedded/system.pp
  93. 93 99
      rtl/haiku/Makefile
  94. 5 11
      rtl/haiku/Makefile.fpc
  95. 13 82
      rtl/haiku/baseunix.pp
  96. 0 519
      rtl/haiku/bethreads.pp
  97. 0 159
      rtl/haiku/i386/cprt0.as
  98. 3 163
      rtl/haiku/i386/dllcprt0.as
  99. 0 170
      rtl/haiku/i386/dllprt.as
  100. 0 39
      rtl/haiku/i386/dllprt.cpp

+ 15 - 10
.gitattributes

@@ -3833,9 +3833,15 @@ packages/gnome1/src/zvt/libzvt.pp svneol=native#text/plain
 packages/gnome1/src/zvt/lists.inc svneol=native#text/plain
 packages/gnome1/src/zvt/lists.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vt.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vt.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vtx.inc svneol=native#text/plain
 packages/gnome1/src/zvt/vtx.inc svneol=native#text/plain
+packages/gnutls/Makefile svneol=native#text/plain
+packages/gnutls/Makefile.fpc svneol=native#text/plain
+packages/gnutls/examples/httpget.pp svneol=native#text/plain
+packages/gnutls/examples/privkey.pp svneol=native#text/plain
+packages/gnutls/examples/srvcacert.pp svneol=native#text/plain
 packages/gnutls/examples/testgnutls.pp svneol=native#text/plain
 packages/gnutls/examples/testgnutls.pp svneol=native#text/plain
 packages/gnutls/fpmake.pp svneol=native#text/plain
 packages/gnutls/fpmake.pp svneol=native#text/plain
 packages/gnutls/src/gnutls.pp svneol=native#text/plain
 packages/gnutls/src/gnutls.pp svneol=native#text/plain
+packages/gnutls/src/gnutlssockets.pp svneol=native#text/plain
 packages/googleapi/Makefile svneol=native#text/plain
 packages/googleapi/Makefile svneol=native#text/plain
 packages/googleapi/Makefile.fpc svneol=native#text/plain
 packages/googleapi/Makefile.fpc svneol=native#text/plain
 packages/googleapi/README.txt svneol=native#text/plain
 packages/googleapi/README.txt svneol=native#text/plain
@@ -9399,33 +9405,24 @@ rtl/go32v2/v2prt0.as svneol=native#text/plain
 rtl/haiku/Makefile svneol=native#text/plain
 rtl/haiku/Makefile svneol=native#text/plain
 rtl/haiku/Makefile.fpc svneol=native#text/plain
 rtl/haiku/Makefile.fpc svneol=native#text/plain
 rtl/haiku/baseunix.pp svneol=native#text/plain
 rtl/haiku/baseunix.pp svneol=native#text/plain
-rtl/haiku/bethreads.pp svneol=native#text/plain
 rtl/haiku/classes.pp svneol=native#text/plain
 rtl/haiku/classes.pp svneol=native#text/plain
 rtl/haiku/errno.inc svneol=native#text/plain
 rtl/haiku/errno.inc svneol=native#text/plain
 rtl/haiku/errnostr.inc svneol=native#text/plain
 rtl/haiku/errnostr.inc svneol=native#text/plain
 rtl/haiku/i386/cprt0.as svneol=native#text/plain
 rtl/haiku/i386/cprt0.as svneol=native#text/plain
 rtl/haiku/i386/dllcprt0.as svneol=native#text/plain
 rtl/haiku/i386/dllcprt0.as svneol=native#text/plain
-rtl/haiku/i386/dllprt.as svneol=native#text/plain
-rtl/haiku/i386/dllprt.cpp svneol=native#text/plain
-rtl/haiku/i386/func.as svneol=native#text/plain
-rtl/haiku/i386/prt0.as svneol=native#text/plain
+rtl/haiku/i386/sig_cpu.inc svneol=native#text/plain
 rtl/haiku/i386/sighnd.inc svneol=native#text/plain
 rtl/haiku/i386/sighnd.inc svneol=native#text/plain
 rtl/haiku/osdefs.inc svneol=native#text/plain
 rtl/haiku/osdefs.inc svneol=native#text/plain
 rtl/haiku/osmacro.inc svneol=native#text/plain
 rtl/haiku/osmacro.inc svneol=native#text/plain
-rtl/haiku/ossysc.inc svneol=native#text/plain
 rtl/haiku/ostypes.inc svneol=native#text/plain
 rtl/haiku/ostypes.inc svneol=native#text/plain
 rtl/haiku/pthread.inc svneol=native#text/plain
 rtl/haiku/pthread.inc svneol=native#text/plain
 rtl/haiku/ptypes.inc svneol=native#text/plain
 rtl/haiku/ptypes.inc svneol=native#text/plain
 rtl/haiku/rtldefs.inc svneol=native#text/plain
 rtl/haiku/rtldefs.inc svneol=native#text/plain
-rtl/haiku/settimeo.inc svneol=native#text/plain
 rtl/haiku/si_c.pp svneol=native#text/plain
 rtl/haiku/si_c.pp svneol=native#text/plain
 rtl/haiku/si_dllc.pp svneol=native#text/plain
 rtl/haiku/si_dllc.pp svneol=native#text/plain
 rtl/haiku/signal.inc svneol=native#text/plain
 rtl/haiku/signal.inc svneol=native#text/plain
 rtl/haiku/suuid.inc svneol=native#text/plain
 rtl/haiku/suuid.inc svneol=native#text/plain
-rtl/haiku/syscall.inc svneol=native#text/plain
-rtl/haiku/syscallh.inc svneol=native#text/plain
 rtl/haiku/sysconst.inc svneol=native#text/plain
 rtl/haiku/sysconst.inc svneol=native#text/plain
-rtl/haiku/sysnr.inc svneol=native#text/plain
 rtl/haiku/sysos.inc svneol=native#text/plain
 rtl/haiku/sysos.inc svneol=native#text/plain
 rtl/haiku/sysosh.inc svneol=native#text/plain
 rtl/haiku/sysosh.inc svneol=native#text/plain
 rtl/haiku/system.pp svneol=native#text/plain
 rtl/haiku/system.pp svneol=native#text/plain
@@ -9434,6 +9431,8 @@ rtl/haiku/termios.inc svneol=native#text/plain
 rtl/haiku/termiosproc.inc svneol=native#text/plain
 rtl/haiku/termiosproc.inc svneol=native#text/plain
 rtl/haiku/unxconst.inc svneol=native#text/plain
 rtl/haiku/unxconst.inc svneol=native#text/plain
 rtl/haiku/unxfunc.inc svneol=native#text/plain
 rtl/haiku/unxfunc.inc svneol=native#text/plain
+rtl/haiku/x86_64/sig_cpu.inc svneol=native#text/plain
+rtl/haiku/x86_64/sighnd.inc svneol=native#text/plain
 rtl/i386/cpu.pp svneol=native#text/plain
 rtl/i386/cpu.pp svneol=native#text/plain
 rtl/i386/cpuh.inc svneol=native#text/plain
 rtl/i386/cpuh.inc svneol=native#text/plain
 rtl/i386/cpuinnr.inc svneol=native#text/plain
 rtl/i386/cpuinnr.inc svneol=native#text/plain
@@ -9877,6 +9876,7 @@ rtl/morphos/doslibf.inc svneol=native#text/plain
 rtl/morphos/emuld.inc svneol=native#text/plain
 rtl/morphos/emuld.inc svneol=native#text/plain
 rtl/morphos/execd.inc svneol=native#text/plain
 rtl/morphos/execd.inc svneol=native#text/plain
 rtl/morphos/execf.inc svneol=native#text/plain
 rtl/morphos/execf.inc svneol=native#text/plain
+rtl/morphos/lineinfo.pp svneol=native#text/plain
 rtl/morphos/prt0.as svneol=native#text/plain
 rtl/morphos/prt0.as svneol=native#text/plain
 rtl/morphos/si_prc.pp svneol=native#text/plain
 rtl/morphos/si_prc.pp svneol=native#text/plain
 rtl/morphos/system.pp svneol=native#text/plain
 rtl/morphos/system.pp svneol=native#text/plain
@@ -14762,6 +14762,7 @@ tests/webtbf/tw34691.pp svneol=native#text/pascal
 tests/webtbf/tw3473.pp svneol=native#text/plain
 tests/webtbf/tw3473.pp svneol=native#text/plain
 tests/webtbf/tw3480.pp svneol=native#text/plain
 tests/webtbf/tw3480.pp svneol=native#text/plain
 tests/webtbf/tw3480a.pp svneol=native#text/plain
 tests/webtbf/tw3480a.pp svneol=native#text/plain
+tests/webtbf/tw34821.pp svneol=native#text/plain
 tests/webtbf/tw3488.pp svneol=native#text/plain
 tests/webtbf/tw3488.pp svneol=native#text/plain
 tests/webtbf/tw3495.pp svneol=native#text/plain
 tests/webtbf/tw3495.pp svneol=native#text/plain
 tests/webtbf/tw3502.pp svneol=native#text/plain
 tests/webtbf/tw3502.pp svneol=native#text/plain
@@ -16472,13 +16473,17 @@ tests/webtbs/tw3456.pp svneol=native#text/plain
 tests/webtbs/tw3457.pp svneol=native#text/plain
 tests/webtbs/tw3457.pp svneol=native#text/plain
 tests/webtbs/tw3460.pp svneol=native#text/plain
 tests/webtbs/tw3460.pp svneol=native#text/plain
 tests/webtbs/tw34605.pp svneol=native#text/plain
 tests/webtbs/tw34605.pp svneol=native#text/plain
+tests/webtbs/tw34653.pp svneol=native#text/pascal
 tests/webtbs/tw3467.pp svneol=native#text/plain
 tests/webtbs/tw3467.pp svneol=native#text/plain
 tests/webtbs/tw3470.pp svneol=native#text/plain
 tests/webtbs/tw3470.pp svneol=native#text/plain
 tests/webtbs/tw3474.pp svneol=native#text/plain
 tests/webtbs/tw3474.pp svneol=native#text/plain
 tests/webtbs/tw3477.pp svneol=native#text/plain
 tests/webtbs/tw3477.pp svneol=native#text/plain
 tests/webtbs/tw3478.pp svneol=native#text/plain
 tests/webtbs/tw3478.pp svneol=native#text/plain
 tests/webtbs/tw3479.pp svneol=native#text/plain
 tests/webtbs/tw3479.pp svneol=native#text/plain
+tests/webtbs/tw34818.pp svneol=native#text/pascal
+tests/webtbs/tw34848.pp svneol=native#text/pascal
 tests/webtbs/tw3489.pp svneol=native#text/plain
 tests/webtbs/tw3489.pp svneol=native#text/plain
+tests/webtbs/tw34893.pp -text svneol=native#text/pascal
 tests/webtbs/tw3490.pp svneol=native#text/plain
 tests/webtbs/tw3490.pp svneol=native#text/plain
 tests/webtbs/tw3491.pp svneol=native#text/plain
 tests/webtbs/tw3491.pp svneol=native#text/plain
 tests/webtbs/tw3492.pp svneol=native#text/plain
 tests/webtbs/tw3492.pp svneol=native#text/plain

+ 5 - 0
compiler/aopt.pas

@@ -36,6 +36,9 @@ Unit aopt;
 
 
     Type
     Type
       TAsmOptimizer = class(TAoptObj)
       TAsmOptimizer = class(TAoptObj)
+        { Pooled object that can be used by optimisation procedures to evaluate
+          future register usage without upsetting the current state. }
+        TmpUsedRegs: TAllUsedRegs;
 
 
         { _AsmL is the PAasmOutpout list that has to be optimized }
         { _AsmL is the PAasmOutpout list that has to be optimized }
         Constructor create(_AsmL: TAsmList); virtual; reintroduce;
         Constructor create(_AsmL: TAsmList); virtual; reintroduce;
@@ -87,6 +90,7 @@ Unit aopt;
         inherited create(_asml,nil,nil,nil);
         inherited create(_asml,nil,nil,nil);
         { setup labeltable, always necessary }
         { setup labeltable, always necessary }
         New(LabelInfo);
         New(LabelInfo);
+        CreateUsedRegs(TmpUsedRegs);
       End;
       End;
 
 
     procedure TAsmOptimizer.FindLoHiLabels;
     procedure TAsmOptimizer.FindLoHiLabels;
@@ -318,6 +322,7 @@ Unit aopt;
 
 
     Destructor TAsmOptimizer.Destroy;
     Destructor TAsmOptimizer.Destroy;
       Begin
       Begin
+        ReleaseUsedRegs(TmpUsedRegs);
         if assigned(LabelInfo^.LabelTable) then
         if assigned(LabelInfo^.LabelTable) then
           Freemem(LabelInfo^.LabelTable);
           Freemem(LabelInfo^.LabelTable);
         Dispose(LabelInfo);
         Dispose(LabelInfo);

+ 27 - 1
compiler/aoptobj.pas

@@ -270,6 +270,8 @@ Unit AoptObj;
         Procedure UpdateUsedRegs(p : Tai);
         Procedure UpdateUsedRegs(p : Tai);
         class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai);
         class procedure UpdateUsedRegs(var Regs: TAllUsedRegs; p: Tai);
         Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
         Function CopyUsedRegs(var dest : TAllUsedRegs) : boolean;
+        procedure RestoreUsedRegs(const Regs : TAllUsedRegs);
+        procedure TransferUsedRegs(var dest: TAllUsedRegs);
         class Procedure ReleaseUsedRegs(const regs : TAllUsedRegs);
         class Procedure ReleaseUsedRegs(const regs : TAllUsedRegs);
         class Function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
         class Function RegInUsedRegs(reg : TRegister;regs : TAllUsedRegs) : boolean;
         class Procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs);
         class Procedure IncludeRegInUsedRegs(reg : TRegister;var regs : TAllUsedRegs);
@@ -457,7 +459,7 @@ Unit AoptObj;
       End;
       End;
 
 
 
 
-    Function TUsedRegs.GetUsedRegs: TRegSet;
+    Function TUsedRegs.GetUsedRegs: TRegSet; inline;
       Begin
       Begin
         GetUsedRegs := UsedRegs;
         GetUsedRegs := UsedRegs;
       End;
       End;
@@ -945,6 +947,30 @@ Unit AoptObj;
       end;
       end;
 
 
 
 
+      procedure TAOptObj.RestoreUsedRegs(const Regs: TAllUsedRegs);
+      var
+        i : TRegisterType;
+      begin
+        { Note that the constructor Create_Regset is being called as a regular
+          method - it is not instantiating a new object.  This is because it is
+          the only published means to modify the internal state en-masse. [Kit] }
+        for i:=low(TRegisterType) to high(TRegisterType) do
+          UsedRegs[i].Create_Regset(i,Regs[i].GetUsedRegs);
+      end;
+
+
+      procedure TAOptObj.TransferUsedRegs(var dest: TAllUsedRegs);
+      var
+        i : TRegisterType;
+      begin
+        { Note that the constructor Create_Regset is being called as a regular
+          method - it is not instantiating a new object.  This is because it is
+          the only published means to modify the internal state en-masse. [Kit] }
+        for i:=low(TRegisterType) to high(TRegisterType) do
+          dest[i].Create_Regset(i, UsedRegs[i].GetUsedRegs);
+      end;
+
+
       class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
       class procedure TAOptObj.ReleaseUsedRegs(const regs: TAllUsedRegs);
         var
         var
           i : TRegisterType;
           i : TRegisterType;

+ 0 - 2
compiler/arm/agarmgas.pas

@@ -102,8 +102,6 @@ unit agarmgas;
     function TArmGNUAssembler.MakeCmdLine: TCmdStr;
     function TArmGNUAssembler.MakeCmdLine: TCmdStr;
       begin
       begin
         result:=inherited MakeCmdLine;
         result:=inherited MakeCmdLine;
-        if tf_section_threadvars in target_info.flags then
-          result:='-mtls-dialect=gnu '+result;
         if (current_settings.fputype = fpu_soft) then
         if (current_settings.fputype = fpu_soft) then
           result:='-mfpu=softvfp '+result;
           result:='-mfpu=softvfp '+result;
         if (current_settings.fputype = fpu_vfpv2) then
         if (current_settings.fputype = fpu_vfpv2) then

+ 1 - 3
compiler/arm/aoptcpu.pas

@@ -646,7 +646,6 @@ Implementation
     var
     var
       hp1,hp2,hp3,hp4: tai;
       hp1,hp2,hp3,hp4: tai;
       i, i2: longint;
       i, i2: longint;
-      TmpUsedRegs: TAllUsedRegs;
       tempop: tasmop;
       tempop: tasmop;
       oldreg: tregister;
       oldreg: tregister;
       dealloc: tai_regalloc;
       dealloc: tai_regalloc;
@@ -932,7 +931,7 @@ Implementation
                           MatchInstruction(hp2, A_STR, [taicpu(p).condition], [PF_H]) and
                           MatchInstruction(hp2, A_STR, [taicpu(p).condition], [PF_H]) and
                           MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[0]^.reg) then
                           MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[0]^.reg) then
                           begin
                           begin
-                            CopyUsedRegs(TmpUsedRegs);
+                            TransferUsedRegs(TmpUsedRegs);
                             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                             if not(RegUsedAfterInstruction(taicpu(p).oper[0]^.reg,hp2,TmpUsedRegs)) then
                             if not(RegUsedAfterInstruction(taicpu(p).oper[0]^.reg,hp2,TmpUsedRegs)) then
@@ -946,7 +945,6 @@ Implementation
                                 p:=hp2;
                                 p:=hp2;
                                 Result:=true;
                                 Result:=true;
                               end;
                               end;
-                            ReleaseUsedRegs(TmpUsedRegs);
                           end
                           end
                         { fold
                         { fold
                           mov reg1,reg0, shift imm1
                           mov reg1,reg0, shift imm1

+ 4 - 10
compiler/avr/aoptcpu.pas

@@ -231,7 +231,6 @@ Implementation
       alloc, dealloc: tai_regalloc;
       alloc, dealloc: tai_regalloc;
       i: integer;
       i: integer;
       l: TAsmLabel;
       l: TAsmLabel;
-      TmpUsedRegs : TAllUsedRegs;
     begin
     begin
       result := false;
       result := false;
       case p.typ of
       case p.typ of
@@ -325,7 +324,7 @@ Implementation
                        (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
                        (taicpu(hp1).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
                        not(MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^)) then
                        not(MatchOperand(taicpu(hp1).oper[0]^,taicpu(hp1).oper[1]^)) then
                       begin
                       begin
-                        CopyUsedRegs(TmpUsedRegs);
+                        TransferUsedRegs(TmpUsedRegs);
                         if not(RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg, hp1, TmpUsedRegs)) then
                         if not(RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg, hp1, TmpUsedRegs)) then
                           begin
                           begin
                             case taicpu(hp1).opcode of
                             case taicpu(hp1).opcode of
@@ -353,7 +352,6 @@ Implementation
 
 
                             RemoveCurrentP(p);
                             RemoveCurrentP(p);
                           end;
                           end;
-                        ReleaseUsedRegs(TmpUsedRegs);
                       end;
                       end;
                   end;
                   end;
                 A_STS:
                 A_STS:
@@ -690,14 +688,12 @@ Implementation
                            taicpu(hp1).loadreg(0, taicpu(hp2).oper[0]^.reg);
                            taicpu(hp1).loadreg(0, taicpu(hp2).oper[0]^.reg);
 
 
                            { life range of reg2 and reg3 is increased, fix register allocation entries }
                            { life range of reg2 and reg3 is increased, fix register allocation entries }
-                           CopyUsedRegs(TmpUsedRegs);
+                           TransferUsedRegs(TmpUsedRegs);
                            UpdateUsedRegs(TmpUsedRegs,tai(p.Next));
                            UpdateUsedRegs(TmpUsedRegs,tai(p.Next));
                            AllocRegBetween(taicpu(hp2).oper[0]^.reg,hp1,hp2,TmpUsedRegs);
                            AllocRegBetween(taicpu(hp2).oper[0]^.reg,hp1,hp2,TmpUsedRegs);
-                           ReleaseUsedRegs(TmpUsedRegs);
 
 
-                           CopyUsedRegs(TmpUsedRegs);
+                           TransferUsedRegs(TmpUsedRegs);
                            AllocRegBetween(taicpu(hp3).oper[0]^.reg,p,hp3,TmpUsedRegs);
                            AllocRegBetween(taicpu(hp3).oper[0]^.reg,p,hp3,TmpUsedRegs);
-                           ReleaseUsedRegs(TmpUsedRegs);
 
 
                            IncludeRegInUsedRegs(taicpu(hp3).oper[0]^.reg,UsedRegs);
                            IncludeRegInUsedRegs(taicpu(hp3).oper[0]^.reg,UsedRegs);
                            UpdateUsedRegs(tai(p.Next));
                            UpdateUsedRegs(tai(p.Next));
@@ -750,7 +746,7 @@ Implementation
                     }
                     }
                     if MatchOpType(taicpu(p),top_reg,top_reg) then
                     if MatchOpType(taicpu(p),top_reg,top_reg) then
                       begin
                       begin
-                        CopyUsedRegs(TmpUsedRegs);
+                        TransferUsedRegs(TmpUsedRegs);
                         UpdateUsedRegs(TmpUsedRegs,tai(p.Next));
                         UpdateUsedRegs(TmpUsedRegs,tai(p.Next));
                         if not(RegInUsedRegs(taicpu(p).oper[0]^.reg,TmpUsedRegs)) and
                         if not(RegInUsedRegs(taicpu(p).oper[0]^.reg,TmpUsedRegs)) and
                           { reg. allocation information before calls is not perfect, so don't do this before
                           { reg. allocation information before calls is not perfect, so don't do this before
@@ -760,10 +756,8 @@ Implementation
                           begin
                           begin
                             DebugMsg('Peephole Mov2Nop performed', p);
                             DebugMsg('Peephole Mov2Nop performed', p);
                             result:=RemoveCurrentP(p);
                             result:=RemoveCurrentP(p);
-                            ReleaseUsedRegs(TmpUsedRegs);
                             exit;
                             exit;
                           end;
                           end;
-                        ReleaseUsedRegs(TmpUsedRegs);
                       end;
                       end;
 
 
                     { turn
                     { turn

+ 22 - 22
compiler/avr/cgcpu.pas

@@ -302,30 +302,30 @@ unit cgcpu;
           begin
           begin
             if not(assigned(hp)) then
             if not(assigned(hp)) then
               internalerror(2014011105);
               internalerror(2014011105);
-             //paramanager.allocparaloc(list,hp);
-             case hp^.loc of
-               LOC_REGISTER,LOC_CREGISTER:
-                 begin
-                   if (tcgsize2size[hp^.size]<>1) or
-                     (hp^.shiftval<>0) then
-                     internalerror(2015041101);
-                   a_load_const_reg(list,hp^.size,(a shr (8*(i-1))) and $ff,hp^.register);
+            paramanager.allocparaloc(list,hp);
+            case hp^.loc of
+              LOC_REGISTER,LOC_CREGISTER:
+                begin
+                  if (tcgsize2size[hp^.size]<>1) or
+                    (hp^.shiftval<>0) then
+                    internalerror(2015041101);
+                  a_load_const_reg(list,hp^.size,(a shr (8*(i-1))) and $ff,hp^.register);
 
 
-                   inc(i,tcgsize2size[hp^.size]);
-                   hp:=hp^.Next;
-                 end;
-               LOC_REFERENCE,LOC_CREFERENCE:
-                 begin
-                   reference_reset(ref,paraloc.alignment,[]);
-                   ref.base:=hp^.reference.index;
-                   ref.offset:=hp^.reference.offset;
-                   a_load_const_ref(list,hp^.size,a shr (8*(i-1)),ref);
+                  inc(i,tcgsize2size[hp^.size]);
+                  hp:=hp^.Next;
+                end;
+              LOC_REFERENCE,LOC_CREFERENCE:
+                begin
+                  reference_reset(ref,paraloc.alignment,[]);
+                  ref.base:=hp^.reference.index;
+                  ref.offset:=hp^.reference.offset;
+                  a_load_const_ref(list,hp^.size,a shr (8*(i-1)),ref);
 
 
-                   inc(i,tcgsize2size[hp^.size]);
-                   hp:=hp^.Next;
-                 end;
-               else
-                 internalerror(2002071004);
+                  inc(i,tcgsize2size[hp^.size]);
+                  hp:=hp^.Next;
+                end;
+              else
+                internalerror(2002071004);
             end;
             end;
           end;
           end;
       end;
       end;

+ 9 - 2
compiler/defcmp.pas

@@ -289,8 +289,15 @@ implementation
              if assigned(tstoreddef(def_from).genconstraintdata) or
              if assigned(tstoreddef(def_from).genconstraintdata) or
                  assigned(tstoreddef(def_to).genconstraintdata) then
                  assigned(tstoreddef(def_to).genconstraintdata) then
                begin
                begin
-                 { constants could get another deftype (e.g. niln) }
-                 if (def_from.typ<>def_to.typ) and not(fromtreetype in nodetype_const) then
+                 { this is bascially a poor man's type checking, if there is a chance
+                   that the types are equal considering the constraints, this needs probably
+                   to be improved and maybe factored out or even result in a recursive compare_defs_ext }
+                 if (def_from.typ<>def_to.typ) and
+                   { formaldefs are compatible with everything }
+                   not(def_from.typ in [formaldef]) and
+                   not(def_to.typ in [formaldef]) and
+                   { constants could get another deftype (e.g. niln) }
+                   not(fromtreetype in nodetype_const) then
                    begin
                    begin
                      { not compatible anyway }
                      { not compatible anyway }
                      doconv:=tc_not_possible;
                      doconv:=tc_not_possible;

+ 1 - 0
compiler/hlcg2ll.pas

@@ -1297,6 +1297,7 @@ implementation
                reg:=getmmregister(list,newsize);
                reg:=getmmregister(list,newsize);
                a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
                a_loadmm_loc_reg(list,size,newsize,l,reg,mms_movescalar);
                l.size:=def_cgsize(newsize);
                l.size:=def_cgsize(newsize);
+               size:=newsize;
              end;
              end;
           location_freetemp(list,l);
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);
           location_reset(l,LOC_MMREGISTER,l.size);

+ 12 - 0
compiler/msg/errore.msg

@@ -1582,6 +1582,18 @@ parser_w_operator_overloaded_hidden_3=03347_W_Operator overload hidden by intern
 % (in case of dynamic arrays that is the modeswitch \var{ArrayOperators}).
 % (in case of dynamic arrays that is the modeswitch \var{ArrayOperators}).
 parser_e_threadvar_must_be_class=03348_E_Thread variables inside classes or records must be class variables
 parser_e_threadvar_must_be_class=03348_E_Thread variables inside classes or records must be class variables
 % A \var{threadvar} section inside a class or record was started without it being prefixed by \var{class}.
 % A \var{threadvar} section inside a class or record was started without it being prefixed by \var{class}.
+parser_e_only_static_members_via_object_type=03349_E_Only static methods and static variables can be referenced through an object type
+% This error occurs in a situation like the following:
+% \begin{verbatim}
+% Type
+%    TObj = object
+%      procedure test;
+%    end;
+%
+% begin
+%   TObj.test;
+% \end{verbatim}
+% \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
 %
 %
 %
 %
 % \end{description}
 % \end{description}

+ 3 - 2
compiler/msgidx.inc

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

Разлика између датотеке није приказан због своје велике величине
+ 382 - 372
compiler/msgtxt.inc


+ 0 - 18
compiler/ncgmem.pas

@@ -55,10 +55,6 @@ interface
           procedure pass_generate_code;override;
           procedure pass_generate_code;override;
        end;
        end;
 
 
-       tcgwithnode = class(twithnode)
-          procedure pass_generate_code;override;
-       end;
-
        tcgvecnode = class(tvecnode)
        tcgvecnode = class(tvecnode)
          function get_mul_size : asizeint;
          function get_mul_size : asizeint;
        private
        private
@@ -607,19 +603,6 @@ implementation
       end;
       end;
 
 
 
 
-{*****************************************************************************
-                            TCGWITHNODE
-*****************************************************************************}
-
-    procedure tcgwithnode.pass_generate_code;
-      begin
-        location_reset(location,LOC_VOID,OS_NO);
-
-        if assigned(left) then
-          secondpass(left);
-       end;
-
-
 {*****************************************************************************
 {*****************************************************************************
                             TCGVECNODE
                             TCGVECNODE
 *****************************************************************************}
 *****************************************************************************}
@@ -1109,6 +1092,5 @@ begin
    caddrnode:=tcgaddrnode;
    caddrnode:=tcgaddrnode;
    cderefnode:=tcgderefnode;
    cderefnode:=tcgderefnode;
    csubscriptnode:=tcgsubscriptnode;
    csubscriptnode:=tcgsubscriptnode;
-   cwithnode:=tcgwithnode;
    cvecnode:=tcgvecnode;
    cvecnode:=tcgvecnode;
 end.
 end.

+ 1 - 1
compiler/ncgset.pas

@@ -1259,7 +1259,7 @@ implementation
                           (max_label<=high(aint)) and
                           (max_label<=high(aint)) and
                           not((labelcnt<=2) or
                           not((labelcnt<=2) or
                               (distv.svalue<0) or
                               (distv.svalue<0) or
-                              (dist>3*TrueCount)) then
+                              (dist>3*labelcnt)) then
                          begin
                          begin
                            { if the labels less or more a continuum then }
                            { if the labels less or more a continuum then }
                            genjumptable(labels,min_label.svalue,max_label.svalue);
                            genjumptable(labels,min_label.svalue,max_label.svalue);

+ 7 - 1
compiler/ncgutil.pas

@@ -217,7 +217,13 @@ implementation
                  (fcl>0)) or
                  (fcl>0)) or
                 (((fcr=fcl) or
                 (((fcr=fcl) or
                   (fcr=0)) and
                   (fcr=0)) and
-                 (ncr>ncl)) then
+                 (ncr>ncl)) and
+                { if one tree contains nodes being conditionally executated, we cannot swap the trees
+                  as the other tree might depend on all nodes being executed, this applies for example
+                  for temp. create nodes with init part, they must be executed else things break, see
+                  issue #34653
+                }
+                 not(has_conditional_nodes(p.right)) then
                p.swapleftright
                p.swapleftright
            end;
            end;
       end;
       end;

+ 0 - 7
compiler/nflw.pas

@@ -1972,7 +1972,6 @@ implementation
                     if assigned(labelsym.jumpbuf) then
                     if assigned(labelsym.jumpbuf) then
                       begin
                       begin
                         labelsym.nonlocal:=true;
                         labelsym.nonlocal:=true;
-                        exclude(current_procinfo.procdef.procoptions,po_inline);
                         result:=ccallnode.createintern('fpc_longjmp',
                         result:=ccallnode.createintern('fpc_longjmp',
                           ccallparanode.create(cordconstnode.create(1,sinttype,true),
                           ccallparanode.create(cordconstnode.create(1,sinttype,true),
                           ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
                           ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner),
@@ -2107,12 +2106,6 @@ implementation
 
 
         include(current_procinfo.flags,pi_has_label);
         include(current_procinfo.flags,pi_has_label);
 
 
-        if assigned(labsym) and labsym.nonlocal then
-          begin
-            include(current_procinfo.flags,pi_has_interproclabel);
-            exclude(current_procinfo.procdef.procoptions,po_inline);
-          end;
-
         if assigned(left) then
         if assigned(left) then
           firstpass(left);
           firstpass(left);
         if (m_non_local_goto in current_settings.modeswitches) and
         if (m_non_local_goto in current_settings.modeswitches) and

+ 1 - 1
compiler/nld.pas

@@ -332,7 +332,7 @@ implementation
                      internalerror(200309289);
                      internalerror(200309289);
                    left:=cloadparentfpnode.create(tprocdef(symtable.defowner),lpf_forload);
                    left:=cloadparentfpnode.create(tprocdef(symtable.defowner),lpf_forload);
                    { we can't inline the referenced parent procedure }
                    { we can't inline the referenced parent procedure }
-                   exclude(tprocdef(symtable.defowner).procoptions,po_inline);
+                   include(tprocdef(symtable.defowner).implprocoptions,pio_nested_access);
                    { reference in nested procedures, variable needs to be in memory }
                    { reference in nested procedures, variable needs to be in memory }
                    { and behaves as if its address escapes its parent block         }
                    { and behaves as if its address escapes its parent block         }
                    make_not_regable(self,[ra_different_scope]);
                    make_not_regable(self,[ra_different_scope]);

+ 0 - 73
compiler/nmem.pas

@@ -136,25 +136,12 @@ interface
        end;
        end;
        tvecnodeclass = class of tvecnode;
        tvecnodeclass = class of tvecnode;
 
 
-       twithnode = class(tunarynode)
-          constructor create(l:tnode);
-          destructor destroy;override;
-          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function dogetcopy : tnode;override;
-          function pass_1 : tnode;override;
-          function docompare(p: tnode): boolean; override;
-          function pass_typecheck:tnode;override;
-       end;
-       twithnodeclass = class of twithnode;
-
     var
     var
        cloadvmtaddrnode : tloadvmtaddrnodeclass= tloadvmtaddrnode;
        cloadvmtaddrnode : tloadvmtaddrnodeclass= tloadvmtaddrnode;
        caddrnode : taddrnodeclass= taddrnode;
        caddrnode : taddrnodeclass= taddrnode;
        cderefnode : tderefnodeclass= tderefnode;
        cderefnode : tderefnodeclass= tderefnode;
        csubscriptnode : tsubscriptnodeclass= tsubscriptnode;
        csubscriptnode : tsubscriptnodeclass= tsubscriptnode;
        cvecnode : tvecnodeclass= tvecnode;
        cvecnode : tvecnodeclass= tvecnode;
-       cwithnode : twithnodeclass= twithnode;
        cloadparentfpnode : tloadparentfpnodeclass = tloadparentfpnode;
        cloadparentfpnode : tloadparentfpnodeclass = tloadparentfpnode;
 
 
     function is_big_untyped_addrnode(p: tnode): boolean;
     function is_big_untyped_addrnode(p: tnode): boolean;
@@ -1315,66 +1302,6 @@ implementation
     end;
     end;
 
 
 
 
-{*****************************************************************************
-                               TWITHNODE
-*****************************************************************************}
-
-    constructor twithnode.create(l:tnode);
-      begin
-         inherited create(withn,l);
-         fileinfo:=l.fileinfo;
-      end;
-
-
-    destructor twithnode.destroy;
-      begin
-        inherited destroy;
-      end;
-
-
-    constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-      end;
-
-
-    procedure twithnode.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-      end;
-
-
-    function twithnode.dogetcopy : tnode;
-      var
-         p : twithnode;
-      begin
-         p:=twithnode(inherited dogetcopy);
-         result:=p;
-      end;
-
-
-    function twithnode.pass_typecheck:tnode;
-      begin
-        result:=nil;
-        resultdef:=voidtype;
-        if assigned(left) then
-          typecheckpass(left);
-      end;
-
-
-    function twithnode.pass_1 : tnode;
-      begin
-        result:=nil;
-        expectloc:=LOC_VOID;
-      end;
-
-
-    function twithnode.docompare(p: tnode): boolean;
-      begin
-        docompare :=
-          inherited docompare(p);
-      end;
-
     function is_big_untyped_addrnode(p: tnode): boolean;
     function is_big_untyped_addrnode(p: tnode): boolean;
       begin
       begin
         is_big_untyped_addrnode:=(p.nodetype=addrn) and
         is_big_untyped_addrnode:=(p.nodetype=addrn) and

+ 0 - 2
compiler/node.pas

@@ -86,7 +86,6 @@ interface
           whilerepeatn,     {A while or repeat statement}
           whilerepeatn,     {A while or repeat statement}
           forn,             {A for loop}
           forn,             {A for loop}
           exitn,            {An exit statement}
           exitn,            {An exit statement}
-          withn,            {A with statement}
           casen,            {A case statement}
           casen,            {A case statement}
           labeln,           {A label}
           labeln,           {A label}
           goton,            {A goto statement}
           goton,            {A goto statement}
@@ -171,7 +170,6 @@ interface
           'whilerepeatn',
           'whilerepeatn',
           'forn',
           'forn',
           'exitn',
           'exitn',
-          'withn',
           'casen',
           'casen',
           'labeln',
           'labeln',
           'goton',
           'goton',

+ 20 - 0
compiler/nutils.pas

@@ -127,6 +127,9 @@ interface
     { returns true, if the tree given might have side effects }
     { returns true, if the tree given might have side effects }
     function might_have_sideeffects(n : tnode;const flags : tmhs_flags = []) : boolean;
     function might_have_sideeffects(n : tnode;const flags : tmhs_flags = []) : boolean;
 
 
+    { returns true, if n contains nodes which might be conditionally executed }
+    function has_conditional_nodes(n : tnode) : boolean;
+
     { count the number of nodes in the node tree,
     { count the number of nodes in the node tree,
       rough estimation how large the tree "node" is }
       rough estimation how large the tree "node" is }
     function node_count(node : tnode) : dword;
     function node_count(node : tnode) : dword;
@@ -1378,6 +1381,23 @@ implementation
         result:=foreachnodestatic(n,@check_for_sideeffect,@flags);
         result:=foreachnodestatic(n,@check_for_sideeffect,@flags);
       end;
       end;
 
 
+
+    function check_for_conditional_nodes(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        result:=fen_false;
+        { this check is not complete yet, but sufficent to cover the current use case: swapping
+          of trees in expressions }
+        if (n.nodetype in [ifn,whilerepeatn,forn,tryexceptn]) or
+          ((n.nodetype in [orn,andn]) and is_boolean(n.resultdef) and doshortbooleval(n)) then
+          result:=fen_norecurse_true;
+      end;
+
+
+    function has_conditional_nodes(n : tnode) : boolean;
+      begin
+        result:=foreachnodestatic(n,@check_for_conditional_nodes,nil);
+      end;
+
     var
     var
       nodecount : dword;
       nodecount : dword;
 
 

+ 2 - 0
compiler/ogomf.pas

@@ -1553,6 +1553,8 @@ implementation
         Thread: TOmfSubRecord_THREAD;
         Thread: TOmfSubRecord_THREAD;
         FixuppWithoutLeOrLiData: Boolean=False;
         FixuppWithoutLeOrLiData: Boolean=False;
       begin
       begin
+        objsec:=nil;
+        EnumeratedDataOffset:=0;
         Result:=False;
         Result:=False;
         case RawRec.RecordType of
         case RawRec.RecordType of
           RT_LEDATA,RT_LEDATA32:
           RT_LEDATA,RT_LEDATA32:

+ 1 - 1
compiler/optconstprop.pas

@@ -92,7 +92,7 @@ unit optconstprop;
           iterate manually here so we have full controll how all nodes are processed }
           iterate manually here so we have full controll how all nodes are processed }
 
 
         { We cannot analyze beyond those nodes, so we terminate to be on the safe side }
         { We cannot analyze beyond those nodes, so we terminate to be on the safe side }
-        if (n.nodetype in [addrn,derefn,asmn,withn,casen,whilerepeatn,labeln,continuen,breakn,
+        if (n.nodetype in [addrn,derefn,asmn,casen,whilerepeatn,labeln,continuen,breakn,
                            tryexceptn,raisen,tryfinallyn,onn,loadparentfpn,loadvmtaddrn,guidconstn,rttin,addoptn,asn,goton,
                            tryexceptn,raisen,tryfinallyn,onn,loadparentfpn,loadvmtaddrn,guidconstn,rttin,addoptn,asn,goton,
                            objcselectorn,objcprotocoln]) then
                            objcselectorn,objcprotocoln]) then
           exit(false)
           exit(false)

+ 0 - 1
compiler/optutils.pas

@@ -318,7 +318,6 @@ unit optutils;
                 { raise never returns }
                 { raise never returns }
                 p.successor:=nil;
                 p.successor:=nil;
               end;
               end;
-            withn,
             tryexceptn,
             tryexceptn,
             tryfinallyn,
             tryfinallyn,
             onn:
             onn:

+ 0 - 1
compiler/pass_2.pas

@@ -132,7 +132,6 @@ implementation
              'while_repeat', {whilerepeatn}
              'while_repeat', {whilerepeatn}
              'for',         {forn}
              'for',         {forn}
              'exitn',       {exitn}
              'exitn',       {exitn}
-             'with',        {withn}
              'case',        {casen}
              'case',        {casen}
              'label',       {labeln}
              'label',       {labeln}
              'goto',        {goton}
              'goto',        {goton}

+ 43 - 7
compiler/pexpr.pas

@@ -1290,6 +1290,7 @@ implementation
       var
       var
         isclassref:boolean;
         isclassref:boolean;
         isrecordtype:boolean;
         isrecordtype:boolean;
+        isobjecttype:boolean;
       begin
       begin
          if sym=nil then
          if sym=nil then
            begin
            begin
@@ -1310,11 +1311,13 @@ implementation
                    do_typecheckpass(p1);
                    do_typecheckpass(p1);
                  isclassref:=(p1.resultdef.typ=classrefdef);
                  isclassref:=(p1.resultdef.typ=classrefdef);
                  isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
                  isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
+                 isobjecttype:=(p1.nodetype=typen) and is_object(p1.resultdef);
                end
                end
               else
               else
                 begin
                 begin
                   isclassref:=false;
                   isclassref:=false;
                   isrecordtype:=false;
                   isrecordtype:=false;
+                  isobjecttype:=false;
                 end;
                 end;
 
 
               if assigned(spezcontext) and not (sym.typ=procsym) then
               if assigned(spezcontext) and not (sym.typ=procsym) then
@@ -1334,16 +1337,47 @@ implementation
                       if (
                       if (
                             isclassref or
                             isclassref or
                             (
                             (
-                              isrecordtype and
+                              (isobjecttype or
+                               isrecordtype) and
                               not (cnf_inherited in callflags)
                               not (cnf_inherited in callflags)
                             )
                             )
                           ) and
                           ) and
                          (p1.nodetype=calln) and
                          (p1.nodetype=calln) and
                          assigned(tcallnode(p1).procdefinition) then
                          assigned(tcallnode(p1).procdefinition) then
                         begin
                         begin
-                          if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
-                             not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
-                            Message(parser_e_only_class_members_via_class_ref);
+                          if not isobjecttype then
+                            begin
+                              if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
+                                 not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
+                                Message(parser_e_only_class_members_via_class_ref);
+                            end
+                          else
+                            begin
+                              { with objects, you can also do this:
+                                  type
+                                    tparent = object
+                                      procedure test;
+                                    end;
+
+                                    tchild = object(tchild)
+                                      procedure test;
+                                    end;
+
+                                    procedure tparent.test;
+                                      begin
+                                      end;
+
+                                    procedure tchild.test;
+                                      begin
+                                        tparent.test;
+                                      end;
+                              }
+                              if (tcallnode(p1).procdefinition.proctypeoption<>potype_constructor) and
+                                 not(po_staticmethod in tcallnode(p1).procdefinition.procoptions) and
+                                 (not assigned(current_structdef) or
+                                  not def_is_related(current_structdef,structh)) then
+                                Message(parser_e_only_static_members_via_object_type);
+                            end;
                           { in Java, constructors are not automatically inherited
                           { in Java, constructors are not automatically inherited
                             -> calling a constructor from a parent type will create
                             -> calling a constructor from a parent type will create
                                an instance of that parent type! }
                                an instance of that parent type! }
@@ -1361,7 +1395,7 @@ implementation
                               assigned(tcallnode(p1).methodpointer) and
                               assigned(tcallnode(p1).methodpointer) and
                               (tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
                               (tcallnode(p1).methodpointer.nodetype=loadvmtaddrn) then
                             Message1(type_w_instance_abstract_class,structh.RttiName);
                             Message1(type_w_instance_abstract_class,structh.RttiName);
-                        end;
+                        end
                    end;
                    end;
                  fieldvarsym:
                  fieldvarsym:
                    begin
                    begin
@@ -1375,7 +1409,9 @@ implementation
                                 (current_procinfo.procdef.struct=structh))) then
                                 (current_procinfo.procdef.struct=structh))) then
                               Message(parser_e_only_class_members)
                               Message(parser_e_only_class_members)
                             else
                             else
-                              Message(parser_e_only_class_members_via_class_ref);
+                              Message(parser_e_only_class_members_via_class_ref)
+                          else if isobjecttype then
+                            Message(parser_e_only_static_members_via_object_type);
                           p1:=csubscriptnode.create(sym,p1);
                           p1:=csubscriptnode.create(sym,p1);
                         end;
                         end;
                    end;
                    end;
@@ -3255,7 +3291,7 @@ implementation
                         if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                         if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                           begin
                           begin
                             tlabelsym(srsym).nonlocal:=true;
                             tlabelsym(srsym).nonlocal:=true;
-                            exclude(current_procinfo.procdef.procoptions,po_inline);
+                            include(current_procinfo.flags,pi_has_interproclabel);
                           end;
                           end;
                         if tlabelsym(srsym).nonlocal and
                         if tlabelsym(srsym).nonlocal and
                           (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
                           (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then

+ 4 - 1
compiler/pparautl.pas

@@ -854,7 +854,10 @@ implementation
                         the interface version must also have it (otherwise we can
                         the interface version must also have it (otherwise we can
                         get annoying crashes due to interface crc changes) }
                         get annoying crashes due to interface crc changes) }
                       (not(po_overload in fwpd.procoptions) and
                       (not(po_overload in fwpd.procoptions) and
-                       (po_overload in currpd.procoptions)) then
+                       (po_overload in currpd.procoptions)) or
+                      { same with noreturn }
+                      (not(po_noreturn in fwpd.procoptions) and
+                       (po_noreturn in currpd.procoptions)) then
                      begin
                      begin
                        MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
                        MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward,
                                    fwpd.fullprocname(false));
                                    fwpd.fullprocname(false));

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 {$endif Test_Double_checksum}
 
 
 const
 const
-  CurrentPPUVersion = 205;
+  CurrentPPUVersion = 206;
 
 
 { unit flags }
 { unit flags }
   uf_init                = $000001; { unit has initialization section }
   uf_init                = $000001; { unit has initialization section }

+ 1 - 3
compiler/pstatmnt.pas

@@ -776,8 +776,6 @@ implementation
               symtablestack.pop(TSymtable(withsymtablelist[i]));
               symtablestack.pop(TSymtable(withsymtablelist[i]));
             withsymtablelist.free;
             withsymtablelist.free;
 
 
-//            p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refnode);
-
             { Finalize complex withnode with destroy of temp }
             { Finalize complex withnode with destroy of temp }
             if assigned(newblock) then
             if assigned(newblock) then
              begin
              begin
@@ -1257,7 +1255,7 @@ implementation
                    if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                    if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then
                      begin
                      begin
                        tlabelsym(srsym).nonlocal:=true;
                        tlabelsym(srsym).nonlocal:=true;
-                       exclude(current_procinfo.procdef.procoptions,po_inline);
+                       include(current_procinfo.flags,pi_has_interproclabel);
                      end;
                      end;
                    if tlabelsym(srsym).nonlocal and
                    if tlabelsym(srsym).nonlocal and
                      (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
                      (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then

+ 16 - 14
compiler/psub.pas

@@ -157,7 +157,8 @@ implementation
             _no_inline('assembler');
             _no_inline('assembler');
             exit;
             exit;
           end;
           end;
-        if pi_has_global_goto in current_procinfo.flags then
+        if (pi_has_global_goto in current_procinfo.flags) or
+           (pi_has_interproclabel in current_procinfo.flags) then
           begin
           begin
             _no_inline('global goto');
             _no_inline('global goto');
             exit;
             exit;
@@ -180,6 +181,20 @@ implementation
             _no_inline('inherited');
             _no_inline('inherited');
             exit;
             exit;
           end;
           end;
+        if pio_nested_access in procdef.implprocoptions then
+         begin
+           _no_inline('access to local from nested scope');
+           exit;
+         end;
+        { We can't support inlining for procedures that have nested
+          procedures because the nested procedures use a fixed offset
+          for accessing locals in the parent procedure (PFV) }
+        if current_procinfo.has_nestedprocs then
+          begin
+            _no_inline('nested procedures');
+            exit;
+          end;
+
         for i:=0 to procdef.paras.count-1 do
         for i:=0 to procdef.paras.count-1 do
           begin
           begin
             currpara:=tparavarsym(procdef.paras[i]);
             currpara:=tparavarsym(procdef.paras[i]);
@@ -2132,19 +2147,6 @@ implementation
         if (pd.proctypeoption=potype_constructor) then
         if (pd.proctypeoption=potype_constructor) then
           tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
           tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
 
 
-        { We can't support inlining for procedures that have nested
-          procedures because the nested procedures use a fixed offset
-          for accessing locals in the parent procedure (PFV) }
-        if current_procinfo.has_nestedprocs then
-          begin
-            if (po_inline in current_procinfo.procdef.procoptions) then
-              begin
-                Message1(parser_n_not_supported_for_inline,'nested procedures');
-                Message(parser_h_inlining_disabled);
-                exclude(current_procinfo.procdef.procoptions,po_inline);
-              end;
-          end;
-
         { When it's a nested procedure then defer the code generation,
         { When it's a nested procedure then defer the code generation,
           when back at normal function level then generate the code
           when back at normal function level then generate the code
           for all defered nested procedures and the current procedure }
           for all defered nested procedures and the current procedure }

+ 0 - 1
compiler/psystem.pas

@@ -799,7 +799,6 @@ implementation
         nodeclass[whilerepeatn]:=cwhilerepeatnode;
         nodeclass[whilerepeatn]:=cwhilerepeatnode;
         nodeclass[forn]:=cfornode;
         nodeclass[forn]:=cfornode;
         nodeclass[exitn]:=cexitnode;
         nodeclass[exitn]:=cexitnode;
-        nodeclass[withn]:=cwithnode;
         nodeclass[casen]:=ccasenode;
         nodeclass[casen]:=ccasenode;
         nodeclass[labeln]:=clabelnode;
         nodeclass[labeln]:=clabelnode;
         nodeclass[goton]:=cgotonode;
         nodeclass[goton]:=cgotonode;

+ 1 - 1
compiler/rautils.pas

@@ -1681,7 +1681,7 @@ Begin
           begin
           begin
             Tlabelsym(sym).nonlocal:=true;
             Tlabelsym(sym).nonlocal:=true;
             if emit then
             if emit then
-              exclude(current_procinfo.procdef.procoptions,po_inline);
+              include(current_procinfo.flags,pi_has_interproclabel);
           end;
           end;
         if not(assigned(tlabelsym(sym).asmblocklabel)) then
         if not(assigned(tlabelsym(sym).asmblocklabel)) then
           if Tlabelsym(sym).nonlocal then
           if Tlabelsym(sym).nonlocal then

+ 3 - 7
compiler/sparcgen/aoptcpu.pas

@@ -237,7 +237,6 @@ unit aoptcpu;
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
   function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
     var
     var
       next,next2: tai;
       next,next2: tai;
-      TmpUsedRegs: TAllUsedRegs;
     begin
     begin
       result:=false;
       result:=false;
       case p.typ of
       case p.typ of
@@ -262,7 +261,7 @@ unit aoptcpu;
                     { the initial register may not be reused }
                     { the initial register may not be reused }
                     (not RegUsedBetween(taicpu(p).oper[0]^.reg,next,next2)) then
                     (not RegUsedBetween(taicpu(p).oper[0]^.reg,next,next2)) then
                     begin
                     begin
-                      CopyUsedRegs(TmpUsedRegs);
+                      TransferUsedRegs(TmpUsedRegs);
                       UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(next.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(next.next));
                       if not RegUsedAfterInstruction(taicpu(p).oper[2]^.reg,next2,TmpUsedRegs) then
                       if not RegUsedAfterInstruction(taicpu(p).oper[2]^.reg,next2,TmpUsedRegs) then
@@ -275,7 +274,6 @@ unit aoptcpu;
                           next.free;
                           next.free;
                           p:=next2;
                           p:=next2;
                         end;
                         end;
-                      ReleaseUsedRegs(TmpUsedRegs);
                     end
                     end
                   else
                   else
                     TryRemoveMov(p,A_MOV);
                     TryRemoveMov(p,A_MOV);
@@ -300,7 +298,7 @@ unit aoptcpu;
                     { the initial register may not be reused }
                     { the initial register may not be reused }
                     (not RegUsedBetween(taicpu(p).oper[0]^.reg,next,next2)) then
                     (not RegUsedBetween(taicpu(p).oper[0]^.reg,next,next2)) then
                     begin
                     begin
-                      CopyUsedRegs(TmpUsedRegs);
+                      TransferUsedRegs(TmpUsedRegs);
                       UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(next.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(next.next));
                       if not RegUsedAfterInstruction(taicpu(p).oper[2]^.reg,next2,TmpUsedRegs) then
                       if not RegUsedAfterInstruction(taicpu(p).oper[2]^.reg,next2,TmpUsedRegs) then
@@ -313,7 +311,6 @@ unit aoptcpu;
                           next.free;
                           next.free;
                           p:=next2;
                           p:=next2;
                         end;
                         end;
-                      ReleaseUsedRegs(TmpUsedRegs);
                     end
                     end
                   else
                   else
                     TryRemoveMov(p,A_MOV);
                     TryRemoveMov(p,A_MOV);
@@ -388,7 +385,7 @@ unit aoptcpu;
                     (taicpu(next).oper[0]^.typ=top_reg) and
                     (taicpu(next).oper[0]^.typ=top_reg) and
                     (taicpu(next).oper[0]^.reg=taicpu(p).oper[2]^.reg) then
                     (taicpu(next).oper[0]^.reg=taicpu(p).oper[2]^.reg) then
                     begin
                     begin
-                      CopyUsedRegs(TmpUsedRegs);
+                      TransferUsedRegs(TmpUsedRegs);
                       UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                       UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                       if not RegUsedAfterInstruction(taicpu(p).oper[2]^.reg,next,TmpUsedRegs) then
                       if not RegUsedAfterInstruction(taicpu(p).oper[2]^.reg,next,TmpUsedRegs) then
                         begin
                         begin
@@ -397,7 +394,6 @@ unit aoptcpu;
                           p.free;
                           p.free;
                           p:=next;
                           p:=next;
                         end;
                         end;
-                      ReleaseUsedRegs(TmpUsedRegs);
                     end
                     end
                   else
                   else
                     TryRemoveMov(p,A_MOV);
                     TryRemoveMov(p,A_MOV);

+ 3 - 1
compiler/symconst.pas

@@ -426,7 +426,9 @@ type
     { the inline body of this routine is available }
     { the inline body of this routine is available }
     pio_has_inlininginfo,
     pio_has_inlininginfo,
     { inline is not possible (has assembler block, etc) }
     { inline is not possible (has assembler block, etc) }
-    pio_inline_not_possible
+    pio_inline_not_possible,
+    { a nested routine accesses a local variable from this routine }
+    pio_nested_access
   );
   );
   timplprocoptions = set of timplprocoption;
   timplprocoptions = set of timplprocoption;
 
 

+ 1 - 1
compiler/systems.pas

@@ -353,7 +353,7 @@ interface
        systems_internal_sysinit = [system_i386_win32,system_x86_64_win64,
        systems_internal_sysinit = [system_i386_win32,system_x86_64_win64,
                                    system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux,
                                    system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux,
                                    system_m68k_atari,system_m68k_palmos,
                                    system_m68k_atari,system_m68k_palmos,
-                                   system_x86_64_haiku
+                                   system_i386_haiku,system_x86_64_haiku
                                   ]+systems_darwin+systems_amigalike;
                                   ]+systems_darwin+systems_amigalike;
 
 
        { all systems that use garbage collection for reference-counted types }
        { all systems that use garbage collection for reference-counted types }

+ 4 - 3
compiler/systems/i_haiku.pas

@@ -36,7 +36,8 @@ unit i_haiku;
             name         : 'Haiku for i386';
             name         : 'Haiku for i386';
             shortname    : 'Haiku';
             shortname    : 'Haiku';
             flags        : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive,
             flags        : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive,
-                            tf_smartlink_sections, tf_has_winlike_resources];
+                            tf_pic_default,tf_pic_uses_got,tf_library_needs_pic,
+                            tf_smartlink_sections,tf_has_winlike_resources];
             cpu          : cpu_i386;
             cpu          : cpu_i386;
             unit_env     : 'HAIKUUNITS';
             unit_env     : 'HAIKUUNITS';
             extradefines : 'BEOS;UNIX;HASUNIX';
             extradefines : 'BEOS;UNIX;HASUNIX';
@@ -99,7 +100,7 @@ unit i_haiku;
               Under R5, this value is even greater. listarea report a default 
               Under R5, this value is even greater. listarea report a default 
               size of 16 Mb for the user stack of the main thread.
               size of 16 Mb for the user stack of the main thread.
               People who still use BeOS nowadays should use R5 (or Haiku), 
               People who still use BeOS nowadays should use R5 (or Haiku), 
-              so i use this new value.  
+              so i use this new value.
             }
             }
             stacksize    : 16 * 1024 * 1024;
             stacksize    : 16 * 1024 * 1024;
             stackalign   : 4;
             stackalign   : 4;
@@ -149,7 +150,7 @@ unit i_haiku;
             linkextern   : ld_haiku;
             linkextern   : ld_haiku;
             ar           : ar_gnu_ar;
             ar           : ar_gnu_ar;
             res          : res_elf;
             res          : res_elf;
-            dbg          : dbg_stabs;
+            dbg          : dbg_dwarf2;
             script       : script_unix;
             script       : script_unix;
             endian       : endian_little;
             endian       : endian_little;
             { FIXME: stuff below is copied from Linux/x64 now, could be incorrect for Haiku (KB) }
             { FIXME: stuff below is copied from Linux/x64 now, could be incorrect for Haiku (KB) }

+ 6 - 0
compiler/systems/t_linux.pas

@@ -178,6 +178,12 @@ begin
 {$ifdef m68k}
 {$ifdef m68k}
       LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/m68k-linux-gnu',true);
       LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/m68k-linux-gnu',true);
 {$endif m68k}
 {$endif m68k}
+{$ifdef mipsel}
+      LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/mipsel-linux-gnu',true);
+{$endif mipsel}
+{$ifdef mips}
+      LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/mips-linux-gnu',true);
+{$endif mips}
 {$ifdef sparc64}
 {$ifdef sparc64}
       LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/sparc64-linux-gnu',true);
       LibrarySearchPath.AddPath(sysrootpath,'/usr/lib/sparc64-linux-gnu',true);
 {$endif sparc64}
 {$endif sparc64}

+ 12 - 6
compiler/utils/fpc.pp

@@ -231,8 +231,14 @@ program fpc;
                              cpusuffix:='a64'
                              cpusuffix:='a64'
                            else if processorstr='arm' then
                            else if processorstr='arm' then
                              cpusuffix:='arm'
                              cpusuffix:='arm'
+                           else if processorstr='avr' then
+                             cpusuffix:='avr'
                            else if processorstr='i386' then
                            else if processorstr='i386' then
                              cpusuffix:='386'
                              cpusuffix:='386'
+                           else if processorstr='i8086' then
+                             cpusuffix:='8086'
+                           else if processorstr='jvm' then
+                             cpusuffix:='jvm'
                            else if processorstr='m68k' then
                            else if processorstr='m68k' then
                              cpusuffix:='68k'
                              cpusuffix:='68k'
                            else if processorstr='mips' then
                            else if processorstr='mips' then
@@ -243,16 +249,16 @@ program fpc;
                              cpusuffix:='ppc'
                              cpusuffix:='ppc'
                            else if processorstr='powerpc64' then
                            else if processorstr='powerpc64' then
                              cpusuffix:='ppc64'
                              cpusuffix:='ppc64'
+                           else if processorstr='riscv32' then
+                             cpusuffix:='rv32'
+                           else if processorstr='riscv64' then
+                             cpusuffix:='rv64'
                            else if processorstr='sparc' then
                            else if processorstr='sparc' then
                              cpusuffix:='sparc'
                              cpusuffix:='sparc'
+                           else if processorstr='sparc64' then
+                             cpusuffix:='sparc64'
                            else if processorstr='x86_64' then
                            else if processorstr='x86_64' then
                              cpusuffix:='x64'
                              cpusuffix:='x64'
-                           else if processorstr='jvm' then
-                             cpusuffix:='jvm'
-                           else if processorstr='i8086' then
-                             cpusuffix:='8086'
-                           else if processorstr='avr' then
-                             cpusuffix:='avr'
                            else
                            else
                              error('Illegal processor type "'+processorstr+'"');
                              error('Illegal processor type "'+processorstr+'"');
 
 

+ 2 - 1
compiler/utils/ppuutils/ppudump.pp

@@ -2232,7 +2232,8 @@ const
   piopt : array[low(timplprocoption)..high(timplprocoption)] of tpiopt=(
   piopt : array[low(timplprocoption)..high(timplprocoption)] of tpiopt=(
     (mask:pio_empty; str:'IsEmpty'),
     (mask:pio_empty; str:'IsEmpty'),
     (mask:pio_has_inlininginfo; str:'HasInliningInfo'),
     (mask:pio_has_inlininginfo; str:'HasInliningInfo'),
-    (mask:pio_inline_not_possible; str:'InlineNotPossible')
+    (mask:pio_inline_not_possible; str:'InlineNotPossible'),
+    (mask:pio_nested_access; str:'NestedAccess')
   );
   );
 var
 var
   i: timplprocoption;
   i: timplprocoption;

+ 25 - 57
compiler/x86/aoptx86.pas

@@ -583,7 +583,6 @@ unit aoptx86;
       end;
       end;
 {$endif DEBUG_AOPTCPU}
 {$endif DEBUG_AOPTCPU}
 
 
-
     function TX86AsmOptimizer.Reg1WriteOverwritesReg2Entirely(reg1, reg2: tregister): boolean;
     function TX86AsmOptimizer.Reg1WriteOverwritesReg2Entirely(reg1, reg2: tregister): boolean;
       begin
       begin
         if not SuperRegistersEqual(reg1,reg2) then
         if not SuperRegistersEqual(reg1,reg2) then
@@ -1032,7 +1031,6 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.OptPass1MOVAP(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass1MOVAP(var p : tai) : boolean;
       var
       var
-        TmpUsedRegs : TAllUsedRegs;
         hp1,hp2 : tai;
         hp1,hp2 : tai;
       begin
       begin
         result:=false;
         result:=false;
@@ -1059,7 +1057,7 @@ unit aoptx86;
                      addsX/subsX/... reg3,reg
                      addsX/subsX/... reg3,reg
           }
           }
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
             If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
             If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
@@ -1081,14 +1079,12 @@ unit aoptx86;
                 p:=hp1;
                 p:=hp1;
                 result:=true;
                 result:=true;
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
           end
           end
         end;
         end;
 
 
 
 
     function TX86AsmOptimizer.OptPass1VMOVAP(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass1VMOVAP(var p : tai) : boolean;
       var
       var
-        TmpUsedRegs : TAllUsedRegs;
         hp1,hp2 : tai;
         hp1,hp2 : tai;
       begin
       begin
         result:=false;
         result:=false;
@@ -1116,7 +1112,7 @@ unit aoptx86;
                       dealloc reg2
                       dealloc reg2
                       =>
                       =>
                       vmova* reg1,reg3 }
                       vmova* reg1,reg3 }
-                    CopyUsedRegs(TmpUsedRegs);
+                    TransferUsedRegs(TmpUsedRegs);
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
                     if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
                       begin
                       begin
@@ -1145,7 +1141,7 @@ unit aoptx86;
                   MatchInstruction(hp2,A_VMOVAPD,A_VMOVAPS,[S_NO]) and
                   MatchInstruction(hp2,A_VMOVAPD,A_VMOVAPS,[S_NO]) and
                   MatchOperand(taicpu(p).oper[0]^,taicpu(hp2).oper[1]^) then
                   MatchOperand(taicpu(p).oper[0]^,taicpu(hp2).oper[1]^) then
                   begin
                   begin
-                    CopyUsedRegs(TmpUsedRegs);
+                    TransferUsedRegs(TmpUsedRegs);
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                     UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                     if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs))
                     if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs))
@@ -1166,7 +1162,6 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.OptPass1VOP(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass1VOP(var p : tai) : boolean;
       var
       var
-        TmpUsedRegs : TAllUsedRegs;
         hp1 : tai;
         hp1 : tai;
       begin
       begin
         result:=false;
         result:=false;
@@ -1186,7 +1181,7 @@ unit aoptx86;
           MatchOperand(taicpu(p).oper[2]^,taicpu(hp1).oper[0]^) and
           MatchOperand(taicpu(p).oper[2]^,taicpu(hp1).oper[0]^) and
           (taicpu(hp1).oper[1]^.typ=top_reg) then
           (taicpu(hp1).oper[1]^.typ=top_reg) then
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             if not(RegUsedAfterInstruction(taicpu(hp1).oper[0]^.reg,hp1,TmpUsedRegs)
             if not(RegUsedAfterInstruction(taicpu(hp1).oper[0]^.reg,hp1,TmpUsedRegs)
              ) then
              ) then
@@ -1204,7 +1199,6 @@ unit aoptx86;
     function TX86AsmOptimizer.OptPass1MOV(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass1MOV(var p : tai) : boolean;
       var
       var
         hp1, hp2: tai;
         hp1, hp2: tai;
-        TmpUsedRegs : TAllUsedRegs;
         GetNextInstruction_p: Boolean;
         GetNextInstruction_p: Boolean;
         PreMessage, RegName1, RegName2, InputVal, MaskNum: string;
         PreMessage, RegName1, RegName2, InputVal, MaskNum: string;
         NewSize: topsize;
         NewSize: topsize;
@@ -1337,10 +1331,10 @@ unit aoptx86;
                     taicpu(p).oper[1]^ := taicpu(hp1).oper[1]^;
                     taicpu(p).oper[1]^ := taicpu(hp1).oper[1]^;
 
 
                     { Safeguard if "and" is followed by a conditional command }
                     { Safeguard if "and" is followed by a conditional command }
-                    CopyUsedRegs(TmpUsedRegs);
-                    UpdateUsedRegs(TmpUsedRegs,tai(hp1.next));
+                    TransferUsedRegs(TmpUsedRegs);
+                    UpdateUsedRegs(TmpUsedRegs,tai(p.next));
 
 
-                    if (RegUsedAfterInstruction(NR_DEFAULTFLAGS, tai(hp1.next), TmpUsedRegs)) then
+                    if (RegUsedAfterInstruction(NR_DEFAULTFLAGS, hp1, TmpUsedRegs)) then
                       begin
                       begin
                         { At this point, the "and" command is effectively equivalent to
                         { At this point, the "and" command is effectively equivalent to
                           "test %reg,%reg". This will be handled separately by the
                           "test %reg,%reg". This will be handled separately by the
@@ -1359,8 +1353,6 @@ unit aoptx86;
                       end;
                       end;
 
 
                     Result := True;
                     Result := True;
-
-                    ReleaseUsedRegs(TmpUsedRegs);
                     Exit;
                     Exit;
 
 
                   end;
                   end;
@@ -1371,7 +1363,7 @@ unit aoptx86;
           (taicpu(p).oper[1]^.typ = top_reg) and
           (taicpu(p).oper[1]^.typ = top_reg) and
           MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
           MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
             UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
             { we have
             { we have
                 mov x, %treg
                 mov x, %treg
@@ -1402,7 +1394,6 @@ unit aoptx86;
                     DebugMsg(SPeepholeOptimization + 'MovMov2Mov 2 done',p);
                     DebugMsg(SPeepholeOptimization + 'MovMov2Mov 2 done',p);
                     asml.remove(hp1);
                     asml.remove(hp1);
                     hp1.free;
                     hp1.free;
-                    ReleaseUsedRegs(TmpUsedRegs);
                     Result:=true;
                     Result:=true;
                     Exit;
                     Exit;
                   end;
                   end;
@@ -1425,7 +1416,6 @@ unit aoptx86;
                         DebugMsg(SPeepholeOptimization + 'MovMov2Mov 5 done',p);
                         DebugMsg(SPeepholeOptimization + 'MovMov2Mov 5 done',p);
                         asml.remove(hp1);
                         asml.remove(hp1);
                         hp1.free;
                         hp1.free;
-                        ReleaseUsedRegs(TmpUsedRegs);
                         Result:=true;
                         Result:=true;
                         Exit;
                         Exit;
                       end;
                       end;
@@ -1445,12 +1435,10 @@ unit aoptx86;
                       DebugMsg(SPeepholeOptimization + 'MovMov2Mov 3 done',p);
                       DebugMsg(SPeepholeOptimization + 'MovMov2Mov 3 done',p);
                       asml.remove(hp1);
                       asml.remove(hp1);
                       hp1.free;
                       hp1.free;
-                      ReleaseUsedRegs(TmpUsedRegs);
                       Result:=true;
                       Result:=true;
                       Exit;
                       Exit;
                     end;
                     end;
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
           end
           end
         else
         else
           { Change
           { Change
@@ -1486,7 +1474,7 @@ unit aoptx86;
                    test/or/and %reg2, %reg2
                    test/or/and %reg2, %reg2
                 }
                 }
                 begin
                 begin
-                  CopyUsedRegs(TmpUsedRegs);
+                  TransferUsedRegs(TmpUsedRegs);
                   { reg1 will be used after the first instruction,
                   { reg1 will be used after the first instruction,
                     so update the allocation info                  }
                     so update the allocation info                  }
                   AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,usedregs);
                   AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,usedregs);
@@ -1512,7 +1500,6 @@ unit aoptx86;
                         asml.remove(p);
                         asml.remove(p);
                         p.free;
                         p.free;
                         p := hp1;
                         p := hp1;
-                        ReleaseUsedRegs(TmpUsedRegs);
                         Exit;
                         Exit;
                       end
                       end
                     else
                     else
@@ -1532,7 +1519,6 @@ unit aoptx86;
                         taicpu(hp1).loadoper(1,taicpu(p).oper[0]^);
                         taicpu(hp1).loadoper(1,taicpu(p).oper[0]^);
                         DebugMsg(SPeepholeOptimization + 'MovTestJxx2MovTestJxx done',p);
                         DebugMsg(SPeepholeOptimization + 'MovTestJxx2MovTestJxx done',p);
                       end;
                       end;
-                  ReleaseUsedRegs(TmpUsedRegs);
                 end
                 end
             end
             end
         else
         else
@@ -1606,7 +1592,7 @@ unit aoptx86;
                       end
                       end
                     else
                     else
                       begin
                       begin
-                        CopyUsedRegs(TmpUsedRegs);
+                        TransferUsedRegs(TmpUsedRegs);
                         UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                         UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                         if (taicpu(p).oper[1]^.typ = top_ref) and
                         if (taicpu(p).oper[1]^.typ = top_ref) and
                           { mov reg1, mem1
                           { mov reg1, mem1
@@ -1631,7 +1617,6 @@ unit aoptx86;
                             AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,UsedRegs);
                             AllocRegBetween(taicpu(p).oper[0]^.reg,p,hp1,UsedRegs);
                             DebugMsg(SPeepholeOptimization + 'MovMovCmp2MovCmp done',hp1);
                             DebugMsg(SPeepholeOptimization + 'MovMovCmp2MovCmp done',hp1);
                           end;
                           end;
-                        ReleaseUsedRegs(TmpUsedRegs);
                       end;
                       end;
                   end
                   end
                 else if (taicpu(p).oper[1]^.typ=top_ref) and
                 else if (taicpu(p).oper[1]^.typ=top_ref) and
@@ -1643,7 +1628,7 @@ unit aoptx86;
                   end
                   end
                 else
                 else
                   begin
                   begin
-                    CopyUsedRegs(TmpUsedRegs);
+                    TransferUsedRegs(TmpUsedRegs);
                     if GetNextInstruction(hp1, hp2) and
                     if GetNextInstruction(hp1, hp2) and
                       MatchOpType(taicpu(p),top_ref,top_reg) and
                       MatchOpType(taicpu(p),top_ref,top_reg) and
                       MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) and
                       MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) and
@@ -1715,7 +1700,6 @@ unit aoptx86;
                         end
                         end
 {$endif i386}
 {$endif i386}
                         ;
                         ;
-                    ReleaseUsedRegs(TmpUsedRegs);
                   end;
                   end;
               end
               end
 (*          { movl [mem1],reg1
 (*          { movl [mem1],reg1
@@ -1801,7 +1785,7 @@ unit aoptx86;
                 to
                 to
                          add/sub/or/... reg3/$const, reg/ref      }
                          add/sub/or/... reg3/$const, reg/ref      }
               begin
               begin
-                CopyUsedRegs(TmpUsedRegs);
+                TransferUsedRegs(TmpUsedRegs);
                 UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                 UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                 UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                 UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                 If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
                 If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
@@ -1855,11 +1839,13 @@ unit aoptx86;
                     hp2.Free;
                     hp2.Free;
                     p := hp1;
                     p := hp1;
                   end;
                   end;
-                ReleaseUsedRegs(TmpUsedRegs);
               end
               end
-{$ifndef x86_64}
             else if MatchOpType(taicpu(hp2),top_reg,top_reg) and
             else if MatchOpType(taicpu(hp2),top_reg,top_reg) and
-              not(SuperRegistersEqual(taicpu(hp1).oper[0]^.reg,taicpu(hp2).oper[1]^.reg))
+              not(SuperRegistersEqual(taicpu(hp1).oper[0]^.reg,taicpu(hp2).oper[1]^.reg)) and
+              (not((taicpu(hp1).opsize=S_Q) and (taicpu(hp2).opsize=S_L)) or
+               { opsize matters for these opcodes, we could probably work around this, but it is not worth the effort }
+               ((taicpu(hp1).opcode<>A_SHL) and (taicpu(hp1).opcode<>A_SHR) and (taicpu(hp1).opcode<>A_SAR))
+              )
 {$ifdef i386}
 {$ifdef i386}
               { byte registers of esi, edi, ebp, esp are not available on i386 }
               { byte registers of esi, edi, ebp, esp are not available on i386 }
               and ((taicpu(hp2).opsize<>S_B) or not(getsupreg(taicpu(hp1).oper[0]^.reg) in [RS_ESI,RS_EDI,RS_EBP,RS_ESP]))
               and ((taicpu(hp2).opsize<>S_B) or not(getsupreg(taicpu(hp1).oper[0]^.reg) in [RS_ESI,RS_EDI,RS_EBP,RS_ESP]))
@@ -1875,7 +1861,7 @@ unit aoptx86;
                          add/sub/or/... reg3/$const, reg3
                          add/sub/or/... reg3/$const, reg3
               }
               }
               begin
               begin
-                CopyUsedRegs(TmpUsedRegs);
+                TransferUsedRegs(TmpUsedRegs);
                 UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                 UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                 UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                 UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
                 If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
                 If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
@@ -1930,11 +1916,8 @@ unit aoptx86;
                     }
                     }
                     asml.remove(hp2);
                     asml.remove(hp2);
                     hp2.Free;
                     hp2.Free;
-//                    p := hp1;
                   end;
                   end;
-                ReleaseUsedRegs(TmpUsedRegs);
               end;
               end;
-{$endif x86_64}
           end
           end
         else if GetNextInstruction_p and
         else if GetNextInstruction_p and
           MatchInstruction(hp1,A_BTS,A_BTR,[Taicpu(p).opsize]) and
           MatchInstruction(hp1,A_BTS,A_BTR,[Taicpu(p).opsize]) and
@@ -1973,7 +1956,7 @@ unit aoptx86;
 
 
              add reg2,ref}
              add reg2,ref}
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             { reg1 may not be used afterwards }
             { reg1 may not be used afterwards }
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)) then
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)) then
               begin
               begin
@@ -1984,7 +1967,6 @@ unit aoptx86;
                 p.free;
                 p.free;
                 p:=hp1;
                 p:=hp1;
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
           end;
           end;
       end;
       end;
 
 
@@ -2044,7 +2026,6 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.OptPass1OP(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass1OP(var p : tai) : boolean;
       var
       var
-        TmpUsedRegs : TAllUsedRegs;
         hp1 : tai;
         hp1 : tai;
       begin
       begin
         result:=false;
         result:=false;
@@ -2065,7 +2046,7 @@ unit aoptx86;
           MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[1]^) and
           MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[1]^) and
           (taicpu(p).oper[0]^.typ=top_reg) then
           (taicpu(p).oper[0]^.typ=top_reg) then
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
               begin
               begin
@@ -2076,7 +2057,6 @@ unit aoptx86;
                 hp1.Free;
                 hp1.Free;
                 result:=true;
                 result:=true;
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
           end;
           end;
       end;
       end;
 
 
@@ -2085,7 +2065,6 @@ unit aoptx86;
       var
       var
         hp1 : tai;
         hp1 : tai;
         l : ASizeInt;
         l : ASizeInt;
-        TmpUsedRegs : TAllUsedRegs;
       begin
       begin
         Result:=false;
         Result:=false;
         { removes seg register prefixes from LEA operations, as they
         { removes seg register prefixes from LEA operations, as they
@@ -2167,7 +2146,7 @@ unit aoptx86;
           MatchOpType(Taicpu(hp1),top_reg,top_reg) and
           MatchOpType(Taicpu(hp1),top_reg,top_reg) and
           (taicpu(p).oper[1]^.reg<>NR_STACK_POINTER_REG) then
           (taicpu(p).oper[1]^.reg<>NR_STACK_POINTER_REG) then
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
               begin
               begin
@@ -2177,7 +2156,6 @@ unit aoptx86;
                 hp1.Free;
                 hp1.Free;
                 result:=true;
                 result:=true;
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
           end;
           end;
       end;
       end;
 
 
@@ -2405,7 +2383,6 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.OptPass1SETcc(var p: tai): boolean;
     function TX86AsmOptimizer.OptPass1SETcc(var p: tai): boolean;
       var
       var
-        TmpUsedRegs : TAllUsedRegs;
         hp1,hp2,next: tai; SetC, JumpC: TAsmCond;
         hp1,hp2,next: tai; SetC, JumpC: TAsmCond;
       begin
       begin
         Result:=false;
         Result:=false;
@@ -2432,10 +2409,9 @@ unit aoptx86;
           begin
           begin
             next := tai(p.Next);
             next := tai(p.Next);
 
 
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, next);
             UpdateUsedRegs(TmpUsedRegs, next);
             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
             UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
-            UpdateUsedRegs(TmpUsedRegs, tai(hp2.next));
 
 
             asml.Remove(hp1);
             asml.Remove(hp1);
             hp1.Free;
             hp1.Free;
@@ -2463,8 +2439,6 @@ unit aoptx86;
                 p := hp2;
                 p := hp2;
               end;
               end;
 
 
-            ReleaseUsedRegs(TmpUsedRegs);
-
             DebugMsg(SPeepholeOptimization + 'SETcc/TEST/Jcc -> Jcc',p);
             DebugMsg(SPeepholeOptimization + 'SETcc/TEST/Jcc -> Jcc',p);
           end;
           end;
       end;
       end;
@@ -2472,7 +2446,6 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.OptPass2MOV(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass2MOV(var p : tai) : boolean;
       var
       var
-       TmpUsedRegs : TAllUsedRegs;
        hp1,hp2: tai;
        hp1,hp2: tai;
 {$ifdef x86_64}
 {$ifdef x86_64}
        hp3: tai;
        hp3: tai;
@@ -2497,9 +2470,8 @@ unit aoptx86;
             { Don't remove the MOV command without first checking that reg2 isn't used afterwards,
             { Don't remove the MOV command without first checking that reg2 isn't used afterwards,
               or unless supreg(reg3) = supreg(reg2)). [Kit] }
               or unless supreg(reg3) = supreg(reg2)). [Kit] }
 
 
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
             UpdateUsedRegs(TmpUsedRegs, tai(p.next));
-            UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
 
 
             if (getsupreg(taicpu(p).oper[1]^.reg) = getsupreg(taicpu(hp1).oper[1]^.reg)) or
             if (getsupreg(taicpu(p).oper[1]^.reg) = getsupreg(taicpu(hp1).oper[1]^.reg)) or
               not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)
               not RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)
@@ -2511,7 +2483,6 @@ unit aoptx86;
                 Result:=true;
                 Result:=true;
               end;
               end;
 
 
-            ReleaseUsedRegs(TmpUsedRegs);
             exit;
             exit;
           end
           end
         else if MatchOpType(taicpu(p),top_reg,top_reg) and
         else if MatchOpType(taicpu(p),top_reg,top_reg) and
@@ -2569,7 +2540,7 @@ unit aoptx86;
           MatchOperand(taicpu(hp1).oper[taicpu(hp1).ops-1]^,taicpu(hp2).oper[0]^) and
           MatchOperand(taicpu(hp1).oper[taicpu(hp1).ops-1]^,taicpu(hp2).oper[0]^) and
           (taicpu(hp2).oper[1]^.typ = top_ref) then
           (taicpu(hp2).oper[1]^.typ = top_ref) then
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             UpdateUsedRegs(TmpUsedRegs,tai(p.next));
             UpdateUsedRegs(TmpUsedRegs,tai(p.next));
             UpdateUsedRegs(TmpUsedRegs,tai(hp1.next));
             UpdateUsedRegs(TmpUsedRegs,tai(hp1.next));
             if (RefsEqual(taicpu(hp2).oper[1]^.ref^,taicpu(p).oper[0]^.ref^) and
             if (RefsEqual(taicpu(hp2).oper[1]^.ref^,taicpu(p).oper[0]^.ref^) and
@@ -2604,7 +2575,6 @@ unit aoptx86;
                 hp2.free;
                 hp2.free;
                 p := hp1
                 p := hp1
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
             Exit;
             Exit;
 {$ifdef x86_64}
 {$ifdef x86_64}
           end
           end
@@ -2706,7 +2676,6 @@ unit aoptx86;
 
 
     function TX86AsmOptimizer.OptPass2Imul(var p : tai) : boolean;
     function TX86AsmOptimizer.OptPass2Imul(var p : tai) : boolean;
       var
       var
-        TmpUsedRegs : TAllUsedRegs;
         hp1 : tai;
         hp1 : tai;
       begin
       begin
         Result:=false;
         Result:=false;
@@ -2723,7 +2692,7 @@ unit aoptx86;
            ((taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) or
            ((taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) or
             ((taicpu(hp1).opsize=S_L) and (taicpu(p).opsize=S_Q) and SuperRegistersEqual(taicpu(hp1).oper[1]^.reg,taicpu(p).oper[1]^.reg))) then
             ((taicpu(hp1).opsize=S_L) and (taicpu(p).opsize=S_Q) and SuperRegistersEqual(taicpu(hp1).oper[1]^.reg,taicpu(p).oper[1]^.reg))) then
           begin
           begin
-            CopyUsedRegs(TmpUsedRegs);
+            TransferUsedRegs(TmpUsedRegs);
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,p,TmpUsedRegs)) then
             if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,p,TmpUsedRegs)) then
               { change
               { change
                   mov reg1,reg2
                   mov reg1,reg2
@@ -2737,7 +2706,6 @@ unit aoptx86;
                 hp1.free;
                 hp1.free;
                 result:=true;
                 result:=true;
               end;
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
           end;
           end;
       end;
       end;
 
 

+ 1 - 1
compiler/x86/cpubase.pas

@@ -848,7 +848,7 @@ implementation
           A_LODS,A_OUTS:
           A_LODS,A_OUTS:
             result:=-1;
             result:=-1;
           else
           else
-            internalerror(2017101202);
+            internalerror(2017101204);
         end;
         end;
       end;
       end;
 
 

+ 2 - 0
packages/fcl-js/src/jswriter.pp

@@ -470,6 +470,7 @@ Var
   S : String;
   S : String;
 
 
 begin
 begin
+  //system.writeln('TJSWriter.Write unicodestring=',U);
   WriteIndent;
   WriteIndent;
   if UseUTF8 then
   if UseUTF8 then
     begin
     begin
@@ -488,6 +489,7 @@ end;
 
 
 procedure TJSWriter.Write(const S: TJSWriterString);
 procedure TJSWriter.Write(const S: TJSWriterString);
 begin
 begin
+  //system.writeln('TJSWriter.Write TJSWriterString=',S);
   {$ifdef FPC_HAS_CPSTRING}
   {$ifdef FPC_HAS_CPSTRING}
   if Not (woUseUTF8 in Options) then
   if Not (woUseUTF8 in Options) then
     Write(UnicodeString(S))
     Write(UnicodeString(S))

+ 8 - 3
packages/fcl-passrc/src/pasresolveeval.pas

@@ -154,14 +154,14 @@ const
   nMethodHidesMethodOfBaseType = 3077;
   nMethodHidesMethodOfBaseType = 3077;
   nContextExpectedXButFoundY = 3078;
   nContextExpectedXButFoundY = 3078;
   nContextXInvalidY = 3079;
   nContextXInvalidY = 3079;
-  // free 3080;
+  nIdentifierXIsNotAnInstanceField = 3080;
   nXIsNotSupported = 3081;
   nXIsNotSupported = 3081;
   nOperatorIsNotOverloadedAOpB = 3082;
   nOperatorIsNotOverloadedAOpB = 3082;
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierWithin = 3086;
   nIllegalQualifierWithin = 3086;
   nMethodClassXInOtherUnitY = 3087;
   nMethodClassXInOtherUnitY = 3087;
-  // free 3088
+  nClassMethodsMustBeStaticInRecords = 3088;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportArrayProperty = 3101;
   nImplementsDoesNotSupportIndex = 3102;
   nImplementsDoesNotSupportIndex = 3102;
@@ -176,7 +176,8 @@ const
   nCantAssignValuesToConstVariable = 3110;
   nCantAssignValuesToConstVariable = 3110;
   nIllegalAssignmentToForLoopVar = 3111;
   nIllegalAssignmentToForLoopVar = 3111;
   nFunctionHidesIdentifier_NonProc = 3112;
   nFunctionHidesIdentifier_NonProc = 3112;
-  // Note: use one of the free IDs above
+  nTypeXCannotBeExtendedByATypeHelper = 3113;
+  nDerivedXMustExtendASubClassY = 3114;
 
 
   // using same IDs as FPC
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -277,6 +278,7 @@ resourcestring
   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
   sContextXInvalidY = '%s: invalid %s';
   sContextXInvalidY = '%s: invalid %s';
+  sIdentifierXIsNotAnInstanceField = 'Identifier "%s" is not an instance field';
   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
   sXIsNotSupported = '%s is not supported';
   sXIsNotSupported = '%s is not supported';
   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
@@ -285,6 +287,7 @@ resourcestring
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
+  sClassMethodsMustBeStaticInRecords = 'Class methods must be static in records';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
@@ -298,6 +301,8 @@ resourcestring
   sMissingFieldsX = 'Missing fields: "%s"';
   sMissingFieldsX = 'Missing fields: "%s"';
   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
+  sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
+  sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
 
 
 type
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
   { TResolveData - base class for data stored in TPasElement.CustomData }

Разлика између датотеке није приказан због своје велике величине
+ 465 - 279
packages/fcl-passrc/src/pasresolver.pp


+ 11 - 7
packages/fcl-passrc/src/pastree.pp

@@ -203,7 +203,7 @@ type
                  eopEqual, eopNotEqual,  // Logical
                  eopEqual, eopNotEqual,  // Logical
                  eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
                  eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual, // ordering
                  eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
                  eopIn,eopIs,eopAs, eopSymmetricaldifference, // Specials
-                 eopAddress, eopDeref, eopMemAddress, // Pointers
+                 eopAddress, eopDeref, eopMemAddress, // Pointers  eopMemAddress=**
                  eopSubIdent); // SomeRec.A, A is subIdent of SomeRec
                  eopSubIdent); // SomeRec.A, A is subIdent of SomeRec
 
 
   { TPasExpr }
   { TPasExpr }
@@ -730,10 +730,14 @@ type
     Function IsAdvancedRecord : Boolean;
     Function IsAdvancedRecord : Boolean;
   end;
   end;
 
 
-  TPasGenericTemplateType = Class(TPasType);
+  TPasGenericTemplateType = Class(TPasType)
+  Public
+    TypeConstraint : String;
+  end;
 
 
   TPasObjKind = (
   TPasObjKind = (
-    okObject, okClass, okInterface, okGeneric,
+    okObject, okClass, okInterface,
+    okGeneric, // MG: what is okGeneric?
     // okSpecialize removed in FPC 3.1.1
     // okSpecialize removed in FPC 3.1.1
     okClassHelper,okRecordHelper,okTypeHelper,
     okClassHelper,okRecordHelper,okTypeHelper,
     okDispInterface);
     okDispInterface);
@@ -758,7 +762,7 @@ type
     ObjKind: TPasObjKind;
     ObjKind: TPasObjKind;
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
                               // Note: AncestorType can be nil even though it has a default ancestor
                               // Note: AncestorType can be nil even though it has a default ancestor
-    HelperForType: TPasType;  // TPasClassType or TPasUnresolvedTypeRef
+    HelperForType: TPasType;  // any type, except helper
     IsForward: Boolean;
     IsForward: Boolean;
     IsExternal : Boolean;
     IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
     IsShortDefinition: Boolean;//class(anchestor); without end
@@ -1074,7 +1078,7 @@ type
                    otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
                    otGreaterThan, otAssign,otNotEqual,otLessEqualThan,otGreaterEqualThan,otPower,
                    otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
                    otSymmetricalDifference, otInc, otDec, otMod, otNegative, otPositive, otBitWiseOr, otDiv,
                    otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
                    otLeftShift, otLogicalOr, otBitwiseAnd, otbitwiseXor,otLogicalAnd,otLogicalNot,otLogicalXor,
-                   otRightShift,otEnumerator);
+                   otRightShift,otEnumerator, otIn);
   TOperatorTypes = set of TOperatorType;
   TOperatorTypes = set of TOperatorType;
 
 
   TPasOperator = class(TPasFunction)
   TPasOperator = class(TPasFunction)
@@ -1650,13 +1654,13 @@ const
            '>',':=','<>','<=','>=','**',
            '>',':=','<>','<=','>=','**',
            '><','Inc','Dec','mod','-','+','Or','div',
            '><','Inc','Dec','mod','-','+','Or','div',
            'shl','or','and','xor','and','not','xor',
            'shl','or','and','xor','and','not','xor',
-           'shr','enumerator');
+           'shr','enumerator','in');
   OperatorNames : Array[TOperatorType] of string
   OperatorNames : Array[TOperatorType] of string
        =  ('','implicit','explicit','multiply','add','subtract','divide','lessthan','equal',
        =  ('','implicit','explicit','multiply','add','subtract','divide','lessthan','equal',
            'greaterthan','assign','notequal','lessthanorequal','greaterthanorequal','power',
            'greaterthan','assign','notequal','lessthanorequal','greaterthanorequal','power',
            'symmetricaldifference','inc','dec','modulus','negative','positive','bitwiseor','intdivide',
            'symmetricaldifference','inc','dec','modulus','negative','positive','bitwiseor','intdivide',
            'leftshift','logicalor','bitwiseand','bitwisexor','logicaland','logicalnot','logicalxor',
            'leftshift','logicalor','bitwiseand','bitwisexor','logicaland','logicalnot','logicalxor',
-           'rightshift','enumerator');
+           'rightshift','enumerator','in');
 
 
   AssignKindNames : Array[TAssignKind] of string = (':=','+=','-=','*=','/=' );
   AssignKindNames : Array[TAssignKind] of string = (':=','+=','-=','*=','/=' );
 
 

+ 161 - 115
packages/fcl-passrc/src/pparser.pp

@@ -72,7 +72,7 @@ const
   nParserNotAProcToken = 2026;
   nParserNotAProcToken = 2026;
   nRangeExpressionExpected = 2027;
   nRangeExpressionExpected = 2027;
   nParserExpectCase = 2028;
   nParserExpectCase = 2028;
-  nParserHelperNotAllowed = 2029;
+  // free 2029;
   nLogStartImplementation = 2030;
   nLogStartImplementation = 2030;
   nLogStartInterface = 2031;
   nLogStartInterface = 2031;
   nParserNoConstructorAllowed = 2032;
   nParserNoConstructorAllowed = 2032;
@@ -132,11 +132,11 @@ resourcestring
   SParserNotAProcToken = 'Not a procedure or function token';
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
   SRangeExpressionExpected = 'Range expression expected';
   SParserExpectCase = 'Case label expression expected';
   SParserExpectCase = 'Case label expression expected';
-  SParserHelperNotAllowed = 'Helper objects not allowed for "%s"';
+  // free for 2029
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
   SLogStartInterface = 'Start parsing interface section';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Record helpers';
-  SParserNoFieldsAllowed = 'Fields are not allowed in Interfaces';
+  SParserNoFieldsAllowedInX = 'Fields are not allowed in %s';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
   SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
   SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
   SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
   SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
   SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
@@ -341,8 +341,6 @@ type
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
     function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
     procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
     procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
       Element: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos);
       Element: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos);
-    procedure AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
-      Params: TParamsExpr);
     {$IFDEF VerbosePasParser}
     {$IFDEF VerbosePasParser}
     procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
     procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
     {$ENDIF}
     {$ENDIF}
@@ -630,7 +628,7 @@ var
     l := CurPos - Start;
     l := CurPos - Start;
     if l <= 0 then
     if l <= 0 then
       exit;
       exit;
-    s:=copy(FPCCommandLine,Start,l);
+    s:=Trim(copy(FPCCommandLine,Start,l));
     if (s[1] = '-') and (length(s)>1) then
     if (s[1] = '-') and (length(s)>1) then
     begin
     begin
       case s[2] of
       case s[2] of
@@ -749,6 +747,7 @@ begin
           end;
           end;
         Inc(CurPos);
         Inc(CurPos);
         end;
         end;
+      Inc(CurPos);
       ProcessCmdLinePart;
       ProcessCmdLinePart;
       end;
       end;
 
 
@@ -1249,6 +1248,7 @@ begin
         if not (PM in [pmOverload, pmMessage,
         if not (PM in [pmOverload, pmMessage,
                         pmDispId,pmNoReturn,pmFar,pmFinal]) then exit(false);
                         pmDispId,pmNoReturn,pmFar,pmFinal]) then exit(false);
       end;
       end;
+      exit;
       end
       end
     else if Parent is TPasRecordType then
     else if Parent is TPasRecordType then
       begin
       begin
@@ -1256,6 +1256,7 @@ begin
                      pmInline, pmAssembler,
                      pmInline, pmAssembler,
                      pmExternal,
                      pmExternal,
                      pmNoReturn, pmFar, pmFinal]) then exit(false);
                      pmNoReturn, pmFar, pmFinal]) then exit(false);
+      exit;
       end;
       end;
     Parent:=Parent.Parent;
     Parent:=Parent.Parent;
     end;
     end;
@@ -1735,12 +1736,40 @@ begin
       tkInterface:
       tkInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
       tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
-      tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
-      tkType:
+      tkClass:
         begin
         begin
+        isHelper:=false;
         NextToken;
         NextToken;
-        isHelper:=CurTokenIsIdentifier('helper');
-        UnGetToken;
+        if CurTokenIsIdentifier('Helper') then
+          begin
+          // class helper: atype end;
+          // class helper for atype end;
+          NextToken;
+          isHelper:=CurToken in [tkfor,tkBraceOpen];
+          UnGetToken;
+          end;
+        UngetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okClassHelper,PM, GenericArgs)
+        else
+          Result:=ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
+        end;
+      tkType:
+        begin
+        isHelper:=false;
+        if msTypeHelpers in Scanner.CurrentModeSwitches then
+          begin
+          NextToken;
+          if CurTokenIsIdentifier('helper') then
+            begin
+            // atype = type helper;
+            // atype = type helper for atype end;
+            NextToken;
+            isHelper:=CurToken in [tkfor,tkBraceOpen];
+            UnGetToken;
+            end;
+          UnGetToken;
+          end;
         if isHelper then
         if isHelper then
           Result:=ParseClassDecl(Parent,NamePos,TypeName,okTypeHelper,PM)
           Result:=ParseClassDecl(Parent,NamePos,TypeName,okTypeHelper,PM)
         else
         else
@@ -1769,16 +1798,20 @@ begin
       tkRecord:
       tkRecord:
         begin
         begin
         NextToken;
         NextToken;
+        isHelper:=false;
         if CurTokenIsIdentifier('Helper') then
         if CurTokenIsIdentifier('Helper') then
           begin
           begin
+          // record helper: atype end;
+          // record helper for atype end;
+          NextToken;
+          isHelper:=CurToken in [tkfor,tkBraceOpen];
           UnGetToken;
           UnGetToken;
-          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM);
-          end
-        else
-          begin
-          UnGetToken;
-          Result := ParseRecordDecl(Parent,NamePos,TypeName,PM);
           end;
           end;
+        UngetToken;
+        if isHelper then
+          Result:=ParseClassDecl(Parent,NamePos,TypeName,okRecordHelper,PM)
+        else
+          Result:=ParseRecordDecl(Parent,NamePos,TypeName,PM);
         end;
         end;
       tkNumber,tkMinus,tkChar:
       tkNumber,tkMinus,tkChar:
         begin
         begin
@@ -2323,9 +2356,9 @@ begin
         if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
         if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
           begin
           begin
           aName:=aName+'.'+CurTokenString;
           aName:=aName+'.'+CurTokenString;
-          expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
-          AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
-          Func:=expr;
+          Expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
+          AddToBinaryExprChain(Result,Expr,eopSubIdent,ScrPos);
+          Func:=Expr;
           NextToken;
           NextToken;
           end
           end
         else
         else
@@ -2341,14 +2374,18 @@ begin
         else
         else
           Params:=ParseParams(AParent,pekArrayParams);
           Params:=ParseParams(AParent,pekArrayParams);
         if not Assigned(Params) then Exit;
         if not Assigned(Params) then Exit;
-        AddParamsToBinaryExprChain(Result,Params);
+        Params.Value:=Result;
+        Result.Parent:=Params;
+        Result:=Params;
         CanSpecialize:=false;
         CanSpecialize:=false;
+        Func:=nil;
         end;
         end;
       tkCaret:
       tkCaret:
         begin
         begin
         Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
         Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
         NextToken;
         NextToken;
         CanSpecialize:=false;
         CanSpecialize:=false;
+        Func:=nil;
         end;
         end;
       tkLessThan:
       tkLessThan:
         begin
         begin
@@ -2370,6 +2407,7 @@ begin
           CanSpecialize:=false;
           CanSpecialize:=false;
           NextToken;
           NextToken;
           end;
           end;
+        Func:=nil;
         end
         end
       else
       else
         break;
         break;
@@ -2536,26 +2574,40 @@ begin
             CheckToken(tkBraceClose);
             CheckToken(tkBraceClose);
             end;
             end;
           NextToken;
           NextToken;
-          // for expressions like (ppdouble)^^;
-          while (CurToken=tkCaret) do
-            begin
-            x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
-            NextToken;
-            end;
-          // for expressions like (PChar(a)+10)[0];
-          if (CurToken=tkSquaredBraceOpen) then
-            begin
-            ArrParams:=ParseParams(AParent,pekArrayParams,False);
-            ArrParams.Value:=x;
-            x.Parent:=ArrParams;
-            x:=ArrParams;
-            end;
-          // for expressions like (TObject(m)).Free;
-          if (CurToken=tkDot) then
-            begin
-            NextToken;
-            x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
+          repeat
+            case CurToken of
+            tkCaret:
+              begin
+              // for expressions like (ppdouble)^^;
+              x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
+              NextToken;
+              end;
+            tkBraceOpen:
+              begin
+              // for expressions like (a+b)(0);
+              ArrParams:=ParseParams(AParent,pekFuncParams,False);
+              ArrParams.Value:=x;
+              x.Parent:=ArrParams;
+              x:=ArrParams;
+              end;
+            tkSquaredBraceOpen:
+              begin
+              // for expressions like (PChar(a)+10)[0];
+              ArrParams:=ParseParams(AParent,pekArrayParams,False);
+              ArrParams.Value:=x;
+              x.Parent:=ArrParams;
+              x:=ArrParams;
+              end;
+            tkDot:
+              begin
+              // for expressions like (TObject(m)).Free;
+              NextToken;
+              x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
+              end
+            else
+              break;
             end;
             end;
+          until false;
           end
           end
         else
         else
           begin
           begin
@@ -3557,7 +3609,9 @@ begin
              RecordEl.SetGenericTemplates(List);
              RecordEl.SetGenericTemplates(List);
              NextToken;
              NextToken;
              ParseRecordFieldList(RecordEl,tkend,
              ParseRecordFieldList(RecordEl,tkend,
-                              msAdvancedRecords in Scanner.CurrentModeSwitches);
+                              (msAdvancedRecords in Scanner.CurrentModeSwitches)
+                              and not (Declarations is TProcedureBody)
+                              and (RecordEl.Name<>''));
              CheckHint(RecordEl,True);
              CheckHint(RecordEl,True);
              Engine.FinishScope(stTypeDef,RecordEl);
              Engine.FinishScope(stTypeDef,RecordEl);
              end;
              end;
@@ -3938,16 +3992,23 @@ procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
 
 
 Var
 Var
   N : String;
   N : String;
+  T : TPasGenericTemplateType;
 
 
 begin
 begin
   ExpectToken(tkLessThan);
   ExpectToken(tkLessThan);
   repeat
   repeat
     N:=ExpectIdentifier;
     N:=ExpectIdentifier;
-    List.Add(CreateElement(TPasGenericTemplateType,N,Parent));
+    T:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,N,Parent));
+    List.Add(T);
     NextToken;
     NextToken;
-    if not (CurToken in [tkComma, tkGreaterThan]) then
+    if Curtoken = tkColon then
+      begin
+      T.TypeConstraint:=ExpectIdentifier;
+      NextToken;
+      end;
+    if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then
       ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
       ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
+        [TokenInfos[tkComma], TokenInfos[tkColon], TokenInfos[tkGreaterThan]]);
   until CurToken = tkGreaterThan;
   until CurToken = tkGreaterThan;
 end;
 end;
 
 
@@ -5187,7 +5248,9 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
       Result := Result + '[';
       Result := Result + '[';
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
       Params.Kind:=pekArrayParams;
       Params.Kind:=pekArrayParams;
-      AddParamsToBinaryExprChain(Expr,Params);
+      Params.Value:=Expr;
+      Expr.Parent:=Params;
+      Expr:=Params;
       NextToken;
       NextToken;
       case CurToken of
       case CurToken of
         tkChar:             Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
         tkChar:             Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
@@ -6344,7 +6407,15 @@ begin
       tkClass:
       tkClass:
         begin
         begin
         if Not AllowMethods then
         if Not AllowMethods then
-          ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
+          begin
+          NextToken;
+          case CurToken of
+          tkConst: ParseExc(nErrRecordConstantsNotAllowed,SErrRecordConstantsNotAllowed);
+          tkvar: ParseExc(nErrRecordVariablesNotAllowed,SErrRecordVariablesNotAllowed);
+          else
+            ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
+          end;
+          end;
         if isClass then
         if isClass then
           ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
           ParseExc(nParserTypeSyntaxError,SParserTypeSyntaxError);
         isClass:=True;
         isClass:=True;
@@ -6437,7 +6508,8 @@ begin
   try
   try
     Result.PackMode:=PackMode;
     Result.PackMode:=PackMode;
     NextToken;
     NextToken;
-    ParseRecordFieldList(Result,tkEnd,msAdvancedRecords in Scanner.CurrentModeSwitches);
+    ParseRecordFieldList(Result,tkEnd,
+      (msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
     Engine.FinishScope(stTypeDef,Result);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
     ok:=true;
   finally
   finally
@@ -6628,6 +6700,7 @@ begin
   LastToken:=CurToken;
   LastToken:=CurToken;
   while (CurToken<>tkEnd) do
   while (CurToken<>tkEnd) do
     begin
     begin
+    //writeln('TPasParser.ParseClassMembers LastToken=',LastToken,' CurToken=',CurToken,' haveClass=',haveClass,' CurSection=',CurSection);
     case CurToken of
     case CurToken of
       tkType:
       tkType:
         begin
         begin
@@ -6653,18 +6726,18 @@ begin
         CurSection:=stConst;
         CurSection:=stConst;
         end;
         end;
       tkVar:
       tkVar:
-        begin
-        case AType.ObjKind of
-        okClass,okObject,okGeneric,
-        okClassHelper,okRecordHelper,okTypeHelper: ;
-        else
-          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
-        end;
-        if LastToken=tkClass then
-          CurSection:=stClassVar
-        else
-          CurSection:=stVar;
-        end;
+        if not (CurSection in [stVar,stClassVar]) then
+          begin
+          if (AType.ObjKind in [okClass,okObject,okGeneric])
+          or (haveClass and (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper])) then
+            // ok
+          else
+            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
+          if LastToken=tkClass then
+            CurSection:=stClassVar
+          else
+            CurSection:=stVar;
+          end;
       tkIdentifier:
       tkIdentifier:
         if CheckVisibility(CurtokenString,CurVisibility) then
         if CheckVisibility(CurtokenString,CurVisibility) then
           CurSection:=stNone
           CurSection:=stNone
@@ -6678,11 +6751,17 @@ begin
           stConst :
           stConst :
             ParseMembersLocalConsts(AType,CurVisibility);
             ParseMembersLocalConsts(AType,CurVisibility);
           stNone,
           stNone,
-          stVar,
+          stVar:
+            begin
+            if not (AType.ObjKind in [okObject,okClass,okGeneric]) then
+              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
+            ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
+            HaveClass:=False;
+            end;
           stClassVar:
           stClassVar:
             begin
             begin
-            if (AType.ObjKind in [okInterface,okDispInterface]) then
-              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowed);
+            if not (AType.ObjKind in [okObject,okClass,okGeneric,okClassHelper,okRecordHelper,okTypeHelper]) then
+              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
             ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
             ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
             HaveClass:=False;
             HaveClass:=False;
             end;
             end;
@@ -6695,7 +6774,11 @@ begin
         curSection:=stNone;
         curSection:=stNone;
         if not haveClass then
         if not haveClass then
           SaveComments;
           SaveComments;
-        if AType.ObjKind in [okInterface,okDispInterface,okRecordHelper] then
+        if (AType.ObjKind in [okObject,okClass,okGeneric])
+            or ((CurToken=tkconstructor)
+              and (AType.ObjKind in [okClassHelper,okTypeHelper,okRecordHelper])) then
+          // ok
+        else
           ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
           ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
         ProcessMethod(AType,HaveClass,CurVisibility);
         ProcessMethod(AType,HaveClass,CurVisibility);
         haveClass:=False;
         haveClass:=False;
@@ -6786,18 +6869,23 @@ begin
   if (CurToken=tkBraceOpen) then
   if (CurToken=tkBraceOpen) then
     begin
     begin
     // read ancestor and interfaces
     // read ancestor and interfaces
+    if (AType.ObjKind=okRecordHelper)
+        and ([msTypeHelpers,msDelphi]*Scanner.CurrentModeSwitches=[msDelphi]) then
+      // Delphi does not support ancestors in record helpers
+      CheckToken(tkend);
     NextToken;
     NextToken;
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
     AType.AncestorType := ParseTypeReference(AType,false,Expr);
-    while CurToken=tkComma do
-      begin
-      NextToken;
-      AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
-      end;
+    if AType.ObjKind in [okClass,okGeneric] then
+      while CurToken=tkComma do
+        begin
+        NextToken;
+        AType.Interfaces.Add(ParseTypeReference(AType,false,Expr));
+        end;
     CheckToken(tkBraceClose);
     CheckToken(tkBraceClose);
     NextToken;
     NextToken;
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     AType.IsShortDefinition:=(CurToken=tkSemicolon);
     end;
     end;
-  if (AType.ObjKind in [okClassHelper,okRecordHelper]) then
+  if (AType.ObjKind in [okClassHelper,okRecordHelper,okTypeHelper]) then
     begin
     begin
     CheckToken(tkfor);
     CheckToken(tkfor);
     NextToken;
     NextToken;
@@ -6826,12 +6914,10 @@ function TPasParser.ParseClassDecl(Parent: TPasElement;
 
 
 Var
 Var
   ok: Boolean;
   ok: Boolean;
-  FT : TPasType;
   AExternalNameSpace,AExternalName : String;
   AExternalNameSpace,AExternalName : String;
   PCT:TPasClassType;
   PCT:TPasClassType;
 begin
 begin
   NextToken;
   NextToken;
-  FT:=Nil;
   if (AObjKind = okClass) and (CurToken = tkOf) then
   if (AObjKind = okClass) and (CurToken = tkOf) then
     begin
     begin
     Result := TPasClassOfType(CreateElement(TPasClassOfType, AClassName,
     Result := TPasClassOfType(CreateElement(TPasClassOfType, AClassName,
@@ -6849,7 +6935,7 @@ begin
     end;
     end;
     exit;
     exit;
     end;
     end;
-  if ((AObjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches)
+  if ((AObjKind in [okClass,okInterface]) and (msExternalClass in CurrentModeswitches)
       and CurTokenIsIdentifier('external')) then
       and CurTokenIsIdentifier('external')) then
     begin
     begin
     NextToken;
     NextToken;
@@ -6871,19 +6957,10 @@ begin
     AExternalNameSpace:='';
     AExternalNameSpace:='';
     AExternalName:='';
     AExternalName:='';
     end;
     end;
-  if (CurTokenIsIdentifier('Helper')) then
+  if AObjKind in [okClassHelper,okRecordHelper,okTypeHelper] then
     begin
     begin
-    if Not (AObjKind in [okClass,okTypeHelper,okRecordHelper]) then
-      ParseExc(nParserHelperNotAllowed,SParserHelperNotAllowed,[ObjKindNames[AObjKind]]);
-    Case AObjKind of
-     okClass:
-       AObjKind:=okClassHelper;
-     okTypeHelper:
-       begin
-       ExpectToken(tkFor);
-       FT:=ParseType(Parent,CurSourcePos,'',False);
-       end
-    end;
+    if not CurTokenIsIdentifier('Helper') then
+      ParseExcSyntaxError;
     NextToken;
     NextToken;
     end;
     end;
   PCT := TPasClassType(CreateElement(TPasClassType, AClassName,
   PCT := TPasClassType(CreateElement(TPasClassType, AClassName,
@@ -6891,7 +6968,7 @@ begin
   Result:=PCT;
   Result:=PCT;
   ok:=false;
   ok:=false;
   try
   try
-    PCT.HelperForType:=FT;
+    PCT.HelperForType:=nil;
     PCT.IsExternal:=(AExternalName<>'');
     PCT.IsExternal:=(AExternalName<>'');
     if AExternalName<>'' then
     if AExternalName<>'' then
       PCT.ExternalName:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalName,'''');
       PCT.ExternalName:={$ifdef pas2js}DeQuoteString{$else}AnsiDequotedStr{$endif}(AExternalName,'''');
@@ -7005,37 +7082,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
-  Params: TParamsExpr);
-// append Params to chain, using the last(right) element as Params.Value
-var
-  Bin: TBinaryExpr;
-begin
-  if Params.Value<>nil then
-    ParseExcSyntaxError;
-  if ChainFirst=nil then
-    ParseExcSyntaxError;
-  if ChainFirst is TBinaryExpr then
-    begin
-    Bin:=TBinaryExpr(ChainFirst);
-    if Bin.left=nil then
-      ParseExcSyntaxError;
-    if Bin.right=nil then
-      ParseExcSyntaxError;
-    Params.Value:=Bin.right;
-    Params.Value.Parent:=Params;
-    Bin.right:=Params;
-    Params.Parent:=Bin;
-    end
-  else
-    begin
-    Params.Value:=ChainFirst;
-    Params.Parent:=ChainFirst.Parent;
-    ChainFirst.Parent:=Params;
-    ChainFirst:=Params;
-    end;
-end;
-
 {$IFDEF VerbosePasParser}
 {$IFDEF VerbosePasParser}
 {AllowWriteln}
 {AllowWriteln}
 procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr
 procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr

+ 121 - 14
packages/fcl-passrc/tests/tcexprparser.pas

@@ -96,14 +96,19 @@ type
     Procedure TestBinaryLessThanEqual;
     Procedure TestBinaryLessThanEqual;
     Procedure TestBinaryLargerThan;
     Procedure TestBinaryLargerThan;
     Procedure TestBinaryLargerThanEqual;
     Procedure TestBinaryLargerThanEqual;
-    procedure TestBinaryFullIdent;
+    procedure TestBinarySubIdent;
     Procedure TestArrayElement;
     Procedure TestArrayElement;
-    Procedure TestArrayElementrecord;
+    Procedure TestArrayElementRecord;
     Procedure TestArrayElement2Dims;
     Procedure TestArrayElement2Dims;
     Procedure TestFunctionCall;
     Procedure TestFunctionCall;
     Procedure TestFunctionCall2args;
     Procedure TestFunctionCall2args;
     Procedure TestFunctionCallNoArgs;
     Procedure TestFunctionCallNoArgs;
-    Procedure ParseStrWithFormatFullyQualified;
+    Procedure TestSubIdentStrWithFormat;
+    Procedure TestAPlusCallB;
+    Procedure TestAPlusBBracketFuncParams;
+    Procedure TestAPlusBBracketArrayParams;
+    Procedure TestAPlusBBracketDotC;
+    Procedure TestADotBDotC;
     Procedure TestRange;
     Procedure TestRange;
     Procedure TestBracketsTotal;
     Procedure TestBracketsTotal;
     Procedure TestBracketsLeft;
     Procedure TestBracketsLeft;
@@ -257,7 +262,7 @@ begin
   AssertExpression('Simple identifier',theExpr,pekIdent,'b');
   AssertExpression('Simple identifier',theExpr,pekIdent,'b');
 end;
 end;
 
 
-procedure TTestExpressions.TestBinaryFullIdent;
+procedure TTestExpressions.TestBinarySubIdent;
 begin
 begin
   DeclareVar('integer','a');
   DeclareVar('integer','a');
   DeclareVar('record x,y : integer; end','b');
   DeclareVar('record x,y : integer; end','b');
@@ -282,7 +287,7 @@ begin
   AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
   AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
 end;
 end;
 
 
-procedure TTestExpressions.TestArrayElementrecord;
+procedure TTestExpressions.TestArrayElementRecord;
 
 
 Var
 Var
   P : TParamsExpr;
   P : TParamsExpr;
@@ -290,14 +295,15 @@ Var
 begin
 begin
   DeclareVar('record a : array[1..2] of integer; end ','b');
   DeclareVar('record a : array[1..2] of integer; end ','b');
   ParseExpression('b.a[1]');
   ParseExpression('b.a[1]');
-  B:=AssertExpression('Binary of record',TheExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
-  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
-  AssertExpression('Name of array',B.Left,pekIdent,'b');
-  P:=TParamsExpr(AssertExpression('Simple identifier',B.right,pekArrayParams,TParamsExpr));
-  AssertExpression('Name of array',P.Value,pekIdent,'a');
+  P:=TParamsExpr(AssertExpression('Array Param',TheExpr,pekArrayParams,TParamsExpr));
   TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
   TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
   AssertEquals('One dimension',1,Length(P.params));
   AssertEquals('One dimension',1,Length(P.params));
   AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
   AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
+
+  B:=TBinaryExpr(AssertExpression('Binary of record',P.Value,pekBinary,TBinaryExpr));
+  AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
+  AssertExpression('Name of array',B.Left,pekIdent,'b');
+  AssertExpression('Name of array',B.right,pekIdent,'a');
   TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
   TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
   TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
   TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
 end;
 end;
@@ -1124,7 +1130,7 @@ begin
   AssertNotNull('Have left',AOperand);
   AssertNotNull('Have left',AOperand);
 end;
 end;
 
 
-Procedure TTestExpressions.ParseStrWithFormatFullyQualified;
+procedure TTestExpressions.TestSubIdentStrWithFormat;
 
 
 Var
 Var
   P : TParamsExpr;
   P : TParamsExpr;
@@ -1134,12 +1140,113 @@ begin
   DeclareVar('string','a');
   DeclareVar('string','a');
   DeclareVar('integer','i');
   DeclareVar('integer','i');
   ParseExpression('system.str(i:0:3,a)');
   ParseExpression('system.str(i:0:3,a)');
-  B:=TBinaryExpr(AssertExpression('Binary identifier',theExpr,pekBinary,TBinaryExpr));
-  P:=TParamsExpr(AssertExpression('Simple identifier',B.Right,pekFuncParams,TParamsExpr));
-  AssertExpression('Name of function',P.Value,pekIdent,'str');
+  P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
   AssertEquals('2 argument',2,Length(p.params));
   AssertEquals('2 argument',2,Length(p.params));
   AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
   AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
   AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
   AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
+  TAssert.AssertSame('P.params[0].parent=P',P,P.params[0].Parent);
+  TAssert.AssertSame('P.params[1].parent=P',P,P.params[1].Parent);
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  AssertExpression('Name of unit',B.left,pekIdent,'system');
+  AssertExpression('Name of function',B.right,pekIdent,'str');
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+end;
+
+procedure TTestExpressions.TestAPlusCallB;
+var
+  B: TBinaryExpr;
+  P: TParamsExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('a+b(1)');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
+  AssertExpression('left a',B.left,pekIdent,'a');
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  P:=TParamsExpr(AssertExpression('Params',B.right,pekFuncParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('param 1',p.params[0],pekNumber,'1');
+end;
+
+procedure TTestExpressions.TestAPlusBBracketFuncParams;
+var
+  P: TParamsExpr;
+  B: TBinaryExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('(a+b)(1)');
+  P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('param 1',p.params[0],pekNumber,'1');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('left a',B.left,pekIdent,'a');
+  AssertExpression('right b',B.right,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestAPlusBBracketArrayParams;
+var
+  B: TBinaryExpr;
+  P: TParamsExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('(a+b)[1]');
+  P:=TParamsExpr(AssertExpression('Params',TheExpr,pekArrayParams,TParamsExpr));
+  TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
+  AssertEquals('1 argument',1,Length(p.params));
+  AssertExpression('param 1',p.params[0],pekNumber,'1');
+
+  B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('left a',B.left,pekIdent,'a');
+  AssertExpression('right b',B.right,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestAPlusBBracketDotC;
+var
+  B, PlusB: TBinaryExpr;
+begin
+  DeclareVar('string','a');
+  DeclareVar('integer','b');
+  ParseExpression('(a+b).c');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
+  AssertEquals('().',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('right c',B.right,pekIdent,'c');
+
+  PlusB:=TBinaryExpr(AssertExpression('Binary identifier',B.left,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('PlusB.left.parent=PlusB',PlusB,PlusB.left.Parent);
+  TAssert.AssertSame('PlusB.right.parent=PlusB',PlusB,PlusB.right.Parent);
+  AssertExpression('left a',PlusB.left,pekIdent,'a');
+  AssertExpression('right b',PlusB.right,pekIdent,'b');
+end;
+
+procedure TTestExpressions.TestADotBDotC;
+var
+  B, SubB: TBinaryExpr;
+begin
+  ParseExpression('a.b.c');
+  B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
+  AssertEquals('dot expr',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+  AssertExpression('right c',B.right,pekIdent,'c');
+
+  SubB:=TBinaryExpr(AssertExpression('Binary identifier',B.left,pekBinary,TBinaryExpr));
+  TAssert.AssertSame('PlusB.left.parent=PlusB',SubB,SubB.left.Parent);
+  TAssert.AssertSame('PlusB.right.parent=PlusB',SubB,SubB.right.Parent);
+  AssertExpression('left a',SubB.left,pekIdent,'a');
+  AssertExpression('right b',SubB.right,pekIdent,'b');
 end;
 end;
 
 
 initialization
 initialization

+ 45 - 0
packages/fcl-passrc/tests/tcgenerics.pp

@@ -12,13 +12,16 @@ Type
   { TTestGenerics }
   { TTestGenerics }
 
 
   TTestGenerics = Class(TBaseTestTypeParser)
   TTestGenerics = Class(TBaseTestTypeParser)
+  private
   Published
   Published
     Procedure TestObjectGenerics;
     Procedure TestObjectGenerics;
     Procedure TestRecordGenerics;
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
     Procedure TestArrayGenerics;
     Procedure TestSpecializationDelphi;
     Procedure TestSpecializationDelphi;
+    procedure TestDeclarationConstraint;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphiSpecialize;
     Procedure TestDeclarationDelphiSpecialize;
+    procedure TestDeclarationFPC;
     Procedure TestMethodImplementation;
     Procedure TestMethodImplementation;
     Procedure TestInlineSpecializationInArgument;
     Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
     Procedure TestSpecializeNested;
@@ -84,6 +87,48 @@ begin
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 end;
 
 
+procedure TTestGenerics.TestDeclarationFPC;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
+  Source.Add('  b : T;');
+  Source.Add('  b2 : T2;');
+  Source.Add('end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
+
+procedure TTestGenerics.TestDeclarationConstraint;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T: T2> = Class(TObject)');
+  Source.Add('  b : T;');
+  Source.Add('end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
+end;
+
 procedure TTestGenerics.TestDeclarationDelphiSpecialize;
 procedure TTestGenerics.TestDeclarationDelphiSpecialize;
 Var
 Var
   T : TPasClassType;
   T : TPasClassType;

+ 333 - 69
packages/fcl-passrc/tests/tcresolver.pas

@@ -347,7 +347,6 @@ type
     Procedure TestForLoopStartIncompFail;
     Procedure TestForLoopStartIncompFail;
     Procedure TestForLoopEndIncompFail;
     Procedure TestForLoopEndIncompFail;
     Procedure TestSimpleStatement_VarFail;
     Procedure TestSimpleStatement_VarFail;
-    Procedure TestRecord_Default;
 
 
     // units
     // units
     Procedure TestUnitForwardOverloads;
     Procedure TestUnitForwardOverloads;
@@ -483,6 +482,7 @@ type
     Procedure TestRecord_Const_UntypedFail;
     Procedure TestRecord_Const_UntypedFail;
     Procedure TestRecord_Const_NestedRecord;
     Procedure TestRecord_Const_NestedRecord;
     Procedure TestRecord_Const_Variant;
     Procedure TestRecord_Const_Variant;
+    Procedure TestRecord_Default;
     Procedure TestRecord_VarExternal;
     Procedure TestRecord_VarExternal;
     Procedure TestRecord_VarSelfFail;
     Procedure TestRecord_VarSelfFail;
 
 
@@ -490,7 +490,10 @@ type
     Procedure TestAdvRecord;
     Procedure TestAdvRecord;
     Procedure TestAdvRecord_Private;
     Procedure TestAdvRecord_Private;
     Procedure TestAdvRecord_StrictPrivate;
     Procedure TestAdvRecord_StrictPrivate;
+    Procedure TestAdvRecord_MethodImplMissingFail;
     Procedure TestAdvRecord_VarConst;
     Procedure TestAdvRecord_VarConst;
+    Procedure TestAdvRecord_RecVal_ConstFail;
+    Procedure TestAdvRecord_RecVal_ClassVarFail;
     Procedure TestAdvRecord_LocalForwardType;
     Procedure TestAdvRecord_LocalForwardType;
     Procedure TestAdvRecord_Constructor_NewInstance;
     Procedure TestAdvRecord_Constructor_NewInstance;
     Procedure TestAdvRecord_ConstructorNoParamsFail;
     Procedure TestAdvRecord_ConstructorNoParamsFail;
@@ -504,6 +507,8 @@ type
     Procedure TestAdvRecord_RecordAsFuncResult;
     Procedure TestAdvRecord_RecordAsFuncResult;
     Procedure TestAdvRecord_InheritedFail;
     Procedure TestAdvRecord_InheritedFail;
     Procedure TestAdvRecord_ForInEnumerator;
     Procedure TestAdvRecord_ForInEnumerator;
+    Procedure TestAdvRecord_InFunctionFail;
+    Procedure TestAdvRecord_SubClass;
 
 
     // class
     // class
     Procedure TestClass;
     Procedure TestClass;
@@ -580,7 +585,6 @@ type
     Procedure TestClass_StrictPrivateInMainBeginFail;
     Procedure TestClass_StrictPrivateInMainBeginFail;
     Procedure TestClass_StrictProtectedInMainBeginFail;
     Procedure TestClass_StrictProtectedInMainBeginFail;
     Procedure TestClass_Constructor_NewInstance;
     Procedure TestClass_Constructor_NewInstance;
-    Procedure TestClass_Constructor_InstanceCallResultFail;
     Procedure TestClass_Destructor_FreeInstance;
     Procedure TestClass_Destructor_FreeInstance;
     Procedure TestClass_ConDestructor_CallInherited;
     Procedure TestClass_ConDestructor_CallInherited;
     Procedure TestClass_Constructor_Inherited;
     Procedure TestClass_Constructor_Inherited;
@@ -856,6 +860,16 @@ type
     Procedure TestHint_ElementHints_WarnOff_SymbolDeprecated;
     Procedure TestHint_ElementHints_WarnOff_SymbolDeprecated;
     Procedure TestHint_Garbage;
     Procedure TestHint_Garbage;
 
 
+    // helpers
+    Procedure ClassHelper;
+    Procedure ClassHelper_AncestorIsNotHelperForDescendantFail;
+    Procedure ClassHelper_ForInterfaceFail;
+    Procedure ClassHelper_FieldFail;
+    Procedure ClassHelper_AbstractFail;
+    Procedure ClassHelper_VirtualObjFPCFail;
+    Procedure RecordHelper;
+    Procedure TypeHelper;
+
     // attributes
     // attributes
     Procedure TestAttributes_Ignore;
     Procedure TestAttributes_Ignore;
   end;
   end;
@@ -5236,23 +5250,6 @@ begin
   CheckResolverException('Illegal expression',nIllegalExpression);
   CheckResolverException('Illegal expression',nIllegalExpression);
 end;
 end;
 
 
-procedure TTestResolver.TestRecord_Default;
-begin
-  StartProgram(false);
-  Add([
-  'type',
-  '  TPoint = record x, y: longint; end;',
-  'var',
-  '  i: longint;',
-  '  r: TPoint;',
-  'begin',
-  '  i:=Default(longint);',
-  '  r:=Default(r);',
-  '  r:=Default(TPoint);',
-  '']);
-  ParseProgram;
-end;
-
 procedure TTestResolver.TestUnitForwardOverloads;
 procedure TTestResolver.TestUnitForwardOverloads;
 begin
 begin
   StartUnit(false);
   StartUnit(false);
@@ -7797,6 +7794,23 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestRecord_Default;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TPoint = record x, y: longint; end;',
+  'var',
+  '  i: longint;',
+  '  r: TPoint;',
+  'begin',
+  '  i:=Default(longint);',
+  '  r:=Default(r);',
+  '  r:=Default(TPoint);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord_VarExternal;
 procedure TTestResolver.TestRecord_VarExternal;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7874,6 +7888,20 @@ begin
   CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
   CheckResolverException('Can''t access strict private member A',nCantAccessPrivateMember);
 end;
 end;
 
 
+procedure TTestResolver.TestAdvRecord_MethodImplMissingFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    procedure SetSize(Value: word);',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException(sForwardProcNotResolved,nForwardProcNotResolved);
+end;
+
 procedure TTestResolver.TestAdvRecord_VarConst;
 procedure TTestResolver.TestAdvRecord_VarConst;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7913,6 +7941,42 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestAdvRecord_RecVal_ConstFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    V1: word;',
+  '  const',
+  '    C1 = 3;',
+  '  end;',
+  'var',
+  '  r: TRec = (V1:2; C1: 4);',
+  'begin',
+  '']);
+  CheckResolverException(sIdentifierXIsNotAnInstanceField,nIdentifierXIsNotAnInstanceField);
+end;
+
+procedure TTestResolver.TestAdvRecord_RecVal_ClassVarFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    V1: word;',
+  '  class var',
+  '    C1: word;',
+  '  end;',
+  'var',
+  '  r: TRec = (V1:2; C1: 4);',
+  'begin',
+  '']);
+  CheckResolverException(sIdentifierXIsNotAnInstanceField,nIdentifierXIsNotAnInstanceField);
+end;
+
 procedure TTestResolver.TestAdvRecord_LocalForwardType;
 procedure TTestResolver.TestAdvRecord_LocalForwardType;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7947,7 +8011,7 @@ begin
   'type',
   'type',
   '  TRec = record',
   '  TRec = record',
   '    constructor Create(w: word);',
   '    constructor Create(w: word);',
-  '    class function DoSome: TRec;',
+  '    class function DoSome: TRec; static;',
   '  end;',
   '  end;',
   'constructor TRec.Create(w: word);',
   'constructor TRec.Create(w: word);',
   'begin',
   'begin',
@@ -7964,6 +8028,7 @@ begin
   '  TRec.{#p}Create(4); // new object',
   '  TRec.{#p}Create(4); // new object',
   '  r:=TRec.{#q}Create(5); // new object',
   '  r:=TRec.{#q}Create(5); // new object',
   '  r.{#r}Create(6); // normal call',
   '  r.{#r}Create(6); // normal call',
+  '  r:=r.{#s}Create(7); // normal call',
   '']);
   '']);
   ParseProgram;
   ParseProgram;
   aMarker:=FirstSrcMarker;
   aMarker:=FirstSrcMarker;
@@ -7988,7 +8053,7 @@ begin
         break;
         break;
         end;
         end;
       case aMarker^.Identifier of
       case aMarker^.Identifier of
-      'a','r':// should be normal call
+      'a','r','s':// should be normal call
         if ActualNewInstance then
         if ActualNewInstance then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
       else // should be newinstance
       else // should be newinstance
@@ -8027,14 +8092,17 @@ begin
   '{$modeswitch advancedrecords}',
   '{$modeswitch advancedrecords}',
   'type',
   'type',
   '  TRec = record',
   '  TRec = record',
-  '    class procedure {#a}Create;',
-  '    class constructor Create;',
+  '    class var w: word;',
+  '    class procedure {#a}Create; static;',
+  '    class constructor Create; static;',
   '  end;',
   '  end;',
   'class constructor TRec.Create;',
   'class constructor TRec.Create;',
   'begin',
   'begin',
+  '  w:=w+1;',
   'end;',
   'end;',
   'class procedure TRec.Create;',
   'class procedure TRec.Create;',
   'begin',
   'begin',
+  '  w:=w+1;',
   'end;',
   'end;',
   'begin',
   'begin',
   '  TRec.{@a}Create;',
   '  TRec.{@a}Create;',
@@ -8231,8 +8299,8 @@ begin
   'type',
   'type',
   '  {#A}TRec = record',
   '  {#A}TRec = record',
   '     {#A_i}i: longint;',
   '     {#A_i}i: longint;',
-  '     class function {#A_CreateA}Create: TRec;',
-  '     class function {#A_CreateB}Create(i: longint): TRec;',
+  '     class function {#A_CreateA}Create: TRec; static;',
+  '     class function {#A_CreateB}Create(i: longint): TRec; static;',
   '  end;',
   '  end;',
   'function {#F}F: TRec;',
   'function {#F}F: TRec;',
   'begin',
   'begin',
@@ -8313,6 +8381,53 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestAdvRecord_InFunctionFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'procedure DoIt;',
+  'type',
+  '  TBird = record',
+  '    class var i: word;',
+  '  end;',
+  'var',
+  '  b: TBird;',
+  'begin',
+  'end;',
+  'begin']);
+  CheckParserException(sErrRecordVariablesNotAllowed,nErrRecordVariablesNotAllowed);
+end;
+
+procedure TTestResolver.TestAdvRecord_SubClass;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  TObject = class end;',
+  '  TPoint = record',
+  '  type',
+  '    TBird = class',
+  '      procedure DoIt;',
+  '      class procedure Glob;',
+  '    end;',
+  '    procedure DoIt(b: TBird);',
+  '  end;',
+  'procedure TPoint.TBird.DoIt;',
+  'begin',
+  'end;',
+  'class procedure TPoint.TBird.Glob;',
+  'begin',
+  'end;',
+  'procedure TPoint.DoIt(b: TBird);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 procedure TTestResolver.TestClass;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -9935,7 +10050,9 @@ begin
   'begin',
   'begin',
   '  TObject.{#p}Create; // new object',
   '  TObject.{#p}Create; // new object',
   '  o:=TObject.{#q}Create; // new object',
   '  o:=TObject.{#q}Create; // new object',
-  '  o.{#r}Create; // normal call']);
+  '  o.{#r}Create; // normal call',
+  '  o:=o.{#s}Create; // normal call',
+  '']);
   ParseProgram;
   ParseProgram;
   aMarker:=FirstSrcMarker;
   aMarker:=FirstSrcMarker;
   while aMarker<>nil do
   while aMarker<>nil do
@@ -9961,7 +10078,7 @@ begin
       if not ActualImplicitCallWithoutParams then
       if not ActualImplicitCallWithoutParams then
         RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
         RaiseErrorAtSrcMarker('expected implicit call at "#'+aMarker^.Identifier+', but got function ref"',aMarker);
       case aMarker^.Identifier of
       case aMarker^.Identifier of
-      'a','r':// should be normal call
+      'a','r','s':// should be normal call
         if ActualNewInstance then
         if ActualNewInstance then
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
           RaiseErrorAtSrcMarker('expected normal call at "#'+aMarker^.Identifier+', but got newinstance"',aMarker);
       else // should be newinstance
       else // should be newinstance
@@ -9975,24 +10092,6 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TTestResolver.TestClass_Constructor_InstanceCallResultFail;
-begin
-  StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('    constructor Create;');
-  Add('  end;');
-  Add('constructor TObject.Create;');
-  Add('begin');
-  Add('end;');
-  Add('var');
-  Add('  o: TObject;');
-  Add('begin');
-  Add('  o:=o.Create; // normal call has no result -> fail');
-  CheckResolverException('Incompatible types: got "Procedure/Function" expected "TObject"',
-    nIncompatibleTypesGotExpected);
-end;
-
 procedure TTestResolver.TestClass_Destructor_FreeInstance;
 procedure TTestResolver.TestClass_Destructor_FreeInstance;
 var
 var
   aMarker: PSrcMarker;
   aMarker: PSrcMarker;
@@ -12059,7 +12158,7 @@ begin
   '    i: longint;',
   '    i: longint;',
   '  end;',
   '  end;',
   'begin']);
   'begin']);
-  CheckParserException(SParserNoFieldsAllowed,nParserNoFieldsAllowed);
+  CheckParserException('Fields are not allowed in interface',nParserNoFieldsAllowed);
 end;
 end;
 
 
 procedure TTestResolver.TestClassInterfaceConstFail;
 procedure TTestResolver.TestClassInterfaceConstFail;
@@ -12160,7 +12259,7 @@ begin
   '    procedure DoIt; virtual;',
   '    procedure DoIt; virtual;',
   '  end;',
   '  end;',
   'begin']);
   'begin']);
-  CheckParserException(sParserNoFieldsAllowed,nParserNoFieldsAllowed);
+  CheckParserException('Fields are not allowed in interface',nParserNoFieldsAllowed);
 end;
 end;
 
 
 procedure TTestResolver.TestClassInterface_Overloads;
 procedure TTestResolver.TestClassInterface_Overloads;
@@ -14748,28 +14847,37 @@ end;
 procedure TTestResolver.TestProcType_Property;
 procedure TTestResolver.TestProcType_Property;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class end;');
-  Add('  TNotifyEvent = procedure(Sender: TObject) of object;');
-  Add('  TControl = class');
-  Add('    FOnClick: TNotifyEvent;');
-  Add('    property OnClick: TNotifyEvent read FOnClick write FOnClick;');
-  Add('    procedure Click(Sender: TObject);');
-  Add('  end;');
-  Add('procedure TControl.Click(Sender: TObject);');
-  Add('begin');
-  Add('  if Assigned(OnClick) then ;');
-  Add('  OnClick:=@Click;');
-  Add('  OnClick(Sender);');
-  Add('  Self.OnClick(Sender);');
-  Add('  with Self do OnClick(Sender);');
-  Add('end;');
-  Add('var Btn: TControl;');
-  Add('begin');
-  Add('  if Assigned(Btn.OnClick) then ;');
-  Add('  Btn.OnClick(Btn);');
-  Add('  Btn.OnClick(Btn);');
-  Add('  with Btn do OnClick(Btn);');
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TNotifyEvent = procedure(Sender: TObject) of object;',
+  '  TControl = class',
+  '    FOnClick: TNotifyEvent;',
+  '    property OnClick: TNotifyEvent read FOnClick write FOnClick;',
+  '    procedure Click(Sender: TObject);',
+  '  end;',
+  '  TButton = class(TControl)',
+  '    property OnClick;',
+  '  end;',
+  'procedure TControl.Click(Sender: TObject);',
+  'begin',
+  '  if Assigned(OnClick) then ;',
+  '  OnClick:=@Click;',
+  '  OnClick(Sender);',
+  '  Self.OnClick(Sender);',
+  '  with Self do OnClick(Sender);',
+  'end;',
+  'var',
+  '  Ctrl: TControl;',
+  '  Btn: TButton;',
+  'begin',
+  '  if Assigned(Ctrl.OnClick) then ;',
+  '  Ctrl.OnClick(Ctrl);',
+  '  with Ctrl do OnClick(Ctrl);',
+  '  if Assigned(Btn.OnClick) then ;',
+  '  Btn.OnClick(Btn);',
+  '  with Btn do OnClick(Btn);',
+  '']);
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
@@ -15388,6 +15496,162 @@ begin
   CheckResolverUnexpectedHints(true);
   CheckResolverUnexpectedHints(true);
 end;
 end;
 
 
+procedure TTestResolver.ClassHelper;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjectHelper = class helper for TObject',
+  '  type T = word;',
+  '  const',
+  '    c: T = 3;',
+  '    k: T = 4;',
+  '  class var',
+  '    v: T;',
+  '    w: T;',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '  end;',
+  '  TExtObjHelper = class helper(TObjectHelper) for TBird',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.ClassHelper_AncestorIsNotHelperForDescendantFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class(TObject)',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '  end;',
+  '  TFish = class(TObject)',
+  '  end;',
+  '  THelper = class helper(TBirdHelper) for TFish',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Derived class helper must extend a subclass of "TBird" or the class itself',
+    nDerivedXMustExtendASubClassY);
+end;
+
+procedure TTestResolver.ClassHelper_ForInterfaceFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  IUnknown = interface',
+  '    procedure DoIt;',
+  '  end;',
+  '  TBirdHelper = class helper for IUnknown',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('class type expected, but IUnknown found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolver.ClassHelper_FieldFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    F: word;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException('Fields are not allowed in class helper',
+    nParserNoFieldsAllowed);
+end;
+
+procedure TTestResolver.ClassHelper_AbstractFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure DoIt; virtual; abstract;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Invalid class helper procedure modifier abstract',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.ClassHelper_VirtualObjFPCFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    procedure DoIt; virtual;',
+  '  end;',
+  'procedure TObjHelper.DoIt;',
+  'begin end;',
+  'begin',
+  '']);
+  CheckResolverException('Invalid class helper procedure modifier virtual',
+    nInvalidXModifierY);
+end;
+
+procedure TTestResolver.RecordHelper;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TRec = record',
+  '  end;',
+  '  TRecHelper = record helper for TRec',
+  '  type T = word;',
+  '  const',
+  '    c: T = 3;',
+  '    k: T = 4;',
+  '  class var',
+  '    v: T;',
+  '    w: T;',
+  '  end;',
+  '  TAnt = word;',
+  '  TAntHelper = record helper for TAnt',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TypeHelper;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TStringHelper = type helper for string',
+  '  end;',
+  '  TCaption = string;',
+  '  TCapHelper = type helper(TStringHelper) for TCaption',
+  '  end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestAttributes_Ignore;
 procedure TTestResolver.TestAttributes_Ignore;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 8 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -165,6 +165,7 @@ type
     Procedure TestReferencePointer;
     Procedure TestReferencePointer;
     Procedure TestInvalidColon;
     Procedure TestInvalidColon;
     Procedure TestTypeHelper;
     Procedure TestTypeHelper;
+    Procedure TestTypeHelperWithParent;
     procedure TestPointerReference;
     procedure TestPointerReference;
     Procedure TestPointerKeyWord;
     Procedure TestPointerKeyWord;
   end;
   end;
@@ -3562,9 +3563,16 @@ end;
 
 
 procedure TTestTypeParser.TestTypeHelper;
 procedure TTestTypeParser.TestTypeHelper;
 begin
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msTypeHelpers];
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
 end;
 end;
 
 
+procedure TTestTypeParser.TestTypeHelperWithParent;
+begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msTypeHelpers];
+  ParseType('Type Helper(TOtherHelper) for AnsiString end',TPasClassType,'');
+end;
+
 procedure TTestTypeParser.TestPointerReference;
 procedure TTestTypeParser.TestPointerReference;
 begin
 begin
   Add('Type');
   Add('Type');

+ 1 - 0
packages/fcl-res/src/coffwriter.pp

@@ -150,6 +150,7 @@ uses coffconsts;
 
 
 constructor TCoffStringTable.Create;
 constructor TCoffStringTable.Create;
   begin
   begin
+    inherited create;
     fSize:=4;
     fSize:=4;
     Duplicates:=dupIgnore;
     Duplicates:=dupIgnore;
   end;
   end;

+ 9 - 2
packages/fcl-web/examples/httpclient/httpget.pas

@@ -1,9 +1,16 @@
 program httpget;
 program httpget;
 
 
 {$mode objfpc}{$H+}
 {$mode objfpc}{$H+}
+{$DEFINE USEGNUTLS}
 
 
 uses
 uses
-  SysUtils, Classes, fphttpclient, sslsockets, fpopenssl, opensslsockets;
+  SysUtils, Classes, fphttpclient,
+{$IFNDEF USEGNUTLS}
+  fpopenssl, opensslsockets,
+{$else}
+  gnutls, gnutlssockets,
+{$endif}
+  sslsockets;
 
 
 Type
 Type
 
 
@@ -82,7 +89,7 @@ procedure TTestApp.Run;
 begin
 begin
   if (ParamCount<>2) then
   if (ParamCount<>2) then
     begin
     begin
-    writeln('Usage : ',ExtractFileName(ParamStr(0)), 'URL filename');
+    writeln('Usage : ',ExtractFileName(ParamStr(0)), ' URL filename');
     Halt(1);
     Halt(1);
     end;
     end;
   With TFPHTTPClient.Create(Nil) do
   With TFPHTTPClient.Create(Nil) do

+ 9 - 1
packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -1,8 +1,16 @@
 {$mode objfpc}
 {$mode objfpc}
 {$h+}
 {$h+}
+{ $define USEGNUTLS}
 program simpleserver;
 program simpleserver;
 
 
-uses sysutils, custhttpapp, fpwebfile, sslbase, opensslsockets;
+uses
+  sysutils,
+{$ifdef USEGNUTLS}
+  gnutlssockets,
+{$else}
+  opensslsockets,
+{$endif}
+  sslbase,custhttpapp, fpwebfile;
 
 
 Type
 Type
 
 

+ 4 - 1
packages/fcl-web/fpmake.pp

@@ -18,7 +18,10 @@ begin
     P.Directory:=ADirectory;
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
 {$endif ALLPACKAGES}
     P.Version:='3.3.1';
     P.Version:='3.3.1';
-    P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros,morphos,dragonfly];
+    P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros,morphos,dragonfly,android];
+    if Defaults.CPU=jvm then
+      P.OSes := P.OSes - [java,android];
+
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-db');
     P.Dependencies.Add('fcl-db');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-xml');

+ 1 - 1
packages/fcl-xml/src/xmlutils.pp

@@ -25,7 +25,7 @@ uses
 type
 type
   TXMLVersion = (xmlVersionUnknown, xmlVersion10, xmlVersion11);
   TXMLVersion = (xmlVersionUnknown, xmlVersion10, xmlVersion11);
   TSetOfChar = set of Char;
   TSetOfChar = set of Char;
-  XMLString = WideString;
+  XMLString = UnicodeString;
   PXMLString = ^XMLString;
   PXMLString = ^XMLString;
   PXMLChar = PWideChar;
   PXMLChar = PWideChar;
 
 

+ 6 - 3
packages/fv/src/drivers.pas

@@ -229,9 +229,12 @@ CONST
 {                         MOUSE BUTTON STATE MASKS                          }
 {                         MOUSE BUTTON STATE MASKS                          }
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 CONST
 CONST
-   mbLeftButton   = $01;                              { Left mouse button }
-   mbRightButton  = $02;                              { Right mouse button }
-   mbMiddleButton = $04;                              { Middle mouse button }
+   mbLeftButton      = $01;                           { Left mouse button }
+   mbRightButton     = $02;                           { Right mouse button }
+   mbMiddleButton    = $04;                           { Middle mouse button }
+   mbScrollWheelDown = $08;                           { Scroll wheel down}
+   mbScrollWheelUp   = $10;                           { Scroll wheel up }
+
 
 
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 {                         SCREEN CRT MODE CONSTANTS                         }
 {                         SCREEN CRT MODE CONSTANTS                         }

+ 1 - 1
packages/fv/src/editors.pas

@@ -1180,7 +1180,7 @@ procedure TIndicator.Draw;
 VAR
 VAR
   Color : Byte;
   Color : Byte;
   Frame : Char;
   Frame : Char;
-  L     : array[0..1] of Longint;
+  L     : array[0..1] of PtrInt;
   S     : String[15];
   S     : String[15];
   B     : TDrawBuffer;
   B     : TDrawBuffer;
 begin
 begin

+ 1 - 1
packages/fv/src/statuses.pas

@@ -785,7 +785,7 @@ var
   B : TDrawBuffer;
   B : TDrawBuffer;
   C : Word;
   C : Word;
   FillSize : Word;
   FillSize : Word;
-  PercentDone : LongInt;
+  PercentDone : PtrInt;
   S : String[4];
   S : String[4];
 begin
 begin
   { fill entire view }
   { fill entire view }

+ 1 - 1
packages/fv/src/validate.pas

@@ -919,7 +919,7 @@ END;
 {---------------------------------------------------------------------------}
 {---------------------------------------------------------------------------}
 PROCEDURE TRangeValidator.Error;
 PROCEDURE TRangeValidator.Error;
 CONST PXErrMsg = 'Value not in the range';
 CONST PXErrMsg = 'Value not in the range';
-VAR Params: Array[0..1] Of Longint;
+VAR Params: Array[0..1] Of PtrInt;
 BEGIN
 BEGIN
    Params[0] := Min;                                  { Transfer min value }
    Params[0] := Min;                                  { Transfer min value }
    Params[1] := Max;                                  { Transfer max value }
    Params[1] := Max;                                  { Transfer max value }

+ 2691 - 0
packages/gnutls/Makefile

@@ -0,0 +1,2691 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-haiku x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+BSDs = freebsd netbsd openbsd darwin dragonfly
+UNIXs = linux $(BSDs) solaris qnx haiku aix
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
+OSNeedsComspecToRunBatch = go32v2 watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef COMSPEC
+ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
+FPC:=$(shell $(FPCPROG) -PB)
+endif
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+else
+ifeq ($(strip $(wildcard $(FPC))),)
+FPC:=$(firstword $(FPCPROG))
+endif
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifeq ($(CPU_TARGET),armeb)
+ARCH=arm
+override FPCOPT+=-Cb
+else
+ifeq ($(CPU_TARGET),armel)
+ARCH=arm
+override FPCOPT+=-CaEABI
+else
+ARCH=$(CPU_TARGET)
+endif
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+endif
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+ifeq ($(OS_SOURCE),darwin)
+DARWIN2DARWIN=1
+endif
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+ifneq ($(OS_TARGET),msdos)
+ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+endif
+endif
+endif
+endif
+endif
+else
+BINUTILSPREFIX=$(OS_TARGET)-
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+ifndef FPCFPMAKE
+ifdef CROSSCOMPILE
+ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPCFPMAKE:=$(shell $(FPCPROG) -PB)
+ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
+FPCFPMAKE:=$(firstword $(FPCPROG))
+endif
+else
+override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
+FPMAKE_SKIP_CONFIG=-n
+export FPCFPMAKE
+export FPMAKE_SKIP_CONFIG
+endif
+else
+FPMAKE_SKIP_CONFIG=-n
+FPCFPMAKE=$(FPC)
+endif
+endif
+override PACKAGE_NAME=gnutls
+override PACKAGE_VERSION=3.3.1
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+EXEDBGEXT=.dbg
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
+endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
+ifeq ($(OS_TARGET),wii)
+EXEEXT=.dol
+SHAREDLIBEXT=.so
+SHORTSUFFIX=wii
+endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHAREDLIBEXT=.a
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
+ifeq ($(OS_TARGET),msdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=d16
+endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+NASM=$(NASMPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
+PPAS=ppas$(SRCBATCHEXT)
+endif
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl fpmkunit fcl-net
+ifeq ($(FULL_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-wii)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),armeb-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),armeb-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i8086-msdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),aarch64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),aarch64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),wasm-wasm)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),sparc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),riscv32-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),riscv32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),riscv64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifeq ($(FULL_TARGET),riscv64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+REQUIRE_PACKAGES_FCL-NET=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+ifdef UNITDIR_FPMAKE_RTL
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_PASZLIB
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_PASZLIB),)
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),)
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)
+else
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_PASZLIB)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_PASZLIB=
+UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_PASZLIB),)
+UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB))
+else
+UNITDIR_PASZLIB=
+endif
+endif
+ifdef UNITDIR_PASZLIB
+override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB)
+endif
+ifdef UNITDIR_FPMAKE_PASZLIB
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_PASZLIB)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+ifdef UNITDIR_FPMAKE_FCL-PROCESS
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-PROCESS)
+endif
+endif
+ifdef REQUIRE_PACKAGES_HASH
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_HASH),)
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),)
+UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)
+else
+UNITDIR_HASH=$(PACKAGEDIR_HASH)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_HASH)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_HASH=
+UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_HASH),)
+UNITDIR_HASH:=$(firstword $(UNITDIR_HASH))
+else
+UNITDIR_HASH=
+endif
+endif
+ifdef UNITDIR_HASH
+override COMPILER_UNITDIR+=$(UNITDIR_HASH)
+endif
+ifdef UNITDIR_FPMAKE_HASH
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_HASH)
+endif
+endif
+ifdef REQUIRE_PACKAGES_LIBTAR
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libtar/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_LIBTAR),)
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)),)
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)
+else
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_LIBTAR)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_LIBTAR) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBTAR)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_LIBTAR=
+UNITDIR_LIBTAR:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libtar/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_LIBTAR),)
+UNITDIR_LIBTAR:=$(firstword $(UNITDIR_LIBTAR))
+else
+UNITDIR_LIBTAR=
+endif
+endif
+ifdef UNITDIR_LIBTAR
+override COMPILER_UNITDIR+=$(UNITDIR_LIBTAR)
+endif
+ifdef UNITDIR_FPMAKE_LIBTAR
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_LIBTAR)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FPMKUNIT
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)),)
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FPMKUNIT=
+UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FPMKUNIT),)
+UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
+else
+UNITDIR_FPMKUNIT=
+endif
+endif
+ifdef UNITDIR_FPMKUNIT
+override COMPILER_UNITDIR+=$(UNITDIR_FPMKUNIT)
+endif
+ifdef UNITDIR_FPMAKE_FPMKUNIT
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-NET
+PACKAGEDIR_FCL-NET:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-net/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-NET),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-NET)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-NET=$(PACKAGEDIR_FCL-NET)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-NET=$(PACKAGEDIR_FCL-NET)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-NET)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-NET=$(PACKAGEDIR_FCL-NET)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-NET)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-NET=$(PACKAGEDIR_FCL-NET)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-NET=$(PACKAGEDIR_FCL-NET)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-NET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-NET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-NET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-NET=
+UNITDIR_FCL-NET:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-net/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-NET),)
+UNITDIR_FCL-NET:=$(firstword $(UNITDIR_FCL-NET))
+else
+UNITDIR_FCL-NET=
+endif
+endif
+ifdef UNITDIR_FCL-NET
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-NET)
+endif
+ifdef UNITDIR_FPMAKE_FCL-NET
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-NET)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(ARCH)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(ARCH)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX)
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+endif
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel),)
+override FPCOPT+=-Cg
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
+EXECPPAS=
+else
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+ifdef RUNBATCH
+	$(RUNBATCH) $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
+endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)  FPC fpmake... $(FPCFPMAKE)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+units:
+examples:
+shared:
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+zipexampleinstall: fpc_zipexampleinstall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: units examples shared sourceinstall exampleinstall zipexampleinstall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+	{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+	$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 102 - 0
packages/gnutls/Makefile.fpc

@@ -0,0 +1,102 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=gnutls
+version=3.3.1
+
+[require]
+packages=rtl fpmkunit fcl-net
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources and omits the location of the source-
+# files from the fpunits.cfg files.
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

+ 155 - 0
packages/gnutls/examples/httpget.pp

@@ -0,0 +1,155 @@
+program httpget;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils, ssockets, gnutls, uriparser;
+
+Const
+  logLevel = 0; // Set to positive value to enable logging.
+  // Correct this for your system.
+  DefaultCerts : PChar =  '/etc/ssl/certs/ca-certificates.crt';
+
+  MAX_BUF = 1024*256;
+  MSG = 'GET %s HTTP/1.0'#13#10'Host: %s'#13#10#13#10;
+
+
+Procedure MyLogFunc(level : longint; msg : PChar); cdecl;
+begin
+  writeln(StdErr,'Log[',Level:2,']: ',msg);
+end;
+
+Var
+  sock : TInetSocket;
+  ret : integer;
+  session : tgnutls_session_t;
+  buf : Array[0..MAX_BUF] of char;
+  cred : tgnutls_certificate_credentials_t;
+  errptr,desc : pchar;
+  FN, URL,S, HostName : String;
+  port : word;
+
+  uri : TURI;
+
+begin
+  if paramCount<1 then
+    begin
+    writeln('Usage : ',ExtractFileName(ParamStr(0)),' url');
+    Halt(1);
+    end;
+  url:=ParamStr(1);
+  uri:=ParseURI(URL,'https',443);
+  hostname:=uri.Host;
+  if uri.Protocol<>'https' then
+    begin
+    Writeln('Only https supported');
+    Halt(1);
+    end;
+  Port:=URI.Port;
+  FN:=uri.Path+URI.Document;
+  if (URI.Params<>'') then
+    FN:=FN+'?'+URI.Params;
+  if FN='' then FN:='/';
+  LoadGNutls();
+  gnutls_global_init();
+  ret := gnutls_certificate_allocate_credentials (@cred);
+  if (ret <> GNUTLS_E_SUCCESS) then
+    begin
+    writeln(stderr, 'error: gnutls_certificate_allocate_credentials: ', gnutls_strerror(ret));
+    halt(1);
+    end;
+  ret := gnutls_certificate_set_x509_trust_file(cred, defaultcerts, GNUTLS_X509_FMT_PEM);
+  if (ret = 0) then
+    begin
+    writeln(stderr, 'error: no certificates found in:', defaultcerts);
+    halt(1);
+    end
+  else if (ret < 0) then
+    begin
+    writeln(stderr, 'error: gnutls_certificate_set_x509_trust_files(',defaultcerts,'): ',
+	     gnutls_strerror(ret));
+    halt(1);
+    end;
+  if (logLevel>0) then
+    begin
+    gnutls_global_set_log_function(@MyLogFunc);
+    gnutls_global_set_log_level(logLevel);
+    end;
+  gnutls_init(@session, GNUTLS_CLIENT);
+  // We can also use
+  //  ret:=gnutls_set_default_priority(session);
+  ret := gnutls_priority_set_direct(session, 'NORMAL', @errptr);
+  if (ret <> GNUTLS_E_SUCCESS) then
+    begin
+    writeln(stderr, 'error: gnutls_priority_set_direct: ',gnutls_strerror(ret) , ' error: at: ', errptr);
+    halt(1);
+    end;
+
+  ret := gnutls_credentials_set(session, GNUTLS_CRD_CERTIFICATE, cred);
+  if (ret <> GNUTLS_E_SUCCESS) then
+    begin
+    writeln(stderr, 'error: gnutls_credentials_set: ', gnutls_strerror(ret));
+    halt(1);
+    end;
+
+  Sock:=TINetSocket.Create(HostName,Port);
+  gnutls_transport_set_int(session, Sock.Handle);
+  gnutls_handshake_set_timeout(session,GNUTLS_DEFAULT_HANDSHAKE_TIMEOUT);
+
+  ret := gnutls_server_name_set(session, GNUTLS_NAME_DNS,pchar(HostName), length(HostName));
+  if (ret <> GNUTLS_E_SUCCESS) then
+    begin
+    writeln(stderr, 'error: gnutls_server_name_set: ', gnutls_strerror(ret));
+    halt(1);
+    end;
+  
+  gnutls_session_set_verify_cert(session,pchar(HostName),0);
+  
+  Repeat
+    ret:=gnutls_handshake(session);
+    if Ret<>GNUTLS_E_SUCCESS then
+      Case ret of
+        GNUTLS_E_AGAIN : Writeln(StdErr,'Handshake again');
+        GNUTLS_E_INTERRUPTED : Writeln(StdErr,'Handshake interrupted');
+      else
+        Writeln(StdErr,'Error ',ret,' received, fatal : ',gnutls_error_is_fatal(ret));
+      end;
+  until (ret>=0)  or (gnutls_error_is_fatal(ret) <> 0);
+  if (ret < 0) then
+    begin
+    writeln(stderr, '*** Handshake failed');
+    gnutls_perror(ret);
+    end
+  else  
+    begin
+    desc := gnutls_session_get_desc(session);
+    writeln(StdErr,'- Session info: ', desc);
+//    gnutls_free(desc);
+    end;
+  S:=Format(Msg,[FN,HostName]);
+  Writeln(StdErr,'Sending request : ',S);
+  gnutls_record_send(session, Pchar(S), length(S));
+  repeat
+    ret := gnutls_record_recv(session, @buf, MAX_BUF);
+    if (ret=0) then
+      writeln(StdErr,'- Peer has closed the TLS connection\n')
+    else if ((ret < 0) and (gnutls_error_is_fatal(ret) = 0)) then
+      writeln(stderr, '*** Warning: ', gnutls_strerror(ret))
+    else if (ret < 0) and (ret<>GNUTLS_E_PREMATURE_TERMINATION) then
+      Writeln(stderr, '*** Error: ', ret, ' : ',gnutls_strerror(ret))
+    else if (ret > 0) then
+        begin
+        writeln(StdErr,'- Received ',ret,' bytes: ');
+        SetLength(S,Ret);
+        Move(Buf[0],S[1],Ret);
+        Write(S);
+        end;
+  until (ret<=0) and Not ((ret=GNUTLS_E_INTERRUPTED) or (Ret=GNUTLS_E_AGAIN));
+  Writeln;
+  gnutls_bye(session, GNUTLS_SHUT_RDWR);
+  Sock.Free;
+  gnutls_deinit(session);
+  gnutls_certificate_free_credentials(cred);
+  gnutls_global_deinit();
+  FreeGnuTLS;
+end.

+ 50 - 0
packages/gnutls/examples/privkey.pp

@@ -0,0 +1,50 @@
+{
+  Simple low-level example for how generate a RSA private key (4096 bytes) using
+  the GnuTLS binding.
+
+  Author(s): Silvio Clecio (silvioprog), Michael Van Canneyt
+  Date: Mon Jan  7 01:36:18 -03 2019
+  GnuTLS version: 3.4+
+}
+
+program privkey;
+
+{$MODE OBJFPC}{$H+}
+{$ASSERTIONS ON}
+
+uses
+  sysutils,
+  ctypes,
+  gnutls;
+
+type
+  EGnuTLS = Exception;
+
+procedure TLSCheckRet(Aret: cint); inline;
+begin
+  if Aret <> GNUTLS_E_SUCCESS then
+    raise EGnuTLS.Create(gnutls_strerror(Aret));
+end;
+
+var
+  priv_key: AnsiString = '';
+  priv_key_size: cuint;
+  key: Tgnutls_x509_privkey_t;
+begin
+  LoadGnuTLS;
+  Assert(GnuTLSLoaded);
+  key:=nil;
+  try
+    TLSCheckRet(gnutls_x509_privkey_init(@key));
+    priv_key_size := gnutls_sec_param_to_pk_bits(GNUTLS_PK_RSA,GNUTLS_SEC_PARAM_HIGH);
+    SetLength(priv_key, Pred(priv_key_size));
+    TLSCheckRet(gnutls_x509_privkey_generate(key, GNUTLS_PK_RSA, priv_key_size, 0));
+    TLSCheckRet(gnutls_x509_privkey_export(key, GNUTLS_X509_FMT_PEM, @priv_key[1], @priv_key_size));
+    SetLength(priv_key, Pred(priv_key_size));
+    WriteLn(priv_key);
+  finally
+    if key<>Nil then
+      gnutls_x509_privkey_deinit(key);
+    FreeGnuTLS;
+  end;
+end.

+ 344 - 0
packages/gnutls/examples/srvcacert.pp

@@ -0,0 +1,344 @@
+{
+  Simple low-level example using the GnuTLS binding for how generate an own CA
+  and self-signed certificate for HTTP server and client.
+
+  Author: Silvio Clecio (silvioprog)
+  Date: Wed Jan  9 03:10:58 BRT 2019
+  GnuTLS version: 3.4+
+
+  Testing the generated files.
+
+  Server side:
+
+    gnutls-serv --port 8080 --http \
+      --x509cafile ca.pem \
+      --x509keyfile server.key \
+      --x509certfile server.pem
+
+  Client side:
+
+    curl -k --key client.key --cert client.pem https://localhost:8080
+
+  or:
+
+    gnutls-cli localhost --port 8080 --insecure \
+      --x509keyfile client.key \
+      --x509certfile client.pem
+}
+
+program srvcacert;
+
+{$MODE OBJFPC}{$H+}
+{$ASSERTIONS ON}
+
+uses
+  sysutils,
+  classes,
+  dateutils,
+  ctypes,
+  gnutls;
+
+const
+  CA_KEY = 'ca.key';
+  CA_PEM = 'ca.pem';
+  SERVER_KEY = 'server.key';
+  SERVER_PEM = 'server.pem';
+  CLIENT_KEY = 'client.key';
+  CLIENT_PEM = 'client.pem';
+
+  CERT_SIZE = 4096;
+
+type
+  EGnuTLS = Exception;
+
+procedure Save(const S: AnsiString; const AFileName: TFileName);
+begin
+  with TStringStream.Create(S) do
+  try
+    SaveToFile(AFileName);
+  finally
+    Free;
+  end;
+end;
+
+procedure TLSCheckRet(Aret: cint); inline;
+begin
+  if Aret <> GNUTLS_E_SUCCESS then
+    raise EGnuTLS.Create(gnutls_strerror(Aret));
+end;
+
+procedure TLSCheck(Aexp: Boolean; Aret: cint); inline;
+begin
+  if Aexp then
+    raise EGnuTLS.Create(gnutls_strerror(Aret));
+end;
+
+procedure TLSGenPrivKey(out Apriv_key: AnsiString);
+var
+  Vkey: Tgnutls_x509_privkey_t;
+  Vpriv_key_size: cuint;
+begin
+  try
+    TLSCheckRet(gnutls_x509_privkey_init(@Vkey));
+    Vpriv_key_size := gnutls_sec_param_to_pk_bits(GNUTLS_PK_RSA,
+      GNUTLS_SEC_PARAM_HIGH);
+    Apriv_key := '';
+    SetLength(Apriv_key, Pred(Vpriv_key_size));
+    TLSCheckRet(gnutls_x509_privkey_generate(Vkey, GNUTLS_PK_RSA,
+      Vpriv_key_size, 0));
+    TLSCheckRet(gnutls_x509_privkey_export(Vkey, GNUTLS_X509_FMT_PEM,
+      @Apriv_key[1], @Vpriv_key_size));
+    SetLength(Apriv_key, Pred(Vpriv_key_size));
+  except
+    gnutls_x509_privkey_deinit(Vkey);
+    raise;
+  end;
+end;
+
+procedure TLSGenCACert(const Aca_priv_key: AnsiString; out Aca_pem: AnsiString;
+  const Acommon_name, Aserial: AnsiString; Adays: Word);
+var
+  Vkey: Tgnutls_x509_privkey_t;
+  Vcrt: Tgnutls_x509_crt_t = nil;
+  Vdata: Tgnutls_datum_t;
+  Vkeyid: AnsiString = '';
+  Vkeyidsize: csize_t;
+  Vactivation: ttime_t;
+  Vca_pem_size: csize_t;
+  Vret: cint;
+begin
+  try
+    TLSCheckRet(gnutls_x509_privkey_init(@Vkey));
+    Vdata.data := @Aca_priv_key[1];
+    Vdata.size := Length(Aca_priv_key);
+    TLSCheckRet(gnutls_x509_privkey_import(Vkey, @Vdata, GNUTLS_X509_FMT_PEM));
+    TLSCheckRet(gnutls_x509_crt_init(@Vcrt));
+    TLSCheckRet(gnutls_x509_crt_set_key(Vcrt, Vkey));
+    TLSCheckRet(gnutls_x509_crt_set_dn_by_oid(Vcrt, GNUTLS_OID_X520_COMMON_NAME,
+      0, @Acommon_name[1], Length(Acommon_name)));
+    TLSCheckRet(gnutls_x509_crt_set_version(Vcrt, 3));
+    TLSCheckRet(gnutls_x509_crt_set_serial(Vcrt, @Aserial[1], Length(Aserial)));
+    Vactivation := DateTimeToUnix(Now,False);
+    TLSCheckRet(gnutls_x509_crt_set_activation_time(Vcrt, Vactivation));
+    TLSCheckRet(gnutls_x509_crt_set_expiration_time(Vcrt,
+      Vactivation + (Adays * 86400)));
+    TLSCheckRet(gnutls_x509_crt_set_ca_status(Vcrt, Ord(True)));
+    TLSCheckRet(gnutls_x509_crt_set_key_usage(Vcrt, GNUTLS_KEY_KEY_CERT_SIGN));
+    Vkeyidsize := 0;
+    Vret := gnutls_x509_crt_get_key_id(Vcrt, GNUTLS_KEYID_USE_SHA1, nil,
+      @Vkeyidsize);
+    TLSCheck((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or (Vkeyidsize < 1), Vret);
+    SetLength(Vkeyid, Pred(Vkeyidsize));
+    TLSCheckRet(gnutls_x509_crt_get_key_id(Vcrt, GNUTLS_KEYID_USE_SHA1,
+      @Vkeyid[1], @Vkeyidsize));
+    TLSCheckRet(gnutls_x509_crt_set_subject_key_id(Vcrt, @Vkeyid[1], Vkeyidsize));
+    TLSCheckRet(gnutls_x509_crt_sign2(Vcrt, Vcrt, Vkey, GNUTLS_DIG_SHA256, 0));
+    Aca_pem := '';
+    Vca_pem_size := CERT_SIZE;
+    SetLength(Aca_pem, Pred(Vca_pem_size));
+    TLSCheckRet(gnutls_x509_crt_export(Vcrt, GNUTLS_X509_FMT_PEM, @Aca_pem[1],
+      @Vca_pem_size));
+    SetLength(Aca_pem, Pred(Vca_pem_size));
+  except
+    gnutls_x509_privkey_deinit(Vkey);
+    gnutls_x509_crt_deinit(Vcrt);
+    raise;
+  end;
+end;
+
+procedure TLSGenSrvCert(const Aca_priv_key, Aca_pem, Asrv_priv_key: AnsiString;
+  out Asrv_pem: AnsiString; const Acommon_name, Aorganization,
+  Aserial: AnsiString; Adays: Word);
+var
+  Vsrv_key: Tgnutls_x509_privkey_t = nil;
+  Vca_key: Tgnutls_x509_privkey_t = nil;
+  Vca_crt: Tgnutls_x509_crt_t = nil;
+  Vsrv_crt: Tgnutls_x509_crt_t = nil;
+  Vdata: Tgnutls_datum_t;
+  Vkeyid: AnsiString = '';
+  Vkeyidsize: csize_t;
+  Vactivation: ttime_t;
+  Vsrv_pem_size: csize_t;
+  Vret: cint;
+begin
+  try
+  TLSCheckRet(gnutls_x509_privkey_init(@Vca_key));
+  Vdata.data := @Aca_priv_key[1];
+  Vdata.size := Length(Aca_priv_key);
+  TLSCheckRet(gnutls_x509_privkey_import(Vca_key, @Vdata, GNUTLS_X509_FMT_PEM));
+  TLSCheckRet(gnutls_x509_privkey_init(@Vsrv_key));
+  Vdata.data := @Asrv_priv_key[1];
+  Vdata.size := Length(Asrv_priv_key);
+  TLSCheckRet(gnutls_x509_privkey_import(Vsrv_key, @Vdata, GNUTLS_X509_FMT_PEM));
+  TLSCheckRet(gnutls_x509_crt_init(@Vca_crt));
+  Vdata.data := @Aca_pem[1];
+  Vdata.size := Length(Aca_pem);
+  TLSCheckRet(gnutls_x509_crt_import(Vca_crt, @Vdata, GNUTLS_X509_FMT_PEM));
+  TLSCheckRet(gnutls_x509_crt_init(@Vsrv_crt));
+  TLSCheckRet(gnutls_x509_crt_set_key(Vsrv_crt, Vsrv_key));
+  TLSCheckRet(gnutls_x509_crt_set_dn_by_oid(Vsrv_crt,
+    GNUTLS_OID_X520_COMMON_NAME, 0, @Acommon_name[1], Length(Acommon_name)));
+  TLSCheckRet(gnutls_x509_crt_set_dn_by_oid(Vsrv_crt,
+    GNUTLS_OID_X520_ORGANIZATION_NAME, 0, @Aorganization[1],
+    Length(Aorganization)));
+  TLSCheckRet(gnutls_x509_crt_set_version(Vsrv_crt, 3));
+  TLSCheckRet(gnutls_x509_crt_set_serial(Vsrv_crt, @Aserial[1],
+    Length(Aserial)));
+  Vactivation := DateTimeToUnix(Now,False);
+  TLSCheckRet(gnutls_x509_crt_set_activation_time(Vsrv_crt, Vactivation));
+  TLSCheckRet(gnutls_x509_crt_set_expiration_time(Vsrv_crt,
+    Vactivation + (Adays * 86400)));
+  TLSCheckRet(gnutls_x509_crt_set_ca_status(Vsrv_crt, Ord(False)));
+  TLSCheckRet(gnutls_x509_crt_set_key_purpose_oid(Vsrv_crt,
+    @GNUTLS_KP_TLS_WWW_SERVER[1], Ord(False)));
+  Vkeyidsize := 0;
+  Vret := gnutls_x509_crt_get_subject_key_id(Vca_crt, nil, @Vkeyidsize, nil);
+  TLSCheck((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or  (Vkeyidsize < 1), Vret);
+  SetLength(Vkeyid, Pred(Vkeyidsize));
+  TLSCheckRet(gnutls_x509_crt_get_subject_key_id(Vca_crt, @Vkeyid[1],
+    @Vkeyidsize, nil));
+  TLSCheckRet(gnutls_x509_crt_set_subject_key_id(Vsrv_crt, @Vkeyid[1],
+    Vkeyidsize));
+  Vkeyidsize := 0;
+  gnutls_x509_crt_get_key_id(Vsrv_crt, GNUTLS_KEYID_USE_SHA1, nil, @Vkeyidsize);
+  TLSCheck((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or (Vkeyidsize < 1), Vret);
+  SetLength(Vkeyid, Pred(Vkeyidsize));
+  TLSCheckRet(gnutls_x509_crt_get_key_id(Vsrv_crt, GNUTLS_KEYID_USE_SHA1,
+    @Vkeyid[1], @Vkeyidsize));
+  TLSCheckRet(gnutls_x509_crt_set_authority_key_id(Vsrv_crt,
+    @Vkeyid[1], Vkeyidsize));
+  TLSCheckRet(gnutls_x509_crt_sign2(Vsrv_crt, Vca_crt, Vca_key,
+    GNUTLS_DIG_SHA256, 0));
+  Vsrv_pem_size := CERT_SIZE;
+  Asrv_pem := '';
+  SetLength(Asrv_pem, Pred(Vsrv_pem_size));
+  TLSCheckRet(gnutls_x509_crt_export(Vsrv_crt, GNUTLS_X509_FMT_PEM,
+    @Asrv_pem[1], @Vsrv_pem_size));
+  SetLength(Asrv_pem, Vsrv_pem_size);
+  except
+    gnutls_x509_privkey_deinit(Vsrv_key);
+    gnutls_x509_privkey_deinit(Vca_key);
+    gnutls_x509_crt_deinit(Vca_crt);
+    gnutls_x509_crt_deinit(Vsrv_crt);
+    raise;
+  end;
+end;
+
+procedure TLSGenCliCert(const Aca_priv_key, Aca_pem, Acli_priv_key: AnsiString;
+  out Acli_pem: AnsiString; const Acommon_name, Aserial: AnsiString;
+  Adays: Word);
+var
+  Vcli_key: Tgnutls_x509_privkey_t = nil;
+  Vca_key: Tgnutls_x509_privkey_t = nil;
+  Vca_crt: Tgnutls_x509_crt_t = nil;
+  Vcli_crt: Tgnutls_x509_crt_t = nil;
+  Vdata: Tgnutls_datum_t;
+  Vkeyid: AnsiString = '';
+  Vkeyidsize: csize_t;
+  Vactivation: ttime_t;
+  Vcli_pem_size: csize_t;
+  Vret: cint;
+begin
+  try
+    TLSCheckRet(gnutls_x509_privkey_init(@Vca_key));
+    Vdata.data := @Aca_priv_key[1];
+    Vdata.size := Length(Aca_priv_key);
+    TLSCheckRet(gnutls_x509_privkey_import(Vca_key, @Vdata,
+      GNUTLS_X509_FMT_PEM));
+    TLSCheckRet(gnutls_x509_privkey_init(@Vcli_key));
+    Vdata.data := @Acli_priv_key[1];
+    Vdata.size := Length(Acli_priv_key);
+    TLSCheckRet(gnutls_x509_privkey_import(Vcli_key, @Vdata,
+      GNUTLS_X509_FMT_PEM));
+    TLSCheckRet(gnutls_x509_crt_init(@Vca_crt));
+    Vdata.data := @Aca_pem[1];
+    Vdata.size := Length(Aca_pem);
+    TLSCheckRet(gnutls_x509_crt_import(Vca_crt, @Vdata, GNUTLS_X509_FMT_PEM));
+    TLSCheckRet(gnutls_x509_crt_init(@Vcli_crt));
+    TLSCheckRet(gnutls_x509_crt_set_key(Vcli_crt, Vcli_key));
+    TLSCheckRet(gnutls_x509_crt_set_dn_by_oid(Vcli_crt,
+      GNUTLS_OID_X520_COMMON_NAME, 0, @Acommon_name[1], Length(Acommon_name)));
+    TLSCheckRet(gnutls_x509_crt_set_version(Vcli_crt, 3));
+    TLSCheckRet(gnutls_x509_crt_set_serial(Vcli_crt, @Aserial[1],
+      Length(Aserial)));
+    Vactivation := DateTimeToUnix(Now,False);
+    TLSCheckRet(gnutls_x509_crt_set_activation_time(Vcli_crt, Vactivation));
+    TLSCheckRet(gnutls_x509_crt_set_expiration_time(Vcli_crt,
+      Vactivation + (Adays * 86400)));
+    TLSCheckRet(gnutls_x509_crt_set_ca_status(Vcli_crt, Ord(False)));
+    TLSCheckRet(gnutls_x509_crt_set_key_purpose_oid(Vcli_crt,
+      @GNUTLS_KP_TLS_WWW_CLIENT[1], Ord(False)));
+    Vkeyidsize := 0;
+    Vret := gnutls_x509_crt_get_subject_key_id(Vca_crt, nil, @Vkeyidsize, nil);
+    TLSCheck((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or (Vkeyidsize < 1), Vret);
+    SetLength(Vkeyid, Pred(Vkeyidsize));
+    TLSCheckRet(gnutls_x509_crt_get_subject_key_id(Vca_crt, @Vkeyid[1],
+      @Vkeyidsize, nil));
+    TLSCheckRet(gnutls_x509_crt_set_subject_key_id(Vcli_crt, @Vkeyid[1],
+      Vkeyidsize));
+    Vkeyidsize := 0;
+    Vret := gnutls_x509_crt_get_key_id(Vca_crt, GNUTLS_KEYID_USE_SHA1,
+      nil, @Vkeyidsize);
+    TLSCheck((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or (Vkeyidsize < 1), Vret);
+    SetLength(Vkeyid, Vkeyidsize);
+    TLSCheckRet(gnutls_x509_crt_get_key_id(Vca_crt, GNUTLS_KEYID_USE_SHA1,
+      @Vkeyid[1], @Vkeyidsize));
+    TLSCheckRet(gnutls_x509_crt_set_authority_key_id(Vcli_crt, @Vkeyid[1],
+      Vkeyidsize));
+    TLSCheckRet(gnutls_x509_crt_sign2(Vcli_crt, Vca_crt, Vca_key,
+      GNUTLS_DIG_SHA256, 0));
+    Vcli_pem_size := CERT_SIZE;
+    Acli_pem := '';
+    SetLength(Acli_pem, Pred(Vcli_pem_size));
+    TLSCheckRet(gnutls_x509_crt_export(Vcli_crt, GNUTLS_X509_FMT_PEM,
+      @Acli_pem[1], @Vcli_pem_size));
+    SetLength(Acli_pem, Vcli_pem_size);
+  except
+    gnutls_x509_privkey_deinit(Vcli_key);
+    gnutls_x509_privkey_deinit(Vca_key);
+    gnutls_x509_crt_deinit(Vca_crt);
+    gnutls_x509_crt_deinit(Vcli_crt);
+    raise;
+  end;
+end;
+
+var
+  ca_pkey, ca_crt, pkey, crt: AnsiString;
+begin
+  LoadGnuTLS;
+  Assert(GnuTLSLoaded);
+  try
+    WriteLn('Generating ', CA_KEY);
+    TLSGenPrivKey(ca_pkey);
+    Save(ca_pkey, CA_KEY);
+    WriteLn('Done!');
+
+    WriteLn('Generating ', CA_PEM);
+    TLSGenCACert(ca_pkey, ca_crt, 'GnuTLS test CA', '01', 365);
+    Save(ca_crt, CA_PEM);
+    WriteLn('Done!');
+
+    WriteLn('Generating ', SERVER_KEY);
+    TLSGenPrivKey(pkey);
+    Save(pkey, SERVER_KEY);
+    WriteLn('Done!');
+
+    WriteLn('Generating ', SERVER_PEM);
+    TLSGenSrvCert(ca_pkey, ca_crt, pkey, crt, 'test.gnutls.org',
+      'GnuTLS test server', '01', 365);
+    Save(crt, SERVER_PEM);
+    WriteLn('Done!');
+
+    WriteLn('Generating ', CLIENT_KEY);
+    TLSGenPrivKey(pkey);
+    Save(pkey, CLIENT_KEY);
+    WriteLn('Done!');
+
+    WriteLn('Generating ', CLIENT_PEM);
+    TLSGenCliCert(ca_pkey, ca_crt, pkey, crt, 'GnuTLS test client', '01', 365);
+    Save(crt, CLIENT_PEM);
+    WriteLn('Done!');
+  finally
+    FreeGnuTLS;
+  end;
+end.

+ 5 - 1
packages/gnutls/fpmake.pp

@@ -25,9 +25,13 @@ begin
     if Defaults.CPU=jvm then
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
       P.OSes := P.OSes - [java,android];
     T:=P.Targets.AddUnit('gnutls.pp');
     T:=P.Targets.AddUnit('gnutls.pp');
+    T:=P.Targets.AddUnit('gnutlssockets.pp');
+      T.Dependencies.AddUnit('gnutls');
     P.ExamplePath.Add('examples');
     P.ExamplePath.Add('examples');
     P.Targets.AddExampleProgram('testgnutls.pp');
     P.Targets.AddExampleProgram('testgnutls.pp');
-
+    P.Targets.AddExampleProgram('privkey.pp');
+    P.Targets.AddExampleProgram('srvcacert.pp');
+    
 {$ifndef ALLPACKAGES}
 {$ifndef ALLPACKAGES}
     Run;
     Run;
     end;
     end;

Разлика између датотеке није приказан због своје велике величине
+ 1122 - 51
packages/gnutls/src/gnutls.pp


+ 604 - 0
packages/gnutls/src/gnutlssockets.pp

@@ -0,0 +1,604 @@
+unit gnutlssockets;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sockets, ssockets, sslsockets, dateUtils,
+  cTypes, sslbase, gnutls;
+
+Const
+  DefCertSize = 8192;
+
+Type
+  EGnuTLS = Class(Exception);
+
+  { TGNUTLSSocketHandler }
+
+  TGNUTLSSocketHandler = Class(TSSLSocketHandler)
+  Private
+    FSession : tgnutls_session_t;
+    FCred : tgnutls_certificate_credentials_t;
+    FGNUTLSLastErrorString: string;
+    FGNUTLSLastError : Integer;
+    FCurrentHostName : String;
+    FCurrentCypherlist : String;
+    function LoadTrustedCertificate(aCertData: TSSLData): Boolean;
+    function MaybeAllocateCredentials: Boolean;
+    procedure SetGNUTLSLastErrorString(AValue: string);
+    function SetTrustedCertificateDir(const aFileName: string): Boolean;
+  Protected
+    function LoadCertificate(aData, aKey: TSSLData): Boolean;
+    procedure FreeCredentials;
+    procedure FreeSession;
+    function DoHandShake: Boolean;
+    function GetCipherListString: String; virtual;
+    Function FetchErrorInfo: Boolean;
+    function Check(aResult: cInt) : cInt;
+    function CheckOK(aResult: cInt) : Boolean;
+    function InitSession(AsServer: Boolean): Boolean; virtual;
+    function DoneSession: Boolean; virtual;
+    function InitSslKeys: boolean;virtual;
+  Public
+    Constructor create; override;
+    destructor destroy; override;
+    function CreateCertGenerator: TX509Certificate; override;
+    function Connect : Boolean; override;
+    function Close : Boolean; override;
+    function Accept : Boolean; override;
+    function Shutdown(BiDirectional : Boolean): boolean; override;
+    function Send(Const Buffer; Count: Integer): Integer; override;
+    function Recv(Const Buffer; Count: Integer): Integer; override;
+    function BytesAvailable: Integer; override;
+    // Result of last CheckSSL call.
+    Function GNUTLSLastError: integer;
+    property GNUTLSLastErrorString: string read FGNUTLSLastErrorString write SetGNUTLSLastErrorString;
+  end;
+
+  { TGNUTLSX509Certificate }
+
+  TGNUTLSX509Certificate = class(TX509Certificate)
+  private
+    FMyFormat : tgnutls_x509_crt_fmt_t;
+    procedure Check(Aret: cint);
+    procedure Check(Aexp: Boolean; Aret: cint);
+    function GenCACert(const Aca_priv_key: TBytes; const Acommon_name, Aserial: AnsiString; Adays: Word): TBytes;
+    function GenPrivKey: TBytes;
+    function GenSrvCert(const Aca_priv_key, Aca_pem, Asrv_priv_key: TBytes; const Acommon_name, Aorganization, Aserial: AnsiString;
+      Adays: Word): TBytes;
+  public
+    constructor create;
+    function CreateCertificateAndKey: TCertAndKey; override;
+  end;
+
+implementation
+
+{ TSocketHandler }
+
+Procedure MaybeInitGNUTLS;
+
+begin
+  if not GnuTLSloaded then
+     LoadGnuTLS();
+end;
+
+{ TGNUTLSX509Certificate }
+
+procedure TGNUTLSX509Certificate.Check(Aret: cint); inline;
+
+begin
+  if Aret <> GNUTLS_E_SUCCESS then
+    raise EGnuTLS.Create(gnutls_strerror(Aret));
+end;
+
+procedure TGNUTLSX509Certificate.Check(Aexp: Boolean; Aret: cint); inline;
+begin
+  if Aexp then
+    raise EGnuTLS.Create(gnutls_strerror(Aret));
+end;
+
+function TGNUTLSX509Certificate.GenPrivKey : TBytes;
+
+var
+  akey: Tgnutls_x509_privkey_t;
+  aSize: cuint;
+
+begin
+  Result:=Default(TBytes);
+  try
+    Check(gnutls_x509_privkey_init(@akey));
+    aSize := gnutls_sec_param_to_pk_bits(GNUTLS_PK_RSA, GNUTLS_SEC_PARAM_HIGH);
+    SetLength(Result,asize);
+    Check(gnutls_x509_privkey_generate(akey, GNUTLS_PK_RSA, aSize, 0));
+    Check(gnutls_x509_privkey_export(akey,FMyFormat,Pointer(Result), @aSize));
+    SetLength(Result,asize);
+  except
+    gnutls_x509_privkey_deinit(akey);
+    raise;
+  end;
+end;
+
+
+Function TGNUTLSX509Certificate.GenCACert(const Aca_priv_key: TBytes; const Acommon_name, Aserial: AnsiString; Adays: Word) : TBytes;
+
+var
+  Vkey: Tgnutls_x509_privkey_t;
+  Vcrt: Tgnutls_x509_crt_t = nil;
+  Vdata: Tgnutls_datum_t;
+  Vkeyid: TBytes;
+  Vkeyidsize: csize_t;
+  Vactivation: ttime_t;
+  Vca_pem_size: csize_t;
+  Vret: cint;
+
+begin
+  Vkeyid:=Default(TBytes);
+  Result:=Default(TBytes);
+  try
+    Check(gnutls_x509_privkey_init(@Vkey));
+    Vdata.data := Pointer(Aca_priv_key);
+    Vdata.size := Length(Aca_priv_key);
+    Check(gnutls_x509_privkey_import(Vkey, @Vdata, FMyFormat));
+    Check(gnutls_x509_crt_init(@Vcrt));
+    Check(gnutls_x509_crt_set_key(Vcrt, Vkey));
+    Check(gnutls_x509_crt_set_dn_by_oid(Vcrt, GNUTLS_OID_X520_COMMON_NAME,0, @Acommon_name[1], Length(Acommon_name)));
+    Check(gnutls_x509_crt_set_version(Vcrt, 3));
+    Check(gnutls_x509_crt_set_serial(Vcrt, @Aserial[1], Length(Aserial)));
+    Vactivation := DateTimeToUnix(Now,False);
+    Check(gnutls_x509_crt_set_activation_time(Vcrt, Vactivation));
+    Check(gnutls_x509_crt_set_expiration_time(Vcrt, Vactivation + (Adays * 86400)));
+    Check(gnutls_x509_crt_set_ca_status(Vcrt, Ord(True)));
+    Check(gnutls_x509_crt_set_key_usage(Vcrt, GNUTLS_KEY_KEY_CERT_SIGN));
+    Vkeyidsize := 0;
+    Vret := gnutls_x509_crt_get_key_id(Vcrt, GNUTLS_KEYID_USE_SHA1, nil, @Vkeyidsize);
+    Check((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or (Vkeyidsize < 1), Vret);
+    SetLength(Vkeyid, Pred(Vkeyidsize));
+    Check(gnutls_x509_crt_get_key_id(Vcrt, GNUTLS_KEYID_USE_SHA1, Pointer(Vkeyid), @Vkeyidsize));
+    Check(gnutls_x509_crt_set_subject_key_id(Vcrt, Pointer(Vkeyid), Vkeyidsize));
+    Check(gnutls_x509_crt_sign2(Vcrt, Vcrt, Vkey, GNUTLS_DIG_SHA256, 0));
+    SetLength(Result, DefCertSize);
+    Check(gnutls_x509_crt_export(Vcrt, FMyFormat, Pointer(Result), @Vca_pem_size));
+    SetLength(Result, Pred(Vca_pem_size));
+  except
+    gnutls_x509_privkey_deinit(Vkey);
+    gnutls_x509_crt_deinit(Vcrt);
+    raise;
+  end;
+end;
+
+Function TGNUTLSX509Certificate.GenSrvCert(const Aca_priv_key, Aca_pem, Asrv_priv_key: TBytes;  const Acommon_name, Aorganization,  Aserial: AnsiString; Adays: Word) : TBytes;
+
+var
+  Vsrv_key: Tgnutls_x509_privkey_t = nil;
+  Vca_key: Tgnutls_x509_privkey_t = nil;
+  Vca_crt: Tgnutls_x509_crt_t = nil;
+  Vsrv_crt: Tgnutls_x509_crt_t = nil;
+  Vdata: Tgnutls_datum_t;
+  Vkeyid: TBytes;
+  Vkeyidsize: csize_t;
+  Vactivation: ttime_t;
+  Vsrv_pem_size: csize_t;
+  Vret: cint;
+
+begin
+  Vkeyid:=Default(TBytes);
+  Result:=Default(TBytes);
+  try
+    Check(gnutls_x509_privkey_init(@Vca_key));
+    Vdata.data := Pointer(Aca_priv_key);
+    Vdata.size := Length(Aca_priv_key);
+    Check(gnutls_x509_privkey_import(Vca_key, @Vdata, FMyFormat));
+    Check(gnutls_x509_privkey_init(@Vsrv_key));
+    Vdata.data := Pointer(Asrv_priv_key);
+    Vdata.size := Length(Asrv_priv_key);
+    Check(gnutls_x509_privkey_import(Vsrv_key, @Vdata, FMyFormat));
+    Check(gnutls_x509_crt_init(@Vca_crt));
+    Vdata.data := Pointer(Aca_pem);
+    Vdata.size := Length(Aca_pem);
+    Check(gnutls_x509_crt_import(Vca_crt, @Vdata, FMyFormat));
+    Check(gnutls_x509_crt_init(@Vsrv_crt));
+    Check(gnutls_x509_crt_set_key(Vsrv_crt, Vsrv_key));
+    Check(gnutls_x509_crt_set_dn_by_oid(Vsrv_crt, GNUTLS_OID_X520_COMMON_NAME, 0, @Acommon_name[1], Length(Acommon_name)));
+    if (AOrganization<>'') then
+      Check(gnutls_x509_crt_set_dn_by_oid(Vsrv_crt, GNUTLS_OID_X520_ORGANIZATION_NAME, 0, @Aorganization[1], Length(Aorganization)));
+    Check(gnutls_x509_crt_set_version(Vsrv_crt, 3));
+    Check(gnutls_x509_crt_set_serial(Vsrv_crt, @Aserial[1],Length(Aserial)));
+    Vactivation := DateTimeToUnix(Now,False);
+    Check(gnutls_x509_crt_set_activation_time(Vsrv_crt, Vactivation));
+    Check(gnutls_x509_crt_set_expiration_time(Vsrv_crt, Vactivation + (Adays * 86400)));
+    Check(gnutls_x509_crt_set_ca_status(Vsrv_crt, Ord(False)));
+    Check(gnutls_x509_crt_set_key_purpose_oid(Vsrv_crt,  @GNUTLS_KP_TLS_WWW_SERVER[1], Ord(False)));
+    Vkeyidsize := 0;
+    Vret := gnutls_x509_crt_get_subject_key_id(Vca_crt, nil, @Vkeyidsize, nil);
+    Check((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or  (Vkeyidsize < 1), Vret);
+    SetLength(Vkeyid, Pred(Vkeyidsize));
+    Check(gnutls_x509_crt_get_subject_key_id(Vca_crt, Pointer(Vkeyid), @Vkeyidsize, nil));
+    Check(gnutls_x509_crt_set_subject_key_id(Vsrv_crt, Pointer(Vkeyid), Vkeyidsize));
+    Vkeyidsize := 0;
+    gnutls_x509_crt_get_key_id(Vsrv_crt, GNUTLS_KEYID_USE_SHA1, nil, @Vkeyidsize);
+    Check((Vret <> GNUTLS_E_SHORT_MEMORY_BUFFER) or (Vkeyidsize < 1), Vret);
+    SetLength(Vkeyid, Pred(Vkeyidsize));
+    Check(gnutls_x509_crt_get_key_id(Vsrv_crt, GNUTLS_KEYID_USE_SHA1, Pointer(Vkeyid), @Vkeyidsize));
+    Check(gnutls_x509_crt_set_authority_key_id(Vsrv_crt,  Pointer(Vkeyid), Vkeyidsize));
+    Check(gnutls_x509_crt_sign2(Vsrv_crt, Vca_crt, Vca_key,  GNUTLS_DIG_SHA256, 0));
+    Vsrv_pem_size := DefCertSize;
+    SetLength(Result, Pred(Vsrv_pem_size));
+    Check(gnutls_x509_crt_export(Vsrv_crt, FMyFormat,Pointer(Result), @Vsrv_pem_size));
+    SetLength(Result, Vsrv_pem_size);
+  except
+    gnutls_x509_privkey_deinit(Vsrv_key);
+    gnutls_x509_privkey_deinit(Vca_key);
+    gnutls_x509_crt_deinit(Vca_crt);
+    gnutls_x509_crt_deinit(Vsrv_crt);
+    raise;
+  end;
+end;
+
+constructor TGNUTLSX509Certificate.create;
+begin
+  FMyFormat:=GNUTLS_X509_FMT_PEM;
+end;
+
+function TGNUTLSX509Certificate.CreateCertificateAndKey: TCertAndKey;
+
+Var
+  PK,cacert : TBytes;
+
+begin
+  Result:=Default(TCertAndKey);
+  PK:=GenPrivKey;
+  CaCErt:=GenCACert(PK,Self.HostName,IntToStr(Serial),30);
+  Result.PrivateKey:=PK;
+  Result.Certificate:=GenSrvCert(PK,CaCert,PK,Self.HostName,'',IntToStr(Serial),30);
+end;
+
+function TGNUTLSSocketHandler.CreateCertGenerator: TX509Certificate;
+begin
+  Result:=TGNUTLSX509Certificate.Create;
+end;
+
+procedure TGNUTLSSocketHandler.SetGNUTLSLastErrorString(AValue: string);
+begin
+  if FGNUTLSLastErrorString=AValue then Exit;
+  FGNUTLSLastErrorString:=AValue;
+end;
+
+
+function TGNUTLSSocketHandler.Connect: Boolean;
+
+begin
+  Result:=Inherited Connect;
+  // Initsession sets handle
+  Result := Result and InitSession(False);
+  if Not Result then
+     exit;
+  if (Socket is TInetSocket) then
+    begin
+    FCurrentHostName:=(Socket as TInetSocket).Host;
+    if SendHostAsSNI then
+      begin
+      Result:=CheckOK(gnutls_server_name_set(FSession, GNUTLS_NAME_DNS,pchar(FCurrentHostName), length(FCurrentHostName)));
+      if not Result then
+        exit;
+      end;
+    gnutls_session_set_verify_cert(Fsession,pchar(FCurrentHostName),0);
+    end;
+  if Not Result then
+    exit;
+  Result:=DoHandShake;
+  if Result and VerifyPeerCert then
+    Result:=(not DoVerifyCert);
+  if Result then
+    SetSSLActive(True);
+end;
+
+function TGNUTLSSocketHandler.Close: Boolean;
+begin
+  Result:=CheckOK(gnutls_bye(FSession,GNUTLS_SHUT_WR));
+end;
+
+Function TGNUTLSSocketHandler.FetchErrorInfo : Boolean;
+
+Var
+  P : Pchar;
+
+begin
+  FGNUTLSLastErrorString:='';
+  Result:=(FGNUTLSLastError<>0);
+  if Result then
+    begin
+    P:=gnutls_strerror(FGNUTLSLastError);
+    if P<>Nil then
+      FGNUTLSLastErrorString:=StrPas(P)
+    else
+      FGNUTLSLastErrorString:=Format('Unknown error code: %d',[FGNUTLSLastError]);
+    end;
+end;
+
+function TGNUTLSSocketHandler.CheckOK(aResult: cInt): Boolean;
+begin
+  Result:=Check(aResult)>=0;
+end;
+
+function TGNUTLSSocketHandler.Check(aResult: cInt): cInt;
+begin
+  Result:=aResult;
+  if (Result<>GNUTLS_E_SUCCESS) then
+     begin
+     FGNUTLSLastError:=aResult;
+     FetchErrorInfo;
+     end;
+end;
+
+function TGNUTLSSocketHandler.GetCipherListString : String;
+
+begin
+  //  Set correct cipher list here
+  if FCurrentCypherlist='' then
+    begin
+    // We need it in a field variable, it seems GNUTLS expects it to last?
+    FCurrentCypherlist:='NORMAL';
+    end;
+  Result:=FCurrentCypherlist;
+end;
+
+function TGNUTLSSocketHandler.InitSession(AsServer: Boolean): Boolean;
+
+Const
+  InitFlags : Array[Boolean] of cInt = (GNUTLS_CLIENT,GNUTLS_SERVER);
+
+Var
+  flags :Cint;
+  errPtr : Pchar;
+
+begin
+  Flags:=InitFlags[AsServer];
+  Result:=CheckOK(gnutls_init(@FSession,Flags));
+  if not Result then
+    exit;
+  Result:=CheckOK(gnutls_priority_set_direct(FSession, PChar(GetCipherListString), @errptr));
+  if not Result then
+    FGNUTLSLastErrorString:=FGNUTLSLastErrorString+', error at: '+StrPas(errPtr);
+  If AsServer and CertificateData.NeedCertificateData  then
+    if Not CreateSelfSignedCertificate then
+      begin
+      DoneSession;
+      Exit(False);
+      end;
+  Result:=InitSslKeys;
+  if not Result then
+    DoneSession;
+{
+S:=CertificateData.CipherList;
+FCTX.SetVerify(VO[VerifypeerCert],Nil);
+FCTX.SetDefaultPasswdCb(@HandleSSLPwd);
+FCTX.SetDefaultPasswdCbUserdata(self);
+}
+  gnutls_transport_set_int2(FSession,Socket.Handle,Socket.Handle);
+  gnutls_handshake_set_timeout(FSession,GNUTLS_DEFAULT_HANDSHAKE_TIMEOUT);
+end;
+
+function TGNUTLSSocketHandler.DoneSession: Boolean;
+begin
+  FreeSession;
+  FreeCredentials;
+  Result:=True;
+end;
+
+function TGNUTLSSocketHandler.MaybeAllocateCredentials : Boolean;
+
+begin
+  Result:=Assigned(FCred);
+  if Result then
+    exit;
+  Result:=CheckOK(gnutls_certificate_allocate_credentials(@FCred));
+  if Result then
+    Result:=CheckOK(gnutls_credentials_set(FSession, GNUTLS_CRD_CERTIFICATE, FCred));
+end;
+
+function TGNUTLSSocketHandler.LoadCertificate(aData,aKey : TSSLData) : Boolean;
+var
+  key,cert : tgnutls_datum_t;
+
+begin
+  result:=MaybeAllocateCredentials;
+  if not Result then exit;
+  if (aData.FileName='') then
+    begin
+    cert.data:=Pointer(aData.Value);
+    cert.size:=Length(aData.Value);
+    key.data:=Pointer(aKey.Value);
+    key.size:=Length(aKey.Value);
+    Result:=CheckOK(gnutls_certificate_set_x509_key_mem(FCred,@cert,@key,GNUTLS_X509_FMT_PEM));
+    if not Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_key_mem(FCred,@cert,@key,GNUTLS_X509_FMT_DER));
+    end
+  else
+    begin
+    Result:=CheckOK(gnutls_certificate_set_x509_key_file (FCred, pChar(aData.FileName),PChar(aKey.FileName),GNUTLS_X509_FMT_PEM));
+    if not Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_key_file (FCred, pChar(aData.FileName),PChar(aKey.FileName),GNUTLS_X509_FMT_DER));
+    end;
+  if Result then
+    Result:=CheckOK(gnutls_credentials_set(FSession, GNUTLS_CRD_CERTIFICATE, FCred));
+end;
+
+function TGNUTLSSocketHandler.LoadTrustedCertificate(aCertData : TSSLData) : Boolean;
+
+var
+  ca : tgnutls_datum_t;
+
+begin
+  MaybeAllocateCredentials;
+  Result:=False;
+  if (aCertData.FileName<>'') then
+    begin
+    Result:=CheckOK(gnutls_certificate_set_x509_trust_file(FCred,PChar(aCertData.FileName),GNUTLS_X509_FMT_PEM));
+    if not Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_trust_file(FCred,PChar(aCertData.FileName),GNUTLS_X509_FMT_DER));
+    end;
+  if (Length(aCertData.Value)>0) then
+    begin
+    ca.data:=Pointer(aCertData.Value);
+    ca.size:=Length(aCertData.Value);
+    Result:=CheckOK(gnutls_certificate_set_x509_trust_mem(FCred,@ca,GNUTLS_X509_FMT_PEM));
+    if not Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_trust_mem(FCred,@ca,GNUTLS_X509_FMT_DER));
+    end;
+end;
+
+function TGNUTLSSocketHandler.SetTrustedCertificateDir(Const aFileName : string) : Boolean;
+
+Var
+  P : PChar;
+
+begin
+  MaybeAllocateCredentials;
+  P:=PAnsiChar(aFileName);
+  if DirectoryExists(aFileName) then
+    begin
+    Result:=CheckOK(gnutls_certificate_set_x509_trust_dir(FCred,P,GNUTLS_X509_FMT_PEM));
+    if not Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_trust_dir(FCred,P,GNUTLS_X509_FMT_DER));
+    end
+  else
+    begin
+    Result:=CheckOK(gnutls_certificate_set_x509_trust_File(FCred,P,GNUTLS_X509_FMT_PEM));
+    if not Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_trust_File(FCred,P,GNUTLS_X509_FMT_DER));
+    end;
+end;
+
+function TGNUTLSSocketHandler.InitSslKeys: boolean;
+
+begin
+  Result:=(FSession<>Nil);
+  if not Result then
+    Exit;
+  if not (CertificateData.NeedCertificateData) then
+    Result:=LoadCertificate(CertificateData.Certificate,CertificateData.PrivateKey);
+  if Result and Not CertificateData.TrustedCertificate.Empty then
+    Result:=LoadTrustedCertificate(CertificateData.TrustedCertificate);
+  if Result and (CertificateData.CertCA.FileName<>'') then
+    Result:=Result and SetTrustedCertificateDir(CertificateData.CertCA.FileName);
+  // If nothing was set, set defaults.
+  if not Assigned(FCred) then
+    begin
+    Result:=MaybeAllocateCredentials;
+    if Result then
+      Result:=CheckOK(gnutls_certificate_set_x509_system_trust(FCred));
+    end;
+end;
+
+constructor TGNUTLSSocketHandler.create;
+begin
+  inherited create;
+  MaybeInitGNUTLS;
+end;
+
+destructor TGNUTLSSocketHandler.destroy;
+begin
+  DoneSession;
+  FreeSession;
+  FreeCredentials;
+  inherited destroy;
+end;
+
+Procedure TGNUTLSSocketHandler.FreeSession;
+
+begin
+  If (FSession<>Nil) then
+    begin
+    gnutls_deinit(Fsession);
+    Fsession:=Nil;
+    end;
+end;
+
+Procedure TGNUTLSSocketHandler.FreeCredentials;
+
+begin
+  If (FCred<>Nil) then
+    begin
+    gnutls_certificate_free_credentials(FCred);
+    FCred:=Nil;
+    end;
+end;
+
+function TGNUTLSSocketHandler.DoHandShake : Boolean;
+
+Var
+  Ret : cInt;
+
+begin
+  Repeat
+    ret:=Check(gnutls_handshake(FSession));
+  until (ret>=0) or (gnutls_error_is_fatal(ret) <> 0);
+  Result:=Ret>=0;
+end;
+
+function TGNUTLSSocketHandler.Accept: Boolean;
+
+begin
+  Result:=InitSession(True);
+  if Result then
+    Result:=DoHandShake;
+  SetSSLActive(Result);
+end;
+
+
+function TGNUTLSSocketHandler.Shutdown(BiDirectional : Boolean): boolean;
+
+begin
+  Result:=assigned(FSession);
+  if Result then
+    If Not BiDirectional then
+      gnutls_bye(FSession, GNUTLS_SHUT_WR)
+    else
+      begin
+      Result:=CheckOK(gnutls_bye(FSession, GNUTLS_SHUT_RDWR));
+      if Result then
+        Result:=fpShutdown(Socket.Handle,1)=0;
+      end;
+  If Result then
+    Result:=DoneSession;
+end;
+
+function TGNUTLSSocketHandler.Send(Const Buffer; Count: Integer): Integer;
+
+Var
+  P : PByte;
+
+begin
+  P:=PByte(@Buffer);
+  Result:=Check(gnutls_record_send(Fsession,P,Count));
+  if Result<0 then
+    Result:=-1;
+end;
+
+function TGNUTLSSocketHandler.Recv(Const Buffer; Count: Integer): Integer;
+
+Var
+  P : PByte;
+
+begin
+  P:=PByte(@Buffer);
+  Result:=Check(gnutls_record_recv(FSession,P,Count));
+  if Result<0 then
+    Result:=-1;
+end;
+
+function TGNUTLSSocketHandler.BytesAvailable: Integer;
+begin
+  Result:=gnutls_record_check_pending(FSession);
+end;
+
+Function TGNUTLSSocketHandler.GNUTLSLastError: integer;
+begin
+  Result:=FGNUTLSLastError;
+end;
+
+initialization
+  TSSLSocketHandler.SetDefaultHandlerClass(TGNUTLSSocketHandler);
+end.
+

Разлика између датотеке није приказан због своје велике величине
+ 164 - 336
packages/graph/src/go32v2/graph.pp


+ 114 - 195
packages/graph/src/go32v2/vesa.inc

@@ -85,24 +85,14 @@ var
     VESAPtr : ^TVESAInfo;
     VESAPtr : ^TVESAInfo;
     st : string[4];
     st : string[4];
     regs : TDPMIRegisters;
     regs : TDPMIRegisters;
-{$ifndef fpc}
-    ModeSel: word;
-    offs: longint;
-{$endif fpc}
     { added... }
     { added... }
     modelist: PmodeList;
     modelist: PmodeList;
     i: longint;
     i: longint;
     RealSeg : word;
     RealSeg : word;
    begin
    begin
     { Allocate real mode buffer }
     { Allocate real mode buffer }
-{$ifndef fpc}
-    Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
-    { Get selector value }
-    VESAPtr := pointer(Ptrlong shl 16);
-{$else fpc}
     Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
     Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
     New(VESAPtr);
     New(VESAPtr);
-{$endif fpc}
     { Get segment value }
     { Get segment value }
     RealSeg := word(Ptrlong shr 16);
     RealSeg := word(Ptrlong shr 16);
     if not assigned(VESAPtr) then
     if not assigned(VESAPtr) then
@@ -114,11 +104,9 @@ var
     regs.es := RealSeg;
     regs.es := RealSeg;
     regs.edi := $00;
     regs.edi := $00;
     RealIntr($10, regs);
     RealIntr($10, regs);
-{$ifdef fpc}
    { no far pointer support in FPC yet, so move the vesa info into a memory }
    { no far pointer support in FPC yet, so move the vesa info into a memory }
    { block in the DS slector space (JM)                                     }
    { block in the DS slector space (JM)                                     }
     dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
     dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
-{$endif fpc}
     St:=Vesaptr^.signature;
     St:=Vesaptr^.signature;
     if st<>'VESA' then
     if st<>'VESA' then
      begin
      begin
@@ -126,44 +114,15 @@ var
          LogLn('No VESA detected.');
          LogLn('No VESA detected.');
 {$endif logging}
 {$endif logging}
          getVesaInfo := FALSE;
          getVesaInfo := FALSE;
-{$ifndef fpc}
-         GlobalDosFree(word(PtrLong and $ffff));
-{$else fpc}
          If not Global_Dos_Free(word(PtrLong and $ffff)) then
          If not Global_Dos_Free(word(PtrLong and $ffff)) then
            RunError(216);
            RunError(216);
          { also free the extra allocated buffer }
          { also free the extra allocated buffer }
          Dispose(VESAPtr);
          Dispose(VESAPtr);
-{$endif fpc}
          exit;
          exit;
      end
      end
     else
     else
       getVesaInfo := TRUE;
       getVesaInfo := TRUE;
 
 
-{$ifndef fpc}
-    { The mode pointer buffer points to a real mode memory }
-    { Therefore steps to get the modes:                    }
-    {  1. Allocate Selector and SetLimit to max number of  }
-    {     of possible modes.                               }
-    ModeSel := AllocSelector(0);
-    SetSelectorLimit(ModeSel, 256*sizeof(word));
-
-    {  2. Set Selector linear address to the real mode pointer }
-    {     returned.                                            }
-    offs := longint(longint(VESAPtr^.ModeList) shr 16) shl 4;
-   {shouldn't the OR in the next line be a + ?? (JM)}
-    offs :=  offs OR (Longint(VESAPtr^.ModeList) and $ffff);
-    SetSelectorBase(ModeSel, offs);
-
-     { copy VESA mode information to a protected mode buffer and }
-     { then free the real mode buffer...                         }
-     Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
-     GlobalDosFree(word(PtrLong and $ffff));
-
-    { ModeList points to the mode list     }
-    { We must copy it somewhere...         }
-    ModeList := Ptr(ModeSel, 0);
-
-{$else fpc}
     { No far pointer support, so the Ptr(ModeSel, 0) doesn't work.     }
     { No far pointer support, so the Ptr(ModeSel, 0) doesn't work.     }
     { Immediately copy everything to a buffer in the DS selector space }
     { Immediately copy everything to a buffer in the DS selector space }
      New(ModeList);
      New(ModeList);
@@ -180,7 +139,6 @@ var
      If not Global_Dos_Free(word(PtrLong and $ffff)) then
      If not Global_Dos_Free(word(PtrLong and $ffff)) then
        RunError(216);
        RunError(216);
      Dispose(VESAPtr);
      Dispose(VESAPtr);
-{$endif fpc}
 
 
     i:=0;
     i:=0;
     new(VESAInfo.ModeList);
     new(VESAInfo.ModeList);
@@ -197,41 +155,22 @@ var
 {$ifdef logging}
 {$ifdef logging}
     LogLn(strf(i) + ' modes found.');
     LogLn(strf(i) + ' modes found.');
 {$endif logging}
 {$endif logging}
-{$ifndef fpc}
-    FreeSelector(ModeSel);
-{$else fpc}
     Dispose(ModeList);
     Dispose(ModeList);
-{$endif fpc}
    end;
    end;
 
 
   function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
   function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
    var
    var
     Ptr: longint;
     Ptr: longint;
-{$ifndef fpc}
-    VESAPtr : ^TVESAModeInfo;
-{$endif fpc}
     regs : TDPMIRegisters;
     regs : TDPMIRegisters;
     RealSeg: word;
     RealSeg: word;
    begin
    begin
     { Alllocate real mode buffer }
     { Alllocate real mode buffer }
-{$ifndef fpc}
-    Ptr:=GlobalDosAlloc(sizeof(TVESAModeInfo));
-    { get the selector value }
-    VESAPtr := pointer(longint(Ptr shl 16));
-    if not assigned(VESAPtr) then
-      RunError(203);
-{$else fpc}
     Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
     Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
-{$endif fpc}
     { get the segment value }
     { get the segment value }
     RealSeg := word(Ptr shr 16);
     RealSeg := word(Ptr shr 16);
     { we have to init everything to zero, since VBE < 1.1  }
     { we have to init everything to zero, since VBE < 1.1  }
     { may not setup fields correctly.                      }
     { may not setup fields correctly.                      }
-{$ifndef fpc}
-    FillChar(VESAPtr^, sizeof(ModeInfo), #0);
-{$else fpc}
     DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0);
     DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0);
-{$endif fpc}
     { setup interrupt registers }
     { setup interrupt registers }
     FillChar(regs, sizeof(regs), #0);
     FillChar(regs, sizeof(regs), #0);
     { call VESA mode information...}
     { call VESA mode information...}
@@ -245,18 +184,10 @@ var
     else
     else
       getVESAModeInfo := TRUE;
       getVESAModeInfo := TRUE;
     { copy to protected mode buffer ... }
     { copy to protected mode buffer ... }
-{$ifndef fpc}
-    Move(VESAPtr^, ModeInfo, sizeof(ModeInfo));
-{$else fpc}
     DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
     DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
-{$endif fpc}
     { free real mode memory  }
     { free real mode memory  }
-{$ifndef fpc}
-    GlobalDosFree(Word(Ptr and $ffff));
-{$else fpc}
     If not Global_Dos_Free(Word(Ptr and $ffff)) then
     If not Global_Dos_Free(Word(Ptr and $ffff)) then
       RunError(216);
       RunError(216);
-{$endif fpc}
    end;
    end;
 
 
 {$ELSE}
 {$ELSE}
@@ -391,7 +322,7 @@ end;
  {*                     8-bit pixels VESA mode routines                  *}
  {*                     8-bit pixels VESA mode routines                  *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA256(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA256(x, y : smallint; color : word);
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -413,7 +344,7 @@ end;
        end;
        end;
   end;
   end;
 
 
-  procedure DirectPutPixVESA256(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA256(x, y : smallint);
   var
   var
      offs : longint;
      offs : longint;
      col : byte;
      col : byte;
@@ -446,7 +377,7 @@ end;
      mem[WinWriteSeg : word(offs)] := Col;
      mem[WinWriteSeg : word(offs)] := Col;
   end;
   end;
 
 
-  function GetPixVESA256(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  function GetPixVESA256(x, y : smallint): word;
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -457,7 +388,7 @@ end;
      GetPixVESA256:=mem[WinReadSeg : word(offs)];
      GetPixVESA256:=mem[WinReadSeg : word(offs)];
   end;
   end;
 
 
-  Procedure GetScanLineVESA256(x1, x2, y: smallint; var data); {$ifndef fpc}far;{$endif}
+  Procedure GetScanLineVESA256(x1, x2, y: smallint; var data);
   var offs: Longint;
   var offs: Longint;
       l, amount, bankrest, index, pixels: longint;
       l, amount, bankrest, index, pixels: longint;
       curbank: smallint;
       curbank: smallint;
@@ -546,7 +477,7 @@ end;
     Until amount = 0;
     Until amount = 0;
   end;
   end;
 
 
-  procedure HLineVESA256(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure HLineVESA256(x,x2,y: smallint);
 
 
    var Offs: Longint;
    var Offs: Longint;
        mask, l, bankrest: longint;
        mask, l, bankrest: longint;
@@ -869,7 +800,7 @@ end;
        end;
        end;
    end;
    end;
 
 
-  procedure VLineVESA256(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure VLineVESA256(x,y,y2: smallint);
 
 
    var Offs: Longint;
    var Offs: Longint;
        l, bankrest: longint;
        l, bankrest: longint;
@@ -1024,7 +955,7 @@ end;
        end;
        end;
    end;
    end;
 
 
-  procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure PatternLineVESA256(x1,x2,y: smallint);
   {********************************************************}
   {********************************************************}
   { Draws a horizontal patterned line according to the     }
   { Draws a horizontal patterned line according to the     }
   { current Fill Settings.                                 }
   { current Fill Settings.                                 }
@@ -1156,12 +1087,11 @@ end;
  {************************************************************************}
  {************************************************************************}
  {*                    256 colors VESA mode routines  Linear mode        *}
  {*                    256 colors VESA mode routines  Linear mode        *}
  {************************************************************************}
  {************************************************************************}
-{$ifdef FPC}
 type
 type
   pbyte = ^byte;
   pbyte = ^byte;
   pword = ^word;
   pword = ^word;
 
 
-  procedure DirectPutPixVESA256Linear(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA256Linear(x, y : smallint);
   var
   var
      offs : longint;
      offs : longint;
      col : byte;
      col : byte;
@@ -1205,7 +1135,7 @@ type
        seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
        seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
   end;
   end;
 
 
-  procedure PutPixVESA256Linear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA256Linear(x, y : smallint; color : word);
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -1230,7 +1160,7 @@ type
        seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
        seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
   end;
   end;
 
 
-  function GetPixVESA256Linear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  function GetPixVESA256Linear(x, y : smallint): word;
   var
   var
      offs : longint;
      offs : longint;
      col : byte;
      col : byte;
@@ -1277,14 +1207,13 @@ begin
     SetVESADisplayStart:=true;
     SetVESADisplayStart:=true;
 end;
 end;
 *)
 *)
-{$endif FPC}
 
 
 
 
  {************************************************************************}
  {************************************************************************}
  {*                    15/16bit pixels VESA mode routines                *}
  {*                    15/16bit pixels VESA mode routines                *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA32kOr64k(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA32kOr64k(x, y : smallint; color : word);
   var
   var
      offs : longint;
      offs : longint;
      place: word;
      place: word;
@@ -1316,7 +1245,7 @@ end;
      memW[WinWriteSeg : place] := color;
      memW[WinWriteSeg : place] := color;
   end;
   end;
 
 
-  function GetPixVESA32kOr64k(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  function GetPixVESA32kOr64k(x, y : smallint): word;
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -1327,7 +1256,7 @@ end;
      GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
      GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
   end;
   end;
 
 
-  procedure DirectPutPixVESA32kOr64k(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA32kOr64k(x, y : smallint);
   var
   var
      offs : longint;
      offs : longint;
      bank : smallint;
      bank : smallint;
@@ -1372,7 +1301,7 @@ end;
      End;
      End;
   end;
   end;
 
 
-  procedure HLineVESA32kOr64k(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure HLineVESA32kOr64k(x,x2,y: smallint);
 
 
    var Offs: Longint;
    var Offs: Longint;
        mask, l, bankrest: longint;
        mask, l, bankrest: longint;
@@ -1689,12 +1618,11 @@ end;
        end;
        end;
    end;
    end;
 
 
-{$ifdef FPC}
  {************************************************************************}
  {************************************************************************}
  {*                    15/16bit pixels VESA mode routines  Linear mode   *}
  {*                    15/16bit pixels VESA mode routines  Linear mode   *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA32kor64kLinear(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA32kor64kLinear(x, y : smallint; color : word);
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -1715,7 +1643,7 @@ end;
        seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
        seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
   end;
   end;
 
 
-  function GetPixVESA32kor64kLinear(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  function GetPixVESA32kor64kLinear(x, y : smallint): word;
   var
   var
      offs : longint;
      offs : longint;
      color : word;
      color : word;
@@ -1730,7 +1658,7 @@ end;
      GetPixVESA32kor64kLinear:=color;
      GetPixVESA32kor64kLinear:=color;
   end;
   end;
 
 
-  procedure DirectPutPixVESA32kor64kLinear(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA32kor64kLinear(x, y : smallint);
   var
   var
      offs : longint;
      offs : longint;
      col : word;
      col : word;
@@ -1774,13 +1702,82 @@ end;
        seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
        seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
   end;
   end;
 
 
-{$endif FPC}
+  procedure HLineVESA32kOr64kLinear(x,x2,y: smallint);
+  var
+    Offs: Longint;
+    hlength: smallint;
+  begin
+    { must we swap the values? }
+    if x > x2 then
+      begin
+        x := x xor x2;
+        x2 := x xor x2;
+        x:= x xor x2;
+      end;
+    { First convert to global coordinates }
+    X   := X + StartXViewPort;
+    X2  := X2 + StartXViewPort;
+    Y   := Y + StartYViewPort;
+    if ClipPixels and
+       LineClipped(x,y,x2,y,
+                   StartXViewPort,StartYViewPort,
+                   StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+      exit;
+    {$ifdef logging2}
+    LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
+    {$endif logging2}
+    HLength := x2 - x + 1;
+    {$ifdef logging2}
+    LogLn('length: '+strf(hlength));
+    {$endif logging2}
+    Offs:=Longint(y)*BytesPerLine+2*x;
+    {$ifdef logging2}
+    LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
+    {$endif logging2}
+    case CurrentWriteMode of
+      XorPut:
+        begin
+          if UseNoSelector then
+            seg_xorword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
+          else
+            seg_xorword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
+        end;
+      OrPut:
+        begin
+          if UseNoSelector then
+            seg_orword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
+          else
+            seg_orword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
+        end;
+      AndPut:
+        begin
+          if UseNoSelector then
+            seg_andword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
+          else
+            seg_andword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
+        end;
+      NormalPut:
+        begin
+          if UseNoSelector then
+            FillWord(Pointer(LFBPointer+offs+LinearPageOfs)^,HLength,Word(CurrentColor))
+          else
+            seg_fillword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
+        end;
+      NotPut:
+        begin
+          if UseNoSelector then
+            FillWord(Pointer(LFBPointer+offs+LinearPageOfs)^,HLength,Word(not Word(CurrentColor)))
+          else
+            seg_fillword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(not Word(CurrentColor)));
+        end;
+    end;
+  end;
 
 
  {************************************************************************}
  {************************************************************************}
  {*                     4-bit pixels VESA mode routines                  *}
  {*                     4-bit pixels VESA mode routines                  *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA16(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA16(x, y : smallint; color : word);
     var
     var
      offs : longint;
      offs : longint;
      dummy : byte;
      dummy : byte;
@@ -1815,7 +1812,7 @@ end;
   end;
   end;
 
 
 
 
- Function GetPixVESA16(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc}
+ Function GetPixVESA16(X,Y: smallint):word;
  Var dummy: Word;
  Var dummy: Word;
      offset: longint;
      offset: longint;
      shift: byte;
      shift: byte;
@@ -1837,7 +1834,7 @@ end;
   end;
   end;
 
 
 
 
-  procedure DirectPutPixVESA16(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA16(x, y : smallint);
     var
     var
      offs : longint;
      offs : longint;
      dummy : byte;
      dummy : byte;
@@ -1882,7 +1879,7 @@ end;
   end;
   end;
 
 
 
 
-  procedure HLineVESA16(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure HLineVESA16(x,x2,y: smallint);
   var
   var
       xtmp: smallint;
       xtmp: smallint;
       ScrOfs, BankRest: longint;
       ScrOfs, BankRest: longint;
@@ -1990,7 +1987,6 @@ end;
 
 
 
 
 {$IFDEF DPMI}
 {$IFDEF DPMI}
-{$ifdef fpc}
    Procedure SetVESARGBAllPalette(const Palette:PaletteType);
    Procedure SetVESARGBAllPalette(const Palette:PaletteType);
     var
     var
      pal: array[0..255] of palrec;
      pal: array[0..255] of palrec;
@@ -2056,7 +2052,6 @@ end;
         end;
         end;
       setallpalettedefault(palette);
       setallpalettedefault(palette);
     end;
     end;
-{$endif fpc}
 
 
    Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
    Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
       BlueValue : smallint);
       BlueValue : smallint);
@@ -2064,9 +2059,6 @@ end;
      pal: palrec;
      pal: palrec;
      regs: TDPMIRegisters;
      regs: TDPMIRegisters;
      Ptr: longint;
      Ptr: longint;
-{$ifndef fpc}
-     PalPtr : ^PalRec;
-{$endif fpc}
      RealSeg: word;
      RealSeg: word;
      FunctionNr : byte;   { use blankbit or normal RAMDAC programming? }
      FunctionNr : byte;   { use blankbit or normal RAMDAC programming? }
     begin
     begin
@@ -2093,25 +2085,13 @@ end;
               FunctionNr := $00;
               FunctionNr := $00;
 
 
             { Alllocate real mode buffer }
             { Alllocate real mode buffer }
-{$ifndef fpc}
-            Ptr:=GlobalDosAlloc(sizeof(palrec));
-            { get the selector values }
-            PalPtr := pointer(Ptr shl 16);
-            if not assigned(PalPtr) then
-               RunError(203);
-{$else fpc}
             Ptr:=Global_Dos_Alloc(sizeof(palrec));
             Ptr:=Global_Dos_Alloc(sizeof(palrec));
-{$endif fpc}
             {get the segment value}
             {get the segment value}
             RealSeg := word(Ptr shr 16);
             RealSeg := word(Ptr shr 16);
             { setup interrupt registers }
             { setup interrupt registers }
             FillChar(regs, sizeof(regs), #0);
             FillChar(regs, sizeof(regs), #0);
             { copy palette values to real mode buffer }
             { copy palette values to real mode buffer }
-{$ifndef fpc}
-            move(pal, palptr^, sizeof(pal));
-{$else fpc}
             DosMemPut(RealSeg,0,pal,sizeof(pal));
             DosMemPut(RealSeg,0,pal,sizeof(pal));
-{$endif fpc}
             regs.eax := $4F09;
             regs.eax := $4F09;
             regs.ebx := FunctionNr;
             regs.ebx := FunctionNr;
             regs.ecx := $01;
             regs.ecx := $01;
@@ -2121,12 +2101,8 @@ end;
             RealIntr($10, regs);
             RealIntr($10, regs);
 
 
             { free real mode memory  }
             { free real mode memory  }
-{$ifndef fpc}
-            GlobalDosFree(word(Ptr and $ffff));
-{$else fpc}
             If not Global_Dos_Free(word(Ptr and $ffff)) then
             If not Global_Dos_Free(word(Ptr and $ffff)) then
               RunError(216);
               RunError(216);
-{$endif fpc}
 
 
             if word(regs.eax) <> $004F then
             if word(regs.eax) <> $004F then
               begin
               begin
@@ -2149,9 +2125,6 @@ end;
       RedValue, GreenValue, BlueValue : smallint);
       RedValue, GreenValue, BlueValue : smallint);
    var
    var
     pal: PalRec;
     pal: PalRec;
-{$ifndef fpc}
-    palptr : ^PalRec;
-{$endif fpc}
     regs : TDPMIRegisters;
     regs : TDPMIRegisters;
     RealSeg: word;
     RealSeg: word;
     ptr: longint;
     ptr: longint;
@@ -2168,15 +2141,7 @@ end;
         if VESAInfo.Version >= $0200 then
         if VESAInfo.Version >= $0200 then
           Begin
           Begin
             { Alllocate real mode buffer }
             { Alllocate real mode buffer }
-{$ifndef fpc}
-            Ptr:=GlobalDosAlloc(sizeof(palrec));
-            { get the selector value }
-            PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
-            if not assigned(PalPtr) then
-               RunError(203);
-{$else fpc}
             Ptr:=Global_Dos_Alloc(sizeof(palrec));
             Ptr:=Global_Dos_Alloc(sizeof(palrec));
-{$endif fpc}
             { get the segment value }
             { get the segment value }
             RealSeg := word(Ptr shr 16);
             RealSeg := word(Ptr shr 16);
             { setup interrupt registers }
             { setup interrupt registers }
@@ -2191,18 +2156,10 @@ end;
             RealIntr($10, regs);
             RealIntr($10, regs);
 
 
            { copy to protected mode buffer ... }
            { copy to protected mode buffer ... }
-{$ifndef fpc}
-           Move(PalPtr^, Pal, sizeof(pal));
-{$else fpc}
            DosMemGet(RealSeg,0,Pal,sizeof(pal));
            DosMemGet(RealSeg,0,Pal,sizeof(pal));
-{$endif fpc}
            { free real mode memory  }
            { free real mode memory  }
-{$ifndef fpc}
-           GlobalDosFree(word(Ptr and $ffff));
-{$else fpc}
            If not Global_Dos_Free(word(Ptr and $ffff)) then
            If not Global_Dos_Free(word(Ptr and $ffff)) then
              RunError(216);
              RunError(216);
-{$endif fpc}
 
 
             if word(regs.eax) <> $004F then
             if word(regs.eax) <> $004F then
               begin
               begin
@@ -2383,7 +2340,6 @@ Const
      else
      else
        BytesPerLine := VESAModeInfo.BytesPerScanLine;
        BytesPerLine := VESAModeInfo.BytesPerScanLine;
 
 
-{$ifdef FPC}
      case mode of
      case mode of
        m320x200x32k,
        m320x200x32k,
        m320x200x64k,
        m320x200x64k,
@@ -2399,8 +2355,8 @@ Const
            DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
            DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
            PutPixel:=@PutPixVESA32kor64kLinear;
            PutPixel:=@PutPixVESA32kor64kLinear;
            GetPixel:=@GetPixVESA32kor64kLinear;
            GetPixel:=@GetPixVESA32kor64kLinear;
+           HLine:=@HLineVESA32kOr64kLinear;
            { linear mode for lines not yet implemented PM }
            { linear mode for lines not yet implemented PM }
-           HLine:=@HLineDefault;
            VLine:=@VLineDefault;
            VLine:=@VLineDefault;
            GetScanLine := @GetScanLineDefault;
            GetScanLine := @GetScanLineDefault;
            PatternLine := @PatternLineDefault;
            PatternLine := @PatternLineDefault;
@@ -2474,7 +2430,6 @@ Const
          inc(WinShift);
          inc(WinShift);
          Temp:=Temp shr 1;
          Temp:=Temp shr 1;
        end; }
        end; }
-{$endif FPC}
    end;
    end;
 
 
   procedure SetupWindows(var ModeInfo: TVESAModeInfo);
   procedure SetupWindows(var ModeInfo: TVESAModeInfo);
@@ -2669,19 +2624,15 @@ Const
    asm
    asm
     mov ax,4F02h
     mov ax,4F02h
     mov bx,mode
     mov bx,mode
-{$ifdef fpc}
     push ebp
     push ebp
     push esi
     push esi
     push edi
     push edi
     push ebx
     push ebx
-{$endif fpc}
     int 10h
     int 10h
-{$ifdef fpc}
     pop ebx
     pop ebx
     pop edi
     pop edi
     pop esi
     pop esi
     pop ebp
     pop ebp
-{$endif fpc}
     sub ax,004Fh
     sub ax,004Fh
     cmp ax,1
     cmp ax,1
     sbb al,al
     sbb al,al
@@ -2762,21 +2713,21 @@ Const
 
 
 {$ENDIF}
 {$ENDIF}
 
 
- procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x64k;
   begin
   begin
     SetVesaMode(m1280x1024x64k);
     SetVesaMode(m1280x1024x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x32k;
   begin
   begin
     SetVESAMode(m1280x1024x32k);
     SetVESAMode(m1280x1024x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x256;
   begin
   begin
     SetVESAMode(m1280x1024x256);
     SetVESAMode(m1280x1024x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
@@ -2784,105 +2735,105 @@ Const
   end;
   end;
 
 
 
 
- procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x16;
   begin
   begin
     SetVESAMode(m1280x1024x16);
     SetVESAMode(m1280x1024x16);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x64k;
   begin
   begin
     SetVESAMode(m1024x768x64k);
     SetVESAMode(m1024x768x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x32k;
   begin
   begin
     SetVESAMode(m1024x768x32k);
     SetVESAMode(m1024x768x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x256;
   begin
   begin
     SetVESAMode(m1024x768x256);
     SetVESAMode(m1024x768x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x16;
   begin
   begin
     SetVESAMode(m1024x768x16);
     SetVESAMode(m1024x768x16);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x64k;
   begin
   begin
     SetVESAMode(m800x600x64k);
     SetVESAMode(m800x600x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x32k;
   begin
   begin
     SetVESAMode(m800x600x32k);
     SetVESAMode(m800x600x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x256;
   begin
   begin
     SetVESAMode(m800x600x256);
     SetVESAMode(m800x600x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x16;
   begin
   begin
     SetVesaMode(m800x600x16);
     SetVesaMode(m800x600x16);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x480x64k;
   begin
   begin
     SetVESAMode(m640x480x64k);
     SetVESAMode(m640x480x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x480x32k;
   begin
   begin
     SetVESAMode(m640x480x32k);
     SetVESAMode(m640x480x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x480x256;
   begin
   begin
     SetVESAMode(m640x480x256);
     SetVESAMode(m640x480x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x400x256;
   begin
   begin
     SetVESAMode(m640x400x256);
     SetVESAMode(m640x400x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init320x200x64k;
   begin
   begin
     SetVESAMode(m320x200x64k);
     SetVESAMode(m320x200x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init320x200x32k;
   begin
   begin
     SetVESAMode(m320x200x32k);
     SetVESAMode(m320x200x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
@@ -2892,7 +2843,7 @@ Const
 
 
 {$IFDEF DPMI}
 {$IFDEF DPMI}
 
 
- Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
+ Procedure SaveStateVESA;
  var
  var
   PtrLong: longint;
   PtrLong: longint;
   regs: TDPMIRegisters;
   regs: TDPMIRegisters;
@@ -2905,19 +2856,15 @@ Const
     { Get the video mode }
     { Get the video mode }
     asm
     asm
       mov  ah,0fh
       mov  ah,0fh
-{$ifdef fpc}
       push ebp
       push ebp
       push esi
       push esi
       push edi
       push edi
       push ebx
       push ebx
-{$endif fpc}
       int  10h
       int  10h
-{$ifdef fpc}
       pop ebx
       pop ebx
       pop edi
       pop edi
       pop esi
       pop esi
       pop ebp
       pop ebp
-{$endif fpc}
       mov  [VideoMode], al
       mov  [VideoMode], al
     end ['EAX'];
     end ['EAX'];
     { saving/restoring video state screws up Windows (JM) }
     { saving/restoring video state screws up Windows (JM) }
@@ -2939,22 +2886,10 @@ Const
 {$ifdef logging}
 {$ifdef logging}
         LogLn('allocating VESA save buffer of '+strf(64*StateSize));
         LogLn('allocating VESA save buffer of '+strf(64*StateSize));
 {$endif logging}
 {$endif logging}
-{$ifndef fpc}
-        PtrLong:=GlobalDosAlloc(64*StateSize);  { values returned in 64-byte blocks }
-{$else fpc}
         PtrLong:=Global_Dos_Alloc(64*StateSize);  { values returned in 64-byte blocks }
         PtrLong:=Global_Dos_Alloc(64*StateSize);  { values returned in 64-byte blocks }
-{$endif fpc}
         if PtrLong = 0 then
         if PtrLong = 0 then
            RunError(203);
            RunError(203);
         SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
         SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
-{$ifndef fpc}
-        { In FPC mode, we can't do anything with this (no far pointers)  }
-        { However, we still need to keep it to be able to free the       }
-        { memory afterwards. Since this data is not accessed in PM code, }
-        { there's no need to save it in a seperate buffer (JM)           }
-        if not assigned(SavePtr) then
-           RunError(203);
-{$endif fpc}
         RealStateSeg := word(PtrLong shr 16);
         RealStateSeg := word(PtrLong shr 16);
 
 
         FillChar(regs, sizeof(regs), #0);
         FillChar(regs, sizeof(regs), #0);
@@ -2977,7 +2912,7 @@ Const
       end;
       end;
   end;
   end;
 
 
- procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
+ procedure RestoreStateVESA;
   var
   var
    regs:TDPMIRegisters;
    regs:TDPMIRegisters;
   begin
   begin
@@ -2985,28 +2920,20 @@ Const
      asm
      asm
       mov  ah,00
       mov  ah,00
       mov  al,[VideoMode]
       mov  al,[VideoMode]
-{$ifdef fpc}
       push ebp
       push ebp
       push esi
       push esi
       push edi
       push edi
       push ebx
       push ebx
-{$endif fpc}
       int  10h
       int  10h
-{$ifdef fpc}
       pop ebx
       pop ebx
       pop edi
       pop edi
       pop esi
       pop esi
       pop ebp
       pop ebp
-{$endif fpc}
      end ['EAX'];
      end ['EAX'];
      { then restore all state information }
      { then restore all state information }
-{$ifndef fpc}
-     if assigned(SavePtr) and (SaveSupported=TRUE) then
-{$else fpc}
      { No far pointer support, so it's possible that that assigned(SavePtr) }
      { No far pointer support, so it's possible that that assigned(SavePtr) }
      { would return false under FPC. Just check if it's different from nil. }
      { would return false under FPC. Just check if it's different from nil. }
      if (SavePtr <> nil) and (SaveSupported=TRUE) then
      if (SavePtr <> nil) and (SaveSupported=TRUE) then
-{$endif fpc}
        begin
        begin
         FillChar(regs, sizeof(regs), #0);
         FillChar(regs, sizeof(regs), #0);
         { restore state, according to Ralph Brown Interrupt list }
         { restore state, according to Ralph Brown Interrupt list }
@@ -3017,11 +2944,7 @@ Const
          regs.es := RealStateSeg;
          regs.es := RealStateSeg;
          regs.ebx := 0;
          regs.ebx := 0;
          RealIntr($10,regs);
          RealIntr($10,regs);
-{$ifndef fpc}
-         if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
-{$else fpc}
          if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
          if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
-{$endif fpc}
           RunError(216);
           RunError(216);
          SavePtr := nil;
          SavePtr := nil;
        end;
        end;
@@ -3123,7 +3046,7 @@ Const
   { between VBE versions , we will use the old method where }
   { between VBE versions , we will use the old method where }
   { the new pixel offset is used to display different pages }
   { the new pixel offset is used to display different pages }
   {******************************************************** }
   {******************************************************** }
- procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+ procedure SetVisualVESA(page: word);
   var
   var
    newStartVisible : word;
    newStartVisible : word;
   begin
   begin
@@ -3143,23 +3066,19 @@ Const
       mov bx, 0000h   { set display start }
       mov bx, 0000h   { set display start }
       mov cx, 0000h   { pixel zero !      }
       mov cx, 0000h   { pixel zero !      }
       mov dx, [NewStartVisible]  { new scanline }
       mov dx, [NewStartVisible]  { new scanline }
-{$ifdef fpc}
       push    ebp
       push    ebp
       push    esi
       push    esi
       push    edi
       push    edi
       push    ebx
       push    ebx
-{$endif}
       int     10h
       int     10h
-{$ifdef fpc}
       pop     ebx
       pop     ebx
       pop     edi
       pop     edi
       pop     esi
       pop     esi
       pop     ebp
       pop     ebp
-{$endif}
     end ['EDX','ECX','EBX','EAX'];
     end ['EDX','ECX','EBX','EAX'];
   end;
   end;
 
 
- procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+ procedure SetActiveVESA(page: word);
   begin
   begin
     { video offset is in pixels under VESA VBE! }
     { video offset is in pixels under VESA VBE! }
     { This value is reset after a mode set to page ZERO = YOffset = 0 ) }
     { This value is reset after a mode set to page ZERO = YOffset = 0 ) }

+ 104 - 33
packages/graph/src/inc/fills.inc

@@ -297,6 +297,11 @@ var
      End;
      End;
 
 
   s1, s2, s3 : PWordArray;                { Three buffers for scanlines                 }
   s1, s2, s3 : PWordArray;                { Three buffers for scanlines                 }
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  sl1 : PLongWordArray absolute s1;
+  sl2 : PLongWordArray absolute s2;
+  sl3 : PLongWordArray absolute s3;
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
 
 
 
 
   Procedure PushPoint (x, y : smallint);
   Procedure PushPoint (x, y : smallint);
@@ -412,7 +417,7 @@ var
   end;
   end;
 
 
 
 
-  Procedure FloodFill (x, y : smallint; Border: word);
+  Procedure FloodFill (x, y : smallint; Border: ColorType);
   {********************************************************}
   {********************************************************}
   { Procedure FloodFill()                                  }
   { Procedure FloodFill()                                  }
   {--------------------------------------------------------}
   {--------------------------------------------------------}
@@ -426,7 +431,7 @@ var
    Beginx : smallint;
    Beginx : smallint;
    d, e : Byte;
    d, e : Byte;
    Cont : Boolean;
    Cont : Boolean;
-   BackupColor : Word;
+   BackupColor : ColorType;
    x1, x2, prevy: smallint;
    x1, x2, prevy: smallint;
   Begin
   Begin
     GetMem(DrawnList,sizeof(PFloodLine)*((ViewHeight div YResDiv) + 1));
     GetMem(DrawnList,sizeof(PFloodLine)*((ViewHeight div YResDiv) + 1));
@@ -437,9 +442,20 @@ var
     BackupColor := CurrentColor;
     BackupColor := CurrentColor;
     CurrentColor := FillSettings.Color;
     CurrentColor := FillSettings.Color;
     { MaxX is based on zero index }
     { MaxX is based on zero index }
-    GetMem (s1,(ViewWidth+1)*2);  { A pixel color represents a word }
-    GetMem (s2,(ViewWidth+1)*2);  { A pixel color represents a word }
-    GetMem (s3,(ViewWidth+1)*2);  { A pixel color represents a word }
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    if MaxColor > 65536 then
+    begin
+      GetMem (s1,(ViewWidth+1)*4);  { A pixel color represents a word }
+      GetMem (s2,(ViewWidth+1)*4);  { A pixel color represents a word }
+      GetMem (s3,(ViewWidth+1)*4);  { A pixel color represents a word }
+    end
+    else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    begin
+      GetMem (s1,(ViewWidth+1)*2);  { A pixel color represents a word }
+      GetMem (s2,(ViewWidth+1)*2);  { A pixel color represents a word }
+      GetMem (s3,(ViewWidth+1)*2);  { A pixel color represents a word }
+    end;
     if (not assigned(s1)) or (not assigned(s2)) or (not assigned(s3)) then
     if (not assigned(s1)) or (not assigned(s2)) or (not assigned(s3)) then
       begin
       begin
         _GraphResult := grNoFloodMem;
         _GraphResult := grNoFloodMem;
@@ -485,38 +501,82 @@ var
          end;
          end;
        prevy := y;
        prevy := y;
        { check the current scan line }
        { check the current scan line }
-       While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+       if MaxColor > 65536 then
+       begin
+         While (sl1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
+       end
+       else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+       begin
+         While (s1^[x]<>Border) And (x<=ViewWidth) Do Inc (x);
+       end;
        d:=0;
        d:=0;
        e:=0;
        e:=0;
        dec(x);
        dec(x);
        Beginx:=x;
        Beginx:=x;
-       REPEAT
-         { check the above line }
-         If y<ViewHeight then
-           Begin
-              Cont:=(s3^[x]<>Border) and (not AlreadyDrawn(x,y+1));
-              If (e=0) And Cont then
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+       if MaxColor > 65536 then
+       begin
+         REPEAT
+           { check the above line }
+           If y<ViewHeight then
+             Begin
+                Cont:=(sl3^[x]<>Border) and (not AlreadyDrawn(x,y+1));
+                If (e=0) And Cont then
+                  Begin
+                    PushPoint (x,y+1);
+                    e:=1;
+                  End
+                Else
+                  If (e=1) And Not Cont then e:=0;
+             End;
+          { check the line below }
+          If (y>0) then
+            Begin
+              Cont:=(sl2^[x]<>Border) and (not AlreadyDrawn(x,y-1));
+              If (d=0) And Cont then
                 Begin
                 Begin
-                  PushPoint (x,y+1);
-                  e:=1;
+                  PushPoint (x,y-1);
+                  d:=1;
                 End
                 End
               Else
               Else
-                If (e=1) And Not Cont then e:=0;
-           End;
-        { check the line below }
-        If (y>0) then
-          Begin
-            Cont:=(s2^[x]<>Border) and (not AlreadyDrawn(x,y-1));
-            If (d=0) And Cont then
-              Begin
-                PushPoint (x,y-1);
-                d:=1;
-              End
-            Else
-              If (d=1) And Not Cont then d:=0;
-          End;
-        Dec (x);
-       Until (x<0) Or (s1^[x]=Border);
+                If (d=1) And Not Cont then d:=0;
+            End;
+          Dec (x);
+         Until (x<0) Or (sl1^[x]=Border);
+       end
+       else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+       begin
+         REPEAT
+           { check the above line }
+           If y<ViewHeight then
+             Begin
+                Cont:=(s3^[x]<>Border) and (not AlreadyDrawn(x,y+1));
+                If (e=0) And Cont then
+                  Begin
+                    PushPoint (x,y+1);
+                    e:=1;
+                  End
+                Else
+                  If (e=1) And Not Cont then e:=0;
+             End;
+          { check the line below }
+          If (y>0) then
+            Begin
+              Cont:=(s2^[x]<>Border) and (not AlreadyDrawn(x,y-1));
+              If (d=0) And Cont then
+                Begin
+                  PushPoint (x,y-1);
+                  d:=1;
+                End
+              Else
+                If (d=1) And Not Cont then d:=0;
+            End;
+          Dec (x);
+         Until (x<0) Or (s1^[x]=Border);
+       end;
        { swap the values }
        { swap the values }
        x1:=x+1;
        x1:=x+1;
        x2:=BeginX;
        x2:=BeginX;
@@ -531,9 +591,20 @@ var
        PatternLine (x1,x2,y);
        PatternLine (x1,x2,y);
      End; { end while }
      End; { end while }
 
 
-    System.FreeMem (s1,(ViewWidth+1)*2);
-    System.FreeMem (s2,(ViewWidth+1)*2);
-    System.FreeMem (s3,(ViewWidth+1)*2);
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    if MaxColor > 65536 then
+    begin
+      System.FreeMem (s1,(ViewWidth+1)*4);
+      System.FreeMem (s2,(ViewWidth+1)*4);
+      System.FreeMem (s3,(ViewWidth+1)*4);
+    end
+    else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    begin
+      System.FreeMem (s1,(ViewWidth+1)*2);
+      System.FreeMem (s2,(ViewWidth+1)*2);
+      System.FreeMem (s3,(ViewWidth+1)*2);
+    end;
     CleanUpDrawnList;
     CleanUpDrawnList;
     System.FreeMem(DrawnList,sizeof(PFloodLine)*((ViewHeight div YResDiv) + 1));
     System.FreeMem(DrawnList,sizeof(PFloodLine)*((ViewHeight div YResDiv) + 1));
     CurrentColor := BackUpColor;
     CurrentColor := BackUpColor;

+ 117 - 41
packages/graph/src/inc/graph.inc

@@ -52,6 +52,10 @@ type
 
 
   WordArray = Array [0..StdbufferSize] Of word;
   WordArray = Array [0..StdbufferSize] Of word;
   PWordArray = ^WordArray;
   PWordArray = ^WordArray;
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  LongWordArray = Array [0..StdbufferSize] Of LongWord;
+  PLongWordArray = ^LongWordArray;
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
 
 
 
 
 const
 const
@@ -78,8 +82,8 @@ const
 
 
 
 
 var
 var
-  CurrentColor:     Word;
-  CurrentBkColor: Word;
+  CurrentColor:     ColorType;
+  CurrentBkColor: ColorType;
   CurrentX : smallint;   { viewport relative }
   CurrentX : smallint;   { viewport relative }
   CurrentY : smallint;   { viewport relative }
   CurrentY : smallint;   { viewport relative }
 
 
@@ -237,7 +241,7 @@ var
       Flag           : Boolean; { determines pixel direction in thick lines }
       Flag           : Boolean; { determines pixel direction in thick lines }
       NumPixels      : smallint;
       NumPixels      : smallint;
       PixelCount     : smallint;
       PixelCount     : smallint;
-      OldCurrentColor: Word;
+      OldCurrentColor: ColorType;
       swtmp          : smallint;
       swtmp          : smallint;
       TmpNumPixels   : smallint;
       TmpNumPixels   : smallint;
  begin
  begin
@@ -673,7 +677,8 @@ var
     TempTerm: graph_float;
     TempTerm: graph_float;
     xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
     xtemp, ytemp, xp, yp, xm, ym, xnext, ynext,
       plxpyp, plxmyp, plxpym, plxmym: smallint;
       plxpyp, plxmyp, plxpym, plxmym: smallint;
-    BackupColor, TmpAngle, OldLineWidth: word;
+    BackupColor: ColorType;
+    TmpAngle, OldLineWidth: word;
     CounterClockwise : Boolean;
     CounterClockwise : Boolean;
   Begin
   Begin
    If LineInfo.ThickNess = ThickWidth Then
    If LineInfo.ThickNess = ThickWidth Then
@@ -817,7 +822,7 @@ var
     j           : smallint;
     j           : smallint;
     TmpFillPattern : byte;
     TmpFillPattern : byte;
     OldWriteMode : word;
     OldWriteMode : word;
-    OldCurrentColor : word;
+    OldCurrentColor : ColorType;
    begin
    begin
      { convert to global coordinates ... }
      { convert to global coordinates ... }
      x1 := x1 + StartXViewPort;
      x1 := x1 + StartXViewPort;
@@ -991,7 +996,8 @@ var
 Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
 Procedure ClearViewPortDefault; {$ifndef fpc}far;{$endif fpc}
 var
 var
  j: smallint;
  j: smallint;
- OldWriteMode, OldCurColor: word;
+ OldWriteMode: word;
+ OldCurColor: ColorType;
  LineSets : LineSettingsType;
  LineSets : LineSettingsType;
 Begin
 Begin
   { CP is always RELATIVE coordinates }
   { CP is always RELATIVE coordinates }
@@ -1113,26 +1119,48 @@ end;
   Var
   Var
     x : smallint;
     x : smallint;
   Begin
   Begin
-     For x:=X1 to X2 Do
-       WordArray(Data)[x-x1]:=GetPixel(x, y);
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    if MaxColor > 65536 then
+    begin
+      For x:=X1 to X2 Do
+        LongWordArray(Data)[x-x1]:=GetPixel(x, y);
+    end
+    else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    begin
+      For x:=X1 to X2 Do
+        WordArray(Data)[x-x1]:=GetPixel(x, y);
+    end;
   End;
   End;
 
 
 
 
 
 
 Function DefaultImageSize(X1,Y1,X2,Y2: smallint): longint; {$ifndef fpc}far;{$endif fpc}
 Function DefaultImageSize(X1,Y1,X2,Y2: smallint): longint; {$ifndef fpc}far;{$endif fpc}
 Begin
 Begin
-  { each pixel uses two bytes, to enable modes with colors up to 64K }
-  { to work.                                                         }
-  DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*2);
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  if MaxColor > 65536 then
+  begin
+    DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*4);
+  end
+  else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  begin
+    { each pixel uses two bytes, to enable modes with colors up to 64K }
+    { to work.                                                         }
+    DefaultImageSize := 12 + (((X2-X1+1)*(Y2-Y1+1))*2);
+  end;
 end;
 end;
 
 
 Procedure DefaultPutImage(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
 Procedure DefaultPutImage(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
 type
 type
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  ptl = array[0..{$ifdef cpu16}8191{$else}$fffffff{$endif}] of longword;
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
   pt = array[0..{$ifdef cpu16}16382{$else}$fffffff{$endif}] of word;
   pt = array[0..{$ifdef cpu16}16382{$else}$fffffff{$endif}] of word;
   ptw = array[0..2] of longint;
   ptw = array[0..2] of longint;
 var
 var
   k: longint;
   k: longint;
-  oldCurrentColor: word;
+  oldCurrentColor: ColorType;
   oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
   oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
 Begin
 Begin
 {$ifdef logging}
 {$ifdef logging}
@@ -1148,7 +1176,12 @@ Begin
 
 
   deltaX := 0;
   deltaX := 0;
   deltaX1 := 0;
   deltaX1 := 0;
-  k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  if MaxColor > 65536 then
+    k := 3 * sizeOf(Longint) div sizeOf(LongWord) { Three reserved longs at start of bitmap }
+  else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+    k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
  { check which part of the image is in the viewport }
  { check which part of the image is in the viewport }
   if clipPixels then
   if clipPixels then
     begin
     begin
@@ -1177,39 +1210,75 @@ Begin
   oldCurrentColor := currentColor;
   oldCurrentColor := currentColor;
   oldCurrentWriteMode := currentWriteMode;
   oldCurrentWriteMode := currentWriteMode;
   currentWriteMode := bitBlt;
   currentWriteMode := bitBlt;
-  for j:=Y to Y1 do
-   Begin
-     inc(k,deltaX);
-     for i:=X to X1 do
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  if MaxColor > 65536 then
+  begin
+    for j:=Y to Y1 do
+    Begin
+      inc(k,deltaX);
+      for i:=X to X1 do
+      begin
+        currentColor := ptl(bitmap)[k];
+        directPutPixel(i,j);
+        inc(k);
+      end;
+      inc(k,deltaX1);
+    end;
+  end
+  else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  begin
+    for j:=Y to Y1 do
+    Begin
+      inc(k,deltaX);
+      for i:=X to X1 do
       begin
       begin
         currentColor := pt(bitmap)[k];
         currentColor := pt(bitmap)[k];
         directPutPixel(i,j);
         directPutPixel(i,j);
         inc(k);
         inc(k);
-     end;
-     inc(k,deltaX1);
-   end;
+      end;
+      inc(k,deltaX1);
+    end;
+  end;
   currentWriteMode := oldCurrentWriteMode;
   currentWriteMode := oldCurrentWriteMode;
   currentColor := oldCurrentColor;
   currentColor := oldCurrentColor;
 end;
 end;
 
 
 Procedure DefaultGetImage(X1,Y1,X2,Y2: smallint; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
 Procedure DefaultGetImage(X1,Y1,X2,Y2: smallint; Var Bitmap); {$ifndef fpc}far;{$endif fpc}
 type
 type
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  ptl = array[0..{$ifdef cpu16}8191{$else}$fffffff{$endif}] of longword;
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
   pt = array[0..{$ifdef cpu16}16382{$else}$fffffff{$endif}] of word;
   pt = array[0..{$ifdef cpu16}16382{$else}$fffffff{$endif}] of word;
   ptw = array[0..2] of longint;
   ptw = array[0..2] of longint;
 var
 var
   i,j: smallint;
   i,j: smallint;
   k: longint;
   k: longint;
 Begin
 Begin
-  k:= 3 * Sizeof(longint) div sizeof(word); { Three reserved longs at start of bitmap }
   i := x2 - x1 + 1;
   i := x2 - x1 + 1;
-  for j:=Y1 to Y2 do
-   Begin
-     GetScanLine(x1,x2,j,pt(Bitmap)[k]);
-     inc(k,i);
-   end;
-   ptw(Bitmap)[0] := X2-X1+1;   { First longint  is width  }
-   ptw(Bitmap)[1] := Y2-Y1+1;   { Second longint is height }
-   ptw(bitmap)[2] := 0;       { Third longint is reserved}
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  if MaxColor > 65536 then
+  begin
+    k:= 3 * Sizeof(longint) div sizeof(longword); { Three reserved longs at start of bitmap }
+    for j:=Y1 to Y2 do
+    Begin
+      GetScanLine(x1,x2,j,ptl(Bitmap)[k]);
+      inc(k,i);
+    end;
+  end
+  else
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+  begin
+    k:= 3 * Sizeof(longint) div sizeof(word); { Three reserved longs at start of bitmap }
+    for j:=Y1 to Y2 do
+    Begin
+      GetScanLine(x1,x2,j,pt(Bitmap)[k]);
+      inc(k,i);
+    end;
+  end;
+  ptw(Bitmap)[0] := X2-X1+1;   { First longint  is width  }
+  ptw(Bitmap)[1] := Y2-Y1+1;   { Second longint is height }
+  ptw(bitmap)[2] := 0;       { Third longint is reserved}
 end;
 end;
 
 
 
 
@@ -1248,12 +1317,12 @@ end;
      NotInGraphicsMode;
      NotInGraphicsMode;
    end;
    end;
 
 
-  function GetPixelDefault(X,Y: smallint): word;
+  function GetPixelDefault(X,Y: smallint): ColorType;
    begin
    begin
      NotInGraphicsMode;
      NotInGraphicsMode;
    end;
    end;
 
 
-  procedure PutPixelDefault(X,Y: smallint; Color: Word);
+  procedure PutPixelDefault(X,Y: smallint; Color: ColorType);
    begin
    begin
      NotInGraphicsMode;
      NotInGraphicsMode;
    end;
    end;
@@ -1272,8 +1341,8 @@ end;
 
 
   procedure OutTextXYDefault(x,y : smallint;const TextString : string);forward;
   procedure OutTextXYDefault(x,y : smallint;const TextString : string);forward;
   procedure CircleDefault(X, Y: smallint; Radius:Word);forward;
   procedure CircleDefault(X, Y: smallint; Radius:Word);forward;
-  procedure SetBkColorDefault(ColorNum: Word);forward;
-  function GetBkColorDefault: Word;forward;
+  procedure SetBkColorDefault(ColorNum: ColorType);forward;
+  function GetBkColorDefault: ColorType;forward;
 
 
 {$i palette.inc}
 {$i palette.inc}
 
 
@@ -1541,7 +1610,7 @@ end;
 
 
 
 
 
 
-   procedure SetFillStyle(Pattern : word; Color: word);
+   procedure SetFillStyle(Pattern : word; Color: ColorType);
 
 
    begin
    begin
      { on invalid input, the current fill setting will be }
      { on invalid input, the current fill setting will be }
@@ -1559,7 +1628,7 @@ end;
    end;
    end;
 
 
 
 
-  procedure SetFillPattern(Pattern: FillPatternType; Color: word);
+  procedure SetFillPattern(Pattern: FillPatternType; Color: ColorType);
   {********************************************************}
   {********************************************************}
   { Changes the Current FillPattern to a user defined      }
   { Changes the Current FillPattern to a user defined      }
   { pattern and changes also the current fill color.       }
   { pattern and changes also the current fill color.       }
@@ -1595,7 +1664,7 @@ end;
   {     - No contour is drawn for the lines                }
   {     - No contour is drawn for the lines                }
   {********************************************************}
   {********************************************************}
   var y               : smallint;
   var y               : smallint;
-      origcolor       : longint;
+      origcolor       : ColorType;
       origlinesettings: Linesettingstype;
       origlinesettings: Linesettingstype;
       origwritemode   : smallint;
       origwritemode   : smallint;
    begin
    begin
@@ -1706,27 +1775,27 @@ end;
 {--------------------------------------------------------------------------}
 {--------------------------------------------------------------------------}
 
 
 
 
-  procedure SetColor(Color: Word);
+  procedure SetColor(Color: ColorType);
 
 
    Begin
    Begin
      CurrentColor := Color;
      CurrentColor := Color;
    end;
    end;
 
 
 
 
-  function GetColor: Word;
+  function GetColor: ColorType;
 
 
    Begin
    Begin
      GetColor := CurrentColor;
      GetColor := CurrentColor;
    end;
    end;
 
 
-  function GetBkColorDefault: Word;
+  function GetBkColorDefault: ColorType;
 
 
    Begin
    Begin
      GetBkColorDefault := CurrentBkColor;
      GetBkColorDefault := CurrentBkColor;
    end;
    end;
 
 
 
 
-  procedure SetBkColorDefault(ColorNum: Word);
+  procedure SetBkColorDefault(ColorNum: ColorType);
   { Background color means background screen color in this case, and it is  }
   { Background color means background screen color in this case, and it is  }
   { INDEPENDANT of the viewport settings, so we must clear the whole screen }
   { INDEPENDANT of the viewport settings, so we must clear the whole screen }
   { with the color.                                                         }
   { with the color.                                                         }
@@ -1752,7 +1821,7 @@ end;
    end;
    end;
 
 
 
 
-  function GetMaxColor: word;
+  function GetMaxColor: ColorType;
   { Checked against TP VGA driver - CEC }
   { Checked against TP VGA driver - CEC }
 
 
    begin
    begin
@@ -1922,6 +1991,13 @@ end;
    end;
    end;
 
 
 
 
+  procedure SetWriteModeEx(WriteMode : smallint);
+   begin
+     if (WriteMode >= CopyPut) and (WriteMode <= NotPut) then
+       CurrentWriteMode := WriteMode;
+   end;
+
+
   procedure GetFillSettings(var Fillinfo:Fillsettingstype);
   procedure GetFillSettings(var Fillinfo:Fillsettingstype);
    begin
    begin
      Fillinfo:=Fillsettings;
      Fillinfo:=Fillsettings;

+ 18 - 11
packages/graph/src/inc/graphh.inc

@@ -434,6 +434,12 @@ type
 
 
 
 
     type
     type
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
+       ColorType = LongWord;
+{$else FPC_GRAPH_SUPPORTS_TRUECOLOR}
+       ColorType = Word;
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
+
        RGBRec = packed record
        RGBRec = packed record
          Red: smallint;
          Red: smallint;
          Green: smallint;
          Green: smallint;
@@ -461,7 +467,7 @@ type
 
 
        FillSettingsType = record
        FillSettingsType = record
              pattern : word;
              pattern : word;
-             color : word;
+             color : ColorType;
        end;
        end;
 
 
        FillPatternType = array[1..8] of byte;
        FillPatternType = array[1..8] of byte;
@@ -518,8 +524,8 @@ TYPE
        defpixelproc = procedure(X,Y: smallint);
        defpixelproc = procedure(X,Y: smallint);
 
 
        { standard plot and get pixel                                }
        { standard plot and get pixel                                }
-       getpixelproc = function(X,Y: smallint): word;
-       putpixelproc = procedure(X,Y: smallint; Color: Word);
+       getpixelproc = function(X,Y: smallint): ColorType;
+       putpixelproc = procedure(X,Y: smallint; Color: ColorType);
 
 
        { clears the viewport, also used to clear the device         }
        { clears the viewport, also used to clear the device         }
        clrviewproc  = procedure;
        clrviewproc  = procedure;
@@ -589,8 +595,8 @@ TYPE
 
 
        CircleProc = procedure(X, Y: smallint; Radius:Word);
        CircleProc = procedure(X, Y: smallint; Radius:Word);
 
 
-       SetBkColorProc = procedure(ColorNum: Word);
-       GetBkColorProc = function: Word;
+       SetBkColorProc = procedure(ColorNum: ColorType);
+       GetBkColorProc = function: ColorType;
 
 
 
 
 TYPE
 TYPE
@@ -752,6 +758,7 @@ procedure GraphDefaults;
 procedure ClearDevice;
 procedure ClearDevice;
 procedure GetViewSettings(var viewport : ViewPortType);
 procedure GetViewSettings(var viewport : ViewPortType);
 procedure SetWriteMode(WriteMode : smallint);
 procedure SetWriteMode(WriteMode : smallint);
+procedure SetWriteModeEx(WriteMode : smallint);
 procedure GetFillSettings(var Fillinfo:Fillsettingstype);
 procedure GetFillSettings(var Fillinfo:Fillsettingstype);
 procedure GetFillPattern(var FillPattern:FillPatternType);
 procedure GetFillPattern(var FillPattern:FillPatternType);
 procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
 procedure GetLineSettings(var ActiveLineInfo : LineSettingsType);
@@ -759,8 +766,8 @@ procedure InitGraph(var GraphDriver:smallint;var GraphMode:smallint;const PathTo
 procedure DetectGraph(var GraphDriver:smallint;var GraphMode:smallint);
 procedure DetectGraph(var GraphDriver:smallint;var GraphMode:smallint);
 function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
 function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
 function RegisterBGIDriver(driver: pointer): smallint;
 function RegisterBGIDriver(driver: pointer): smallint;
-procedure SetFillStyle(Pattern : word; Color: word);
-procedure SetFillPattern(Pattern: FillPatternType; Color: word);
+procedure SetFillStyle(Pattern : word; Color: ColorType);
+procedure SetFillPattern(Pattern: FillPatternType; Color: ColorType);
 Function GetDriverName: string;
 Function GetDriverName: string;
  procedure MoveRel(Dx, Dy: smallint);
  procedure MoveRel(Dx, Dy: smallint);
  procedure MoveTo(X,Y: smallint);
  procedure MoveTo(X,Y: smallint);
@@ -769,9 +776,9 @@ Function GetDriverName: string;
  function GetDirectVideo: boolean;
  function GetDirectVideo: boolean;
 
 
  { -------------------- Color/Palette ------------------------------- }
  { -------------------- Color/Palette ------------------------------- }
- function  GetColor: Word;
- procedure SetColor(Color: Word);
- function  GetMaxColor: word;
+ function  GetColor: ColorType;
+ procedure SetColor(Color: ColorType);
+ function  GetMaxColor: ColorType;
 
 
  procedure SetPalette(ColorNum: word; Color: shortint);
  procedure SetPalette(ColorNum: word; Color: shortint);
  procedure GetPalette(var Palette: PaletteType);
  procedure GetPalette(var Palette: PaletteType);
@@ -787,7 +794,7 @@ Function GetDriverName: string;
  procedure DrawPoly(NumPoints : word;var polypoints);
  procedure DrawPoly(NumPoints : word;var polypoints);
  procedure LineRel(Dx, Dy: smallint);
  procedure LineRel(Dx, Dy: smallint);
  procedure LineTo(X,Y : smallint);
  procedure LineTo(X,Y : smallint);
- procedure FloodFill(x : smallint; y : smallint; Border: word);
+ procedure FloodFill(x : smallint; y : smallint; Border: ColorType);
 
 
  { -------------------- Circle related routines --------------------- }
  { -------------------- Circle related routines --------------------- }
  procedure GetAspectRatio(var Xasp,Yasp : word);
  procedure GetAspectRatio(var Xasp,Yasp : word);

+ 3 - 1
packages/graph/src/inc/modes.inc

@@ -31,9 +31,11 @@
      4096: driver := D12bit;
      4096: driver := D12bit;
      32768: driver := D15bit;
      32768: driver := D15bit;
      65536: driver := D16bit;
      65536: driver := D16bit;
-{    not yet supported
+{$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
      65536*256: driver := D24bit;
      65536*256: driver := D24bit;
+{    not yet supported
      65536*65536: driver := D32bit;}
      65536*65536: driver := D32bit;}
+{$endif FPC_GRAPH_SUPPORTS_TRUECOLOR}
      else
      else
        begin
        begin
          driver := maxsmallint;
          driver := maxsmallint;

Разлика између датотеке није приказан због своје велике величине
+ 250 - 383
packages/graph/src/msdos/graph.pp


+ 43 - 59
packages/graph/src/msdos/vesa.inc

@@ -217,7 +217,7 @@ end;
  {*                     8-bit pixels VESA mode routines                  *}
  {*                     8-bit pixels VESA mode routines                  *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA256(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA256(x, y : smallint; color : ColorType);
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -239,7 +239,7 @@ end;
        end;
        end;
   end;
   end;
 
 
-  procedure DirectPutPixVESA256(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA256(x, y : smallint);
   var
   var
      offs : longint;
      offs : longint;
      col : byte;
      col : byte;
@@ -272,7 +272,7 @@ end;
      mem[WinWriteSeg : word(offs)] := Col;
      mem[WinWriteSeg : word(offs)] := Col;
   end;
   end;
 
 
-  function GetPixVESA256(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  function GetPixVESA256(x, y : smallint): ColorType;
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -283,7 +283,7 @@ end;
      GetPixVESA256:=mem[WinReadSeg : word(offs)];
      GetPixVESA256:=mem[WinReadSeg : word(offs)];
   end;
   end;
 
 
-  Procedure GetScanLineVESA256(x1, x2, y: smallint; var data); {$ifndef fpc}far;{$endif}
+  Procedure GetScanLineVESA256(x1, x2, y: smallint; var data);
   var offs: Longint;
   var offs: Longint;
       l, amount, bankrest, index, pixels: longint;
       l, amount, bankrest, index, pixels: longint;
       curbank: smallint;
       curbank: smallint;
@@ -372,7 +372,7 @@ end;
     Until amount = 0;
     Until amount = 0;
   end;
   end;
 
 
-  procedure HLineVESA256(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure HLineVESA256(x,x2,y: smallint);
 
 
    var Offs: Longint;
    var Offs: Longint;
        mask, l, bankrest: longint;
        mask, l, bankrest: longint;
@@ -695,7 +695,7 @@ end;
        end;
        end;
    end;
    end;
 
 
-  procedure VLineVESA256(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure VLineVESA256(x,y,y2: smallint);
 
 
    var Offs: Longint;
    var Offs: Longint;
        l, bankrest: longint;
        l, bankrest: longint;
@@ -850,7 +850,7 @@ end;
        end;
        end;
    end;
    end;
 
 
-  procedure PatternLineVESA256(x1,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure PatternLineVESA256(x1,x2,y: smallint);
   {********************************************************}
   {********************************************************}
   { Draws a horizontal patterned line according to the     }
   { Draws a horizontal patterned line according to the     }
   { current Fill Settings.                                 }
   { current Fill Settings.                                 }
@@ -983,7 +983,7 @@ end;
  {*                    15/16bit pixels VESA mode routines                *}
  {*                    15/16bit pixels VESA mode routines                *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA32kOr64k(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA32kOr64k(x, y : smallint; color : ColorType);
   var
   var
      offs : longint;
      offs : longint;
      place: word;
      place: word;
@@ -1015,7 +1015,7 @@ end;
      memW[WinWriteSeg : place] := color;
      memW[WinWriteSeg : place] := color;
   end;
   end;
 
 
-  function GetPixVESA32kOr64k(x, y : smallint): word; {$ifndef fpc}far;{$endif fpc}
+  function GetPixVESA32kOr64k(x, y : smallint): ColorType;
   var
   var
      offs : longint;
      offs : longint;
   begin
   begin
@@ -1026,7 +1026,7 @@ end;
      GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
      GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
   end;
   end;
 
 
-  procedure DirectPutPixVESA32kOr64k(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA32kOr64k(x, y : smallint);
   var
   var
      offs : longint;
      offs : longint;
      bank : smallint;
      bank : smallint;
@@ -1071,7 +1071,7 @@ end;
      End;
      End;
   end;
   end;
 
 
-  procedure HLineVESA32kOr64k(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure HLineVESA32kOr64k(x,x2,y: smallint);
 
 
    var Offs: Longint;
    var Offs: Longint;
        mask, l, bankrest: longint;
        mask, l, bankrest: longint;
@@ -1393,7 +1393,7 @@ end;
  {*                     4-bit pixels VESA mode routines                  *}
  {*                     4-bit pixels VESA mode routines                  *}
  {************************************************************************}
  {************************************************************************}
 
 
-  procedure PutPixVESA16(x, y : smallint; color : word); {$ifndef fpc}far;{$endif fpc}
+  procedure PutPixVESA16(x, y : smallint; color : ColorType);
     var
     var
      offs : longint;
      offs : longint;
      dummy : byte;
      dummy : byte;
@@ -1428,7 +1428,7 @@ end;
   end;
   end;
 
 
 
 
- Function GetPixVESA16(X,Y: smallint):word; {$ifndef fpc}far;{$endif fpc}
+ Function GetPixVESA16(X,Y: smallint):ColorType;
  Var dummy: Word;
  Var dummy: Word;
      offset: longint;
      offset: longint;
      shift: byte;
      shift: byte;
@@ -1450,7 +1450,7 @@ end;
   end;
   end;
 
 
 
 
-  procedure DirectPutPixVESA16(x, y : smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure DirectPutPixVESA16(x, y : smallint);
     var
     var
      offs : longint;
      offs : longint;
      dummy : byte;
      dummy : byte;
@@ -1495,7 +1495,7 @@ end;
   end;
   end;
 
 
 
 
-  procedure HLineVESA16(x,x2,y: smallint); {$ifndef fpc}far;{$endif fpc}
+  procedure HLineVESA16(x,x2,y: smallint);
   var
   var
       xtmp: smallint;
       xtmp: smallint;
       ScrOfs, BankRest: longint;
       ScrOfs, BankRest: longint;
@@ -1933,24 +1933,16 @@ end;
    asm
    asm
     mov ax,4F02h
     mov ax,4F02h
     mov bx,mode
     mov bx,mode
-{$ifdef fpc}
+    push ds
     push bp
     push bp
-    push si
-    push di
-    push bx
-{$endif fpc}
     int 10h
     int 10h
-{$ifdef fpc}
-    pop bx
-    pop di
-    pop si
     pop bp
     pop bp
-{$endif fpc}
+    pop ds
     sub ax,004Fh
     sub ax,004Fh
     cmp ax,1
     cmp ax,1
     sbb al,al
     sbb al,al
     mov res,al
     mov res,al
-   end ['BX','AX'];
+   end ['DX','CX','BX','AX','SI','DI'];
    if not res then
    if not res then
      _GraphResult := GrNotDetected
      _GraphResult := GrNotDetected
    else _GraphResult := grOk;
    else _GraphResult := grOk;
@@ -1980,21 +1972,21 @@ end;
      GetMaxScanLines := regs.dx;
      GetMaxScanLines := regs.dx;
    end;
    end;
 
 
- procedure Init1280x1024x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x64k;
   begin
   begin
     SetVesaMode(m1280x1024x64k);
     SetVesaMode(m1280x1024x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1280x1024x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x32k;
   begin
   begin
     SetVESAMode(m1280x1024x32k);
     SetVESAMode(m1280x1024x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1280x1024x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x256;
   begin
   begin
     SetVESAMode(m1280x1024x256);
     SetVESAMode(m1280x1024x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
@@ -2002,105 +1994,105 @@ end;
   end;
   end;
 
 
 
 
- procedure Init1280x1024x16; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1280x1024x16;
   begin
   begin
     SetVESAMode(m1280x1024x16);
     SetVESAMode(m1280x1024x16);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x64k;
   begin
   begin
     SetVESAMode(m1024x768x64k);
     SetVESAMode(m1024x768x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x32k;
   begin
   begin
     SetVESAMode(m1024x768x32k);
     SetVESAMode(m1024x768x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x256;
   begin
   begin
     SetVESAMode(m1024x768x256);
     SetVESAMode(m1024x768x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init1024x768x16; {$ifndef fpc}far;{$endif fpc}
+ procedure Init1024x768x16;
   begin
   begin
     SetVESAMode(m1024x768x16);
     SetVESAMode(m1024x768x16);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x64k;
   begin
   begin
     SetVESAMode(m800x600x64k);
     SetVESAMode(m800x600x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x32k;
   begin
   begin
     SetVESAMode(m800x600x32k);
     SetVESAMode(m800x600x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x256;
   begin
   begin
     SetVESAMode(m800x600x256);
     SetVESAMode(m800x600x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init800x600x16; {$ifndef fpc}far;{$endif fpc}
+ procedure Init800x600x16;
   begin
   begin
     SetVesaMode(m800x600x16);
     SetVesaMode(m800x600x16);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x480x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x480x64k;
   begin
   begin
     SetVESAMode(m640x480x64k);
     SetVESAMode(m640x480x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x480x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x480x32k;
   begin
   begin
     SetVESAMode(m640x480x32k);
     SetVESAMode(m640x480x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x480x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x480x256;
   begin
   begin
     SetVESAMode(m640x480x256);
     SetVESAMode(m640x480x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init640x400x256; {$ifndef fpc}far;{$endif fpc}
+ procedure Init640x400x256;
   begin
   begin
     SetVESAMode(m640x400x256);
     SetVESAMode(m640x400x256);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init320x200x64k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init320x200x64k;
   begin
   begin
     SetVESAMode(m320x200x64k);
     SetVESAMode(m320x200x64k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
     ScanLines := GetMaxScanLines;
     ScanLines := GetMaxScanLines;
   end;
   end;
 
 
- procedure Init320x200x32k; {$ifndef fpc}far;{$endif fpc}
+ procedure Init320x200x32k;
   begin
   begin
     SetVESAMode(m320x200x32k);
     SetVESAMode(m320x200x32k);
     { Get maximum number of scanlines for page flipping }
     { Get maximum number of scanlines for page flipping }
@@ -2109,7 +2101,7 @@ end;
 
 
 
 
 
 
- Procedure SaveStateVESA; {$ifndef fpc}far;{$endif fpc}
+ Procedure SaveStateVESA;
  var
  var
   regs: Registers;
   regs: Registers;
   begin
   begin
@@ -2161,7 +2153,7 @@ end;
       end;
       end;
   end;
   end;
 
 
- procedure RestoreStateVESA; {$ifndef fpc}far;{$endif fpc}
+ procedure RestoreStateVESA;
   var
   var
    regs:Registers;
    regs:Registers;
    SavePtrCopy: Pointer;
    SavePtrCopy: Pointer;
@@ -2202,7 +2194,7 @@ end;
   { between VBE versions , we will use the old method where }
   { between VBE versions , we will use the old method where }
   { the new pixel offset is used to display different pages }
   { the new pixel offset is used to display different pages }
   {******************************************************** }
   {******************************************************** }
- procedure SetVisualVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+ procedure SetVisualVESA(page: word);
   var
   var
    newStartVisible : word;
    newStartVisible : word;
   begin
   begin
@@ -2222,23 +2214,15 @@ end;
       mov bx, 0000h   { set display start }
       mov bx, 0000h   { set display start }
       mov cx, 0000h   { pixel zero !      }
       mov cx, 0000h   { pixel zero !      }
       mov dx, [NewStartVisible]  { new scanline }
       mov dx, [NewStartVisible]  { new scanline }
-{$ifdef fpc}
+      push    ds
       push    bp
       push    bp
-      push    si
-      push    di
-      push    bx
-{$endif}
       int     10h
       int     10h
-{$ifdef fpc}
-      pop     bx
-      pop     di
-      pop     si
       pop     bp
       pop     bp
-{$endif}
-    end ['DX','CX','BX','AX'];
+      pop     ds
+    end ['DX','CX','BX','AX','SI','DI'];
   end;
   end;
 
 
- procedure SetActiveVESA(page: word); {$ifndef fpc}far;{$endif fpc}
+ procedure SetActiveVESA(page: word);
   begin
   begin
     { video offset is in pixels under VESA VBE! }
     { video offset is in pixels under VESA VBE! }
     { This value is reset after a mode set to page ZERO = YOffset = 0 ) }
     { This value is reset after a mode set to page ZERO = YOffset = 0 ) }

Разлика између датотеке није приказан због своје велике величине
+ 683 - 69
packages/graph/src/ptcgraph/ptcgraph.pp


+ 21 - 6
packages/ide/fpide.pas

@@ -1657,7 +1657,10 @@ procedure TIDEApp.UpdateRecentFileList;
 var P: PMenuItem;
 var P: PMenuItem;
     {ID,}I: word;
     {ID,}I: word;
     FileMenu: PMenuItem;
     FileMenu: PMenuItem;
+    R: TRect;
+    AdjustRecentCount : word;
 begin
 begin
+  if not assigned(MenuBar) then exit;
 {  ID:=cmRecentFileBase;}
 {  ID:=cmRecentFileBase;}
   FileMenu:=SearchSubMenu(MenuBar^.Menu,menuFile);
   FileMenu:=SearchSubMenu(MenuBar^.Menu,menuFile);
   repeat
   repeat
@@ -1683,13 +1686,25 @@ begin
   if (P<>nil) and IsSeparator(P) then
   if (P<>nil) and IsSeparator(P) then
      RemoveMenuItem(FileMenu^.SubMenu,P);
      RemoveMenuItem(FileMenu^.SubMenu,P);
 
 
-  if RecentFileCount>0 then
-     AppendMenuItem(FileMenu^.SubMenu,NewLine(nil));
-  for I:=1 to RecentFileCount do
+  GetExtent(R);
+  AdjustRecentCount :=0;
+  {calculate how much lines on screen for reacent files can be used }
+  if r.b.y-r.a.y -19 > 0 then AdjustRecentCount:=r.b.y-r.a.y -19;
+  {only if there is enough space then show all reacent files }
+  {else cut list shorter }
+  if RecentFileCount < AdjustRecentCount then
+     AdjustRecentCount:=RecentFileCount;
+
+  if AdjustRecentCount>0 then
   begin
   begin
-    P:=NewItem('~'+IntToStr(I)+'~ '+ShrinkPath(SmartPath(RecentFiles[I].FileName),27),' ',
-        kbNoKey,cmRecentFileBase+I,hcRecentFileBase+I,nil);
-    AppendMenuItem(FileMenu^.SubMenu,P);
+     AppendMenuItem(FileMenu^.SubMenu,NewLine(nil));
+
+    for I:=1 to AdjustRecentCount do
+    begin
+      P:=NewItem('~'+IntToStr(I)+'~ '+ShrinkPath(SmartPath(RecentFiles[I].FileName),27),' ',
+          kbNoKey,cmRecentFileBase+I,hcRecentFileBase+I,nil);
+      AppendMenuItem(FileMenu^.SubMenu,P);
+    end;
   end;
   end;
 end;
 end;
 
 

+ 1 - 0
packages/ide/fpmwnd.inc

@@ -38,6 +38,7 @@ begin
       Mode.col:=x;
       Mode.col:=x;
       Mode.row:=y;
       Mode.row:=y;
       SetScreenVideoMode(Mode);
       SetScreenVideoMode(Mode);
+      UpdateRecentFileList; {ensure file menu not go over screen}
       Redraw;
       Redraw;
     end;
     end;
 end;
 end;

+ 14 - 1
packages/ide/weditor.pas

@@ -3422,6 +3422,7 @@ var
   E: TEvent;
   E: TEvent;
   OldEvent : PEvent;
   OldEvent : PEvent;
   CCAction: TCCAction;
   CCAction: TCCAction;
+  LinesScroll : sw_integer;
 begin
 begin
   CCAction:=ccClear;
   CCAction:=ccClear;
   E:=Event;
   E:=Event;
@@ -3437,6 +3438,18 @@ begin
   case Event.What of
   case Event.What of
     evMouseDown :
     evMouseDown :
       if MouseInView(Event.Where) then
       if MouseInView(Event.Where) then
+       if (Event.Buttons=mbScrollWheelUp) then { mouse scroll up}
+         begin
+           LinesScroll:=1;
+           if Event.Double then LinesScroll:=LinesScroll+4;
+           ScrollTo(Delta.X, Delta.Y + LinesScroll);
+         end else
+       if (Event.Buttons=mbScrollWheelDown) then  { mouse scroll down }
+         begin
+           LinesScroll:=-1;
+           if Event.Double then LinesScroll:=LinesScroll-4;
+           ScrollTo(Delta.X, Delta.Y + LinesScroll);
+         end else
        if (Event.Buttons=mbRightButton) then
        if (Event.Buttons=mbRightButton) then
          begin
          begin
            MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
            MakeLocal(Event.Where,P); Inc(P.X); Inc(P.Y);
@@ -5124,7 +5137,7 @@ begin
   OK:=(S[StartPos] in WordChars);
   OK:=(S[StartPos] in WordChars);
   if OK then
   if OK then
     begin
     begin
-       While (StartPos>0) and (S[StartPos-1] in WordChars) do
+       While (StartPos>1) and (S[StartPos-1] in WordChars) do
          Dec(StartPos);
          Dec(StartPos);
        While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
        While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
          Inc(EndPos);
          Inc(EndPos);

+ 192 - 180
packages/openssl/src/openssl.pas

@@ -42,7 +42,7 @@ unit openssl;
 |==============================================================================|
 |==============================================================================|
 | FreePascal basic cleanup (original worked too): Ales Katona                  |
 | FreePascal basic cleanup (original worked too): Ales Katona                  |
 | WARNING: due to reliance on some units, I have removed the ThreadLocks init  |
 | WARNING: due to reliance on some units, I have removed the ThreadLocks init  |
-|          if need be, it should be re-added, or handled by the                | 
+|          if need be, it should be re-added, or handled by the                |
 |           OS threading init somehow                                          |
 |           OS threading init somehow                                          |
 |                                                                              |
 |                                                                              |
 | 2010 - Felipe Monteiro de Carvalho - Added RAND functios                     |
 | 2010 - Felipe Monteiro de Carvalho - Added RAND functios                     |
@@ -105,7 +105,7 @@ var
    {$ELSE OS2}
    {$ELSE OS2}
   DLLSSLName: string = 'libssl';
   DLLSSLName: string = 'libssl';
   DLLUtilName: string = 'libcrypto';
   DLLUtilName: string = 'libcrypto';
-  
+
   { ADD NEW ONES WHEN THEY APPEAR!
   { ADD NEW ONES WHEN THEY APPEAR!
     Always make .so/dylib first, then versions, in descending order!
     Always make .so/dylib first, then versions, in descending order!
     Add "." .before the version, first is always just "" }
     Add "." .before the version, first is always just "" }
@@ -134,7 +134,7 @@ type
   PSSL_METHOD = SslPtr;
   PSSL_METHOD = SslPtr;
 {  PX509 = SslPtr;}
 {  PX509 = SslPtr;}
 {  PX509_NAME = SslPtr;}
 {  PX509_NAME = SslPtr;}
-  PEVP_MD	= SslPtr;
+  PEVP_MD = SslPtr;
   PBIO_METHOD = SslPtr;
   PBIO_METHOD = SslPtr;
   PBIO = SslPtr;
   PBIO = SslPtr;
 {  EVP_PKEY = SslPtr;}
 {  EVP_PKEY = SslPtr;}
@@ -155,20 +155,20 @@ type
   PDN = ^X509_NAME;
   PDN = ^X509_NAME;
 
 
   ASN1_STRING = record
   ASN1_STRING = record
-	length: integer;
-	asn1_type: integer;
-	data: pointer;
-	flags: longint;
+  length: integer;
+  asn1_type: integer;
+  data: pointer;
+  flags: longint;
   end;
   end;
   PASN1_STRING = ^ASN1_STRING;
   PASN1_STRING = ^ASN1_STRING;
   PASN1_TIME = PASN1_STRING;
   PASN1_TIME = PASN1_STRING;
 
 
   X509_VAL = record
   X509_VAL = record
-	notBefore: PASN1_TIME;
+  notBefore: PASN1_TIME;
     notAfter: PASN1_TIME;
     notAfter: PASN1_TIME;
   end;
   end;
   PX509_VAL = ^X509_VAL;
   PX509_VAL = ^X509_VAL;
-  
+
   X509_CINF = record
   X509_CINF = record
     version: pointer;
     version: pointer;
     serialNumber: pointer;
     serialNumber: pointer;
@@ -182,7 +182,7 @@ type
     extensions: pointer;
     extensions: pointer;
   end;
   end;
   PX509_CINF = ^X509_CINF;
   PX509_CINF = ^X509_CINF;
-  
+
   CRYPTO_EX_DATA = record
   CRYPTO_EX_DATA = record
     sk: pointer;
     sk: pointer;
     dummy: integer;
     dummy: integer;
@@ -208,26 +208,26 @@ type
   end;
   end;
   pX509 = ^X509;
   pX509 = ^X509;
   PPX509 = ^PX509;
   PPX509 = ^PX509;
-  
+
   DSA = record
   DSA = record
-	pad: integer;
-	version: integer;
-	write_params: integer;
-	p: pointer;
-	q: pointer;
-	g: pointer;
-	pub_key: pointer;
-	priv_key: pointer;
-	kinv: pointer;
-	r: pointer;
-	flags: integer;
-	method_mont_p: PChar;
-	references: integer;
-	ex_data: record
+  pad: integer;
+  version: integer;
+  write_params: integer;
+  p: pointer;
+  q: pointer;
+  g: pointer;
+  pub_key: pointer;
+  priv_key: pointer;
+  kinv: pointer;
+  r: pointer;
+  flags: integer;
+  method_mont_p: PChar;
+  references: integer;
+  ex_data: record
       sk: pointer;
       sk: pointer;
       dummy: integer;
       dummy: integer;
     end;
     end;
-	meth: pointer;
+  meth: pointer;
   end;
   end;
   pDSA = ^DSA;
   pDSA = ^DSA;
 
 
@@ -238,7 +238,7 @@ type
       2: (dsa: pDSA);
       2: (dsa: pDSA);
       3: (dh: pDH);
       3: (dh: pDH);
    end;
    end;
-  
+
   EVP_PKEY = record
   EVP_PKEY = record
     ktype: integer;
     ktype: integer;
     save_type: integer;
     save_type: integer;
@@ -249,7 +249,7 @@ type
   end;
   end;
   PEVP_PKEY = ^EVP_PKEY;
   PEVP_PKEY = ^EVP_PKEY;
   PPEVP_PKEY = ^PEVP_PKEY;
   PPEVP_PKEY = ^PEVP_PKEY;
-  
+
   PPRSA = ^PRSA;
   PPRSA = ^PRSA;
   PASN1_cInt = SslPtr;
   PASN1_cInt = SslPtr;
   PPasswdCb = SslPtr;
   PPasswdCb = SslPtr;
@@ -403,14 +403,14 @@ type
     key_len: cint;  //* Default value for variable length ciphers */
     key_len: cint;  //* Default value for variable length ciphers */
     iv_len: cint;
     iv_len: cint;
     flags: culong; //* Various flags */
     flags: culong; //* Various flags */
-    init: EVP_CIPHER_INIT_FUNC;	//* init key */
+    init: EVP_CIPHER_INIT_FUNC; //* init key */
     do_cipher: EVP_CIPHER_DO_CIPHER_FUNC;//* encrypt/decrypt data */
     do_cipher: EVP_CIPHER_DO_CIPHER_FUNC;//* encrypt/decrypt data */
     cleanup: EVP_CIPHER_CLEANUP_FUNC; //* cleanup ctx */
     cleanup: EVP_CIPHER_CLEANUP_FUNC; //* cleanup ctx */
-    ctx_size: cint;		//* how big ctx->cipher_data needs to be */
+    ctx_size: cint;   //* how big ctx->cipher_data needs to be */
     set_asn1_parameters: EVP_CIPHER_SET_ASN1_PARAMETERS_FUNC; //* Populate a ASN1_TYPE with parameters */
     set_asn1_parameters: EVP_CIPHER_SET_ASN1_PARAMETERS_FUNC; //* Populate a ASN1_TYPE with parameters */
     get_asn1_parameters: EVP_CIPHER_GET_ASN1_PARAMETERS_FUNC; //* Get parameters from a ASN1_TYPE */
     get_asn1_parameters: EVP_CIPHER_GET_ASN1_PARAMETERS_FUNC; //* Get parameters from a ASN1_TYPE */
     ctrl: EVP_CIPHER_CTRL_FUNC; //* Miscellaneous operations */
     ctrl: EVP_CIPHER_CTRL_FUNC; //* Miscellaneous operations */
-    app_data: Pointer;	//* Application data */
+    app_data: Pointer;  //* Application data */
   end;
   end;
   PEVP_CIPHER = ^EVP_CIPHER;
   PEVP_CIPHER = ^EVP_CIPHER;
 
 
@@ -427,7 +427,7 @@ type
 
 
     app_data: Pointer;   //* application stuff */
     app_data: Pointer;   //* application stuff */
     key_len: cint;    //* May change for variable length cipher */
     key_len: cint;    //* May change for variable length cipher */
-    flags: culong;	//* Various flags */
+    flags: culong;  //* Various flags */
     cipher_data: Pointer; //* per EVP data */
     cipher_data: Pointer; //* per EVP data */
     final_used: cint;
     final_used: cint;
     block_mask: cint;
     block_mask: cint;
@@ -685,12 +685,12 @@ const
   SSL_CTRL_SET_CHANNEL_ID                     = 119;
   SSL_CTRL_SET_CHANNEL_ID                     = 119;
 
 
 
 
-  DTLS_CTRL_GET_TIMEOUT	           = 73;
+  DTLS_CTRL_GET_TIMEOUT            = 73;
   DTLS_CTRL_HANDLE_TIMEOUT         = 74;
   DTLS_CTRL_HANDLE_TIMEOUT         = 74;
-  DTLS_CTRL_LISTEN		   = 75;
-  SSL_CTRL_GET_RI_SUPPORT	   = 76;
-  SSL_CTRL_CLEAR_OPTIONS	   = 77;
-  SSL_CTRL_CLEAR_MODE		   = 78;
+  DTLS_CTRL_LISTEN       = 75;
+  SSL_CTRL_GET_RI_SUPPORT    = 76;
+  SSL_CTRL_CLEAR_OPTIONS     = 77;
+  SSL_CTRL_CLEAR_MODE      = 78;
 
 
   TLSEXT_TYPE_server_name = 0;
   TLSEXT_TYPE_server_name = 0;
   TLSEXT_TYPE_max_fragment_length = 1;
   TLSEXT_TYPE_max_fragment_length = 1;
@@ -788,7 +788,7 @@ const
   OPENSSL_DES_DECRYPT = 0;
   OPENSSL_DES_DECRYPT = 0;
   OPENSSL_DES_ENCRYPT = 1;
   OPENSSL_DES_ENCRYPT = 1;
 
 
-  X509_V_OK =	0;
+  X509_V_OK = 0;
   X509_V_ILLEGAL = 1;
   X509_V_ILLEGAL = 1;
   X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
   X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2;
   X509_V_ERR_UNABLE_TO_GET_CRL = 3;
   X509_V_ERR_UNABLE_TO_GET_CRL = 3;
@@ -827,7 +827,7 @@ const
   //The application is not happy
   //The application is not happy
   X509_V_ERR_APPLICATION_VERIFICATION = 50;
   X509_V_ERR_APPLICATION_VERIFICATION = 50;
 
 
-  SSL_FILETYPE_ASN1	= 2;
+  SSL_FILETYPE_ASN1 = 2;
   SSL_FILETYPE_PEM = 1;
   SSL_FILETYPE_PEM = 1;
   EVP_PKEY_RSA = 6;
   EVP_PKEY_RSA = 6;
 
 
@@ -891,73 +891,73 @@ const
 
 
   // BIO
   // BIO
 
 
-  BIO_NOCLOSE	        = $00;
-  BIO_CLOSE 	        = $01;
+  BIO_NOCLOSE         = $00;
+  BIO_CLOSE           = $01;
 
 
   //* modifiers */
   //* modifiers */
-  BIO_FP_READ		= $02;
-  BIO_FP_WRITE		= $04;
-  BIO_FP_APPEND		= $08;
-  BIO_FP_TEXT		= $10;
+  BIO_FP_READ   = $02;
+  BIO_FP_WRITE    = $04;
+  BIO_FP_APPEND   = $08;
+  BIO_FP_TEXT   = $10;
 
 
   BIO_C_SET_CONNECT                 = 100;
   BIO_C_SET_CONNECT                 = 100;
   BIO_C_DO_STATE_MACHINE            = 101;
   BIO_C_DO_STATE_MACHINE            = 101;
-  BIO_C_SET_NBIO	            = 102;
-  BIO_C_SET_PROXY_PARAM	            = 103;
-  BIO_C_SET_FD	                    = 104;
-  BIO_C_GET_FD		            = 105;
-  BIO_C_SET_FILE_PTR	            = 106;
-  BIO_C_GET_FILE_PTR	            = 107;
-  BIO_C_SET_FILENAME	            = 108;
-  BIO_C_SET_SSL		            = 109;
-  BIO_C_GET_SSL		            = 110;
-  BIO_C_SET_MD		            = 111;
-  BIO_C_GET_MD	                    = 112;
+  BIO_C_SET_NBIO              = 102;
+  BIO_C_SET_PROXY_PARAM             = 103;
+  BIO_C_SET_FD                      = 104;
+  BIO_C_GET_FD                = 105;
+  BIO_C_SET_FILE_PTR              = 106;
+  BIO_C_GET_FILE_PTR              = 107;
+  BIO_C_SET_FILENAME              = 108;
+  BIO_C_SET_SSL               = 109;
+  BIO_C_GET_SSL               = 110;
+  BIO_C_SET_MD                = 111;
+  BIO_C_GET_MD                      = 112;
   BIO_C_GET_CIPHER_STATUS           = 113;
   BIO_C_GET_CIPHER_STATUS           = 113;
-  BIO_C_SET_BUF_MEM 	            = 114;
-  BIO_C_GET_BUF_MEM_PTR  	    = 115;
+  BIO_C_SET_BUF_MEM               = 114;
+  BIO_C_GET_BUF_MEM_PTR       = 115;
   BIO_C_GET_BUFF_NUM_LINES          = 116;
   BIO_C_GET_BUFF_NUM_LINES          = 116;
-  BIO_C_SET_BUFF_SIZE	            = 117;
-  BIO_C_SET_ACCEPT 	            = 118;
-  BIO_C_SSL_MODE 	            = 119;
-  BIO_C_GET_MD_CTX	            = 120;
-  BIO_C_GET_PROXY_PARAM	            = 121;
-  BIO_C_SET_BUFF_READ_DATA 	    = 122; // data to read first */
-  BIO_C_GET_CONNECT	 	    = 123;
-  BIO_C_GET_ACCEPT		    = 124;
+  BIO_C_SET_BUFF_SIZE             = 117;
+  BIO_C_SET_ACCEPT              = 118;
+  BIO_C_SSL_MODE              = 119;
+  BIO_C_GET_MD_CTX              = 120;
+  BIO_C_GET_PROXY_PARAM             = 121;
+  BIO_C_SET_BUFF_READ_DATA      = 122; // data to read first */
+  BIO_C_GET_CONNECT       = 123;
+  BIO_C_GET_ACCEPT        = 124;
   BIO_C_SET_SSL_RENEGOTIATE_BYTES   = 125;
   BIO_C_SET_SSL_RENEGOTIATE_BYTES   = 125;
   BIO_C_GET_SSL_NUM_RENEGOTIATES    = 126;
   BIO_C_GET_SSL_NUM_RENEGOTIATES    = 126;
   BIO_C_SET_SSL_RENEGOTIATE_TIMEOUT = 127;
   BIO_C_SET_SSL_RENEGOTIATE_TIMEOUT = 127;
-  BIO_C_FILE_SEEK		    = 128;
-  BIO_C_GET_CIPHER_CTX		    = 129;
-  BIO_C_SET_BUF_MEM_EOF_RETURN	= 130;//*return end of input value*/
-  BIO_C_SET_BIND_MODE		= 131;
-  BIO_C_GET_BIND_MODE		= 132;
-  BIO_C_FILE_TELL		= 133;
-  BIO_C_GET_SOCKS		= 134;
-  BIO_C_SET_SOCKS		= 135;
-
-  BIO_C_SET_WRITE_BUF_SIZE	= 136;//* for BIO_s_bio */
-  BIO_C_GET_WRITE_BUF_SIZE	= 137;
-  BIO_C_MAKE_BIO_PAIR		= 138;
-  BIO_C_DESTROY_BIO_PAIR	= 139;
-  BIO_C_GET_WRITE_GUARANTEE	= 140;
-  BIO_C_GET_READ_REQUEST	= 141;
-  BIO_C_SHUTDOWN_WR		= 142;
-  BIO_C_NREAD0		        = 143;
-  BIO_C_NREAD			= 144;
-  BIO_C_NWRITE0			= 145;
-  BIO_C_NWRITE			= 146;
-  BIO_C_RESET_READ_REQUEST	= 147;
-  BIO_C_SET_MD_CTX		= 148;
-
-  BIO_C_SET_PREFIX		= 149;
-  BIO_C_GET_PREFIX		= 150;
-  BIO_C_SET_SUFFIX		= 151;
-  BIO_C_GET_SUFFIX		= 152;
-
-  BIO_C_SET_EX_ARG		= 153;
-  BIO_C_GET_EX_ARG		= 154;
+  BIO_C_FILE_SEEK       = 128;
+  BIO_C_GET_CIPHER_CTX        = 129;
+  BIO_C_SET_BUF_MEM_EOF_RETURN  = 130;//*return end of input value*/
+  BIO_C_SET_BIND_MODE   = 131;
+  BIO_C_GET_BIND_MODE   = 132;
+  BIO_C_FILE_TELL   = 133;
+  BIO_C_GET_SOCKS   = 134;
+  BIO_C_SET_SOCKS   = 135;
+
+  BIO_C_SET_WRITE_BUF_SIZE  = 136;//* for BIO_s_bio */
+  BIO_C_GET_WRITE_BUF_SIZE  = 137;
+  BIO_C_MAKE_BIO_PAIR   = 138;
+  BIO_C_DESTROY_BIO_PAIR  = 139;
+  BIO_C_GET_WRITE_GUARANTEE = 140;
+  BIO_C_GET_READ_REQUEST  = 141;
+  BIO_C_SHUTDOWN_WR   = 142;
+  BIO_C_NREAD0            = 143;
+  BIO_C_NREAD     = 144;
+  BIO_C_NWRITE0     = 145;
+  BIO_C_NWRITE      = 146;
+  BIO_C_RESET_READ_REQUEST  = 147;
+  BIO_C_SET_MD_CTX    = 148;
+
+  BIO_C_SET_PREFIX    = 149;
+  BIO_C_GET_PREFIX    = 150;
+  BIO_C_SET_SUFFIX    = 151;
+  BIO_C_GET_SUFFIX    = 152;
+
+  BIO_C_SET_EX_ARG    = 153;
+  BIO_C_GET_EX_ARG    = 154;
 
 
   BIO_CTRL_RESET  =    1  ; { opt - rewind/zero etc }
   BIO_CTRL_RESET  =    1  ; { opt - rewind/zero etc }
   BIO_CTRL_EOF    =    2  ; { opt - are we at the eof }
   BIO_CTRL_EOF    =    2  ; { opt - are we at the eof }
@@ -1032,7 +1032,7 @@ var
   function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
   function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX;
   procedure SslCtxFree(arg0: PSSL_CTX);
   procedure SslCtxFree(arg0: PSSL_CTX);
   function SslSetFd(s: PSSL; fd: cInt):cInt;
   function SslSetFd(s: PSSL; fd: cInt):cInt;
-  
+
   function SslCtrl(ssl: PSSL; cmd: cInt; larg: clong; parg: Pointer): cLong;
   function SslCtrl(ssl: PSSL; cmd: cInt; larg: clong; parg: Pointer): cLong;
   function SslCTXCtrl(ctx: PSSL_CTX; cmd: cInt; larg: clong; parg: Pointer): cLong;
   function SslCTXCtrl(ctx: PSSL_CTX; cmd: cInt; larg: clong; parg: Pointer): cLong;
 
 
@@ -1040,7 +1040,7 @@ var
   function SSLSetMode(s: PSSL; mode: cLong): cLong;
   function SSLSetMode(s: PSSL; mode: cLong): cLong;
   function SSLCTXGetMode(ctx: PSSL_CTX): cLong;
   function SSLCTXGetMode(ctx: PSSL_CTX): cLong;
   function SSLGetMode(s: PSSL): cLong;
   function SSLGetMode(s: PSSL): cLong;
-  
+
   function SslMethodV2:PSSL_METHOD;
   function SslMethodV2:PSSL_METHOD;
   function SslMethodV3:PSSL_METHOD;
   function SslMethodV3:PSSL_METHOD;
   function SslMethodTLSV1:PSSL_METHOD;
   function SslMethodTLSV1:PSSL_METHOD;
@@ -1273,16 +1273,16 @@ var
   // PEM Functions - pem.h
   // PEM Functions - pem.h
   //
   //
   function PEM_read_bio_PrivateKey(bp: PBIO; X: PPEVP_PKEY;
   function PEM_read_bio_PrivateKey(bp: PBIO; X: PPEVP_PKEY;
-           cb: Ppem_password_cb; u: Pointer): PEVP_PKEY;  	   
+           cb: Ppem_password_cb; u: Pointer): PEVP_PKEY;
   function PEM_read_bio_PUBKEY(bp: pBIO; var x: pEVP_PKEY;
   function PEM_read_bio_PUBKEY(bp: pBIO; var x: pEVP_PKEY;
                cb: Ppem_password_cb; u: pointer): pEVP_PKEY;
                cb: Ppem_password_cb; u: pointer): pEVP_PKEY;
   function PEM_write_bio_PrivateKey(bp: pBIO; x: pEVP_PKEY;
   function PEM_write_bio_PrivateKey(bp: pBIO; x: pEVP_PKEY;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
-               u: pointer): integer;	
+               u: pointer): integer;
   function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
   function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
   function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
   function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
   function PEM_write_bio_X509(bp: pBIO;  x: px509): integer;
   function PEM_write_bio_X509(bp: pBIO;  x: px509): integer;
-
+  function PEM_write_bio_PKCS7(bp : PBIO; x : PPKCS7) : cint;
   // BIO Functions - bio.h
   // BIO Functions - bio.h
   function BioNew(b: PBIO_METHOD): PBIO;
   function BioNew(b: PBIO_METHOD): PBIO;
   procedure BioFreeAll(b: PBIO);
   procedure BioFreeAll(b: PBIO);
@@ -1294,7 +1294,7 @@ var
   function BioWrite(b: PBIO; Buf: TBytes; Len: cInt): cInt; overload;
   function BioWrite(b: PBIO; Buf: TBytes; Len: cInt): cInt; overload;
   function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
   function BIO_ctrl(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong;
   function BIO_read_filename(b: PBIO; const name: PChar): cint;
   function BIO_read_filename(b: PBIO; const name: PChar): cint;
-  
+
   function BIO_s_file: pBIO_METHOD;
   function BIO_s_file: pBIO_METHOD;
   function BIO_new_file(const filename: PChar; const mode: PChar): pBIO;
   function BIO_new_file(const filename: PChar; const mode: PChar): pBIO;
   function BIO_new_mem_buf(buf: pointer; len: integer): pBIO;
   function BIO_new_mem_buf(buf: pointer; len: integer): pBIO;
@@ -1681,7 +1681,7 @@ type
   TEVP_DigestInit = function(ctx: PEVP_MD_CTX; type_: PEVP_MD): cint; cdecl;
   TEVP_DigestInit = function(ctx: PEVP_MD_CTX; type_: PEVP_MD): cint; cdecl;
   TEVP_DigestUpdate = function(ctx: PEVP_MD_CTX; const data: Pointer; cnt: csize_t): cint; cdecl;
   TEVP_DigestUpdate = function(ctx: PEVP_MD_CTX; const data: Pointer; cnt: csize_t): cint; cdecl;
   TEVP_DigestFinal = function(ctx: PEVP_MD_CTX; md: PByte; s: pcuint): cint; cdecl;
   TEVP_DigestFinal = function(ctx: PEVP_MD_CTX; md: PByte; s: pcuint): cint; cdecl;
-  
+
   TEVP_SignFinal = function(ctx: pEVP_MD_CTX; sig: pointer; var s: cardinal;
   TEVP_SignFinal = function(ctx: pEVP_MD_CTX; sig: pointer; var s: cardinal;
     key: pEVP_PKEY): integer; cdecl;
     key: pEVP_PKEY): integer; cdecl;
   TEVP_PKEY_size = function(key: pEVP_PKEY): integer; cdecl;
   TEVP_PKEY_size = function(key: pEVP_PKEY): integer; cdecl;
@@ -1719,20 +1719,21 @@ type
 
 
   TPEM_read_bio_PrivateKey = function(bp: PBIO; X: PPEVP_PKEY;
   TPEM_read_bio_PrivateKey = function(bp: PBIO; X: PPEVP_PKEY;
            cb: Ppem_password_cb; u: Pointer): PEVP_PKEY; cdecl;
            cb: Ppem_password_cb; u: Pointer): PEVP_PKEY; cdecl;
-   
+
   TPEM_read_bio_PUBKEY = function(bp: pBIO; var x: pEVP_PKEY;
   TPEM_read_bio_PUBKEY = function(bp: pBIO; var x: pEVP_PKEY;
                cb: Ppem_password_cb; u: pointer): pEVP_PKEY; cdecl;
                cb: Ppem_password_cb; u: pointer): pEVP_PKEY; cdecl;
   TPEM_write_bio_PrivateKey = function(bp: pBIO; x: pEVP_PKEY;
   TPEM_write_bio_PrivateKey = function(bp: pBIO; x: pEVP_PKEY;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
-               u: pointer): integer; cdecl;	
+               u: pointer): integer; cdecl;
   TPEM_write_bio_PUBKEY = function(bp: pBIO; x: pEVP_PKEY): integer; cdecl;
   TPEM_write_bio_PUBKEY = function(bp: pBIO; x: pEVP_PKEY): integer; cdecl;
   TPEM_read_bio_X509 = function(bp: pBIO; x: PPX509; cb: Ppem_password_cb; u: pointer): px509; cdecl;
   TPEM_read_bio_X509 = function(bp: pBIO; x: PPX509; cb: Ppem_password_cb; u: pointer): px509; cdecl;
   TPEM_write_bio_X509 = function(bp: pBIO; x: PX509): integer; cdecl;
   TPEM_write_bio_X509 = function(bp: pBIO; x: PX509): integer; cdecl;
+  TPEM_write_bio_PKCS7 = function(bp: pBIO; x: PPKCS7): integer; cdecl;
 
 
   // BIO Functions
   // BIO Functions
 
 
   TBIO_ctrl = function(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong; cdecl;
   TBIO_ctrl = function(bp: PBIO; cmd: cint; larg: clong; parg: Pointer): clong; cdecl;
-  
+
   TBIO_s_file = function: pBIO_METHOD; cdecl;
   TBIO_s_file = function: pBIO_METHOD; cdecl;
   TBIO_new_file = function(const filename: PChar; const mode: PChar): pBIO; cdecl;
   TBIO_new_file = function(const filename: PChar; const mode: PChar): pBIO; cdecl;
   TBIO_new_mem_buf = function(buf: pointer; len: integer): pBIO; cdecl;
   TBIO_new_mem_buf = function(buf: pointer; len: integer): pBIO; cdecl;
@@ -1856,7 +1857,7 @@ var
 
 
   // 3DES functions
   // 3DES functions
   _DESsetoddparity: TDESsetoddparity = nil;
   _DESsetoddparity: TDESsetoddparity = nil;
-  _DESsetkey	   : TDESsetkey = nil;
+  _DESsetkey     : TDESsetkey = nil;
   _DESsetkeychecked: TDESsetkeychecked = nil;
   _DESsetkeychecked: TDESsetkeychecked = nil;
   _DESecbencrypt: TDESecbencrypt = nil;
   _DESecbencrypt: TDESecbencrypt = nil;
   //thread lock functions
   //thread lock functions
@@ -1957,16 +1958,17 @@ var
   _EVP_DigestVerifyFinal: TEVP_DigestVerifyFinal = nil;
   _EVP_DigestVerifyFinal: TEVP_DigestVerifyFinal = nil;
   // PEM
   // PEM
   _PEM_read_bio_PrivateKey: TPEM_read_bio_PrivateKey = nil;
   _PEM_read_bio_PrivateKey: TPEM_read_bio_PrivateKey = nil;
-  	   
-  _PEM_read_bio_PUBKEY: TPEM_read_bio_PUBKEY = nil; 
-  _PEM_write_bio_PrivateKey: TPEM_write_bio_PrivateKey = nil;	
+
+  _PEM_read_bio_PUBKEY: TPEM_read_bio_PUBKEY = nil;
+  _PEM_write_bio_PrivateKey: TPEM_write_bio_PrivateKey = nil;
   _PEM_write_bio_PUBKEY: TPEM_write_bio_PUBKEY = nil;
   _PEM_write_bio_PUBKEY: TPEM_write_bio_PUBKEY = nil;
   _PEM_read_bio_X509: TPEM_read_bio_X509 = nil;
   _PEM_read_bio_X509: TPEM_read_bio_X509 = nil;
   _PEM_write_bio_X509: TPEM_write_bio_X509 = nil;
   _PEM_write_bio_X509: TPEM_write_bio_X509 = nil;
+  _PEM_write_bio_PKCS7 : TPEM_write_bio_PKCS7 = Nil;
   // BIO Functions
   // BIO Functions
 
 
   _BIO_ctrl: TBIO_ctrl = nil;
   _BIO_ctrl: TBIO_ctrl = nil;
-  
+
   _BIO_s_file: TBIO_s_file = nil;
   _BIO_s_file: TBIO_s_file = nil;
   _BIO_new_file: TBIO_new_file = nil;
   _BIO_new_file: TBIO_new_file = nil;
   _BIO_new_mem_buf: TBIO_new_mem_buf = nil;
   _BIO_new_mem_buf: TBIO_new_mem_buf = nil;
@@ -1985,68 +1987,68 @@ var
   PKCS7_ATTR_SIGN_it : ASN1_ITEM;cvar;external;
   PKCS7_ATTR_SIGN_it : ASN1_ITEM;cvar;external;
   PKCS7_ATTR_VERIFY_it : ASN1_ITEM;cvar;external;
   PKCS7_ATTR_VERIFY_it : ASN1_ITEM;cvar;external;
 }
 }
-  _PKCS7_ISSUER_AND_SERIAL_new : function: PPKCS7_ISSUER_AND_SERIAL;
-  _PKCS7_ISSUER_AND_SERIAL_free : procedure(a:PPKCS7_ISSUER_AND_SERIAL);
-  _PKCS7_ISSUER_AND_SERIAL_digest : function(data:PPKCS7_ISSUER_AND_SERIAL; _type:PEVP_MD; md:Pbyte; len:Pdword):longint;
-  _PKCS7_dup : function(p7:PPKCS7):PPKCS7;
-  _PEM_write_bio_PKCS7_stream : function(_out:PBIO; p7:PPKCS7; _in:PBIO; flags:longint):longint;
-  _PKCS7_SIGNER_INFO_new : function:PPKCS7_SIGNER_INFO;
-  _PKCS7_SIGNER_INFO_free : procedure(a:PPKCS7_SIGNER_INFO);
-  _PKCS7_RECIP_INFO_new : function:PPKCS7_RECIP_INFO;
-  _PKCS7_RECIP_INFO_free : procedure(a:PPKCS7_RECIP_INFO);
-  _PKCS7_SIGNED_new : function:PPKCS7_SIGNED;
-  _PKCS7_SIGNED_free : procedure(a:PPKCS7_SIGNED);
-  _PKCS7_ENC_CONTENT_new : function:PPKCS7_ENC_CONTENT;
-  _PKCS7_ENC_CONTENT_free : procedure(a:PPKCS7_ENC_CONTENT);
-  _PKCS7_ENVELOPE_new : function:PPKCS7_ENVELOPE;
-  _PKCS7_ENVELOPE_free : procedure(a:PPKCS7_ENVELOPE);
-  _PKCS7_SIGN_ENVELOPE_new : function:PPKCS7_SIGN_ENVELOPE;
-  _PKCS7_SIGN_ENVELOPE_free : procedure(a:PPKCS7_SIGN_ENVELOPE);
-  _PKCS7_DIGEST_new : function:PPKCS7_DIGEST;
-  _PKCS7_DIGEST_free : procedure(a:PPKCS7_DIGEST);
-  _PKCS7_ENCRYPT_new : function:PPKCS7_ENCRYPT;
-  _PKCS7_ENCRYPT_free : procedure(a:PPKCS7_ENCRYPT);
-  _PKCS7_new : function:PPKCS7;
-  _PKCS7_free : procedure(a:PPKCS7);
-  _PKCS7_print_ctx : function(_out:PBIO; x:PPKCS7; indent:longint; pctx:Pointer):longint;
-  _PKCS7_ctrl : function(p7:PPKCS7; cmd:longint; larg:longint; parg:Pchar):longint;
-  _PKCS7_set_type : function(p7:PPKCS7; _type:longint):longint;
-  _PKCS7_set0_type_other : function(p7:PPKCS7; _type:longint; other:PASN1_TYPE):longint;
-  _PKCS7_set_content : function(p7:PPKCS7; p7_data:PPKCS7):longint;
-  _PKCS7_SIGNER_INFO_set : function(p7i:PPKCS7_SIGNER_INFO; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):longint;
-  _PKCS7_SIGNER_INFO_sign : function(si:PPKCS7_SIGNER_INFO):longint;
-  _PKCS7_add_signer : function(p7:PPKCS7; p7i:PPKCS7_SIGNER_INFO):longint;
-  _PKCS7_add_certificate : function(p7:PPKCS7; x509:PX509):longint;
-  _PKCS7_add_crl : function(p7:PPKCS7; x509: Pointer):longint;
-  _PKCS7_content_new : function(p7:PPKCS7; nid:longint):longint;
-  _PKCS7_add_signature : function(p7:PPKCS7; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):PPKCS7_SIGNER_INFO;
-  _PKCS7_cert_from_signer_info : function(p7:PPKCS7; si:PPKCS7_SIGNER_INFO):PX509;
-  _PKCS7_set_digest : function(p7:PPKCS7; md:PEVP_MD):longint;
-  _PKCS7_add_recipient : function(p7:PPKCS7; x509:PX509):PPKCS7_RECIP_INFO;
-  _PKCS7_add_recipient_info : function(p7:PPKCS7; ri:PPKCS7_RECIP_INFO):longint;
-  _PKCS7_RECIP_INFO_set : function(p7i:PPKCS7_RECIP_INFO; x509:PX509):longint;
-  _PKCS7_set_cipher : function(p7:PPKCS7; cipher:PEVP_CIPHER):longint;
-  _PKCS7_get_issuer_and_serial : function(p7:PPKCS7; idx:longint):PPKCS7_ISSUER_AND_SERIAL;
-  _PKCS7_digest_from_attributes : function(sk:Pstack_st_X509_ATTRIBUTE):Pointer;
-  _PKCS7_add_signed_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; _type:longint; data:pointer):longint;
-  _PKCS7_add_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; atrtype:longint; value:pointer):longint;
-  _PKCS7_get_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;
-  _PKCS7_get_signed_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;
-  _PKCS7_set_signed_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;
-  _PKCS7_set_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;
-  _PKCS7_sign : function(signcert:PX509; pkey:PEVP_PKEY; certs:Pstack_st_X509; data:PBIO; flags:longint):PPKCS7;
-  _PKCS7_sign_add_signer : function(p7:PPKCS7; signcert:PX509; pkey:PEVP_PKEY; md:PEVP_MD; flags:longint):PPKCS7_SIGNER_INFO;
-  _PKCS7_final : function(p7:PPKCS7; data:PBIO; flags:longint):longint;
-  _PKCS7_verify : function(p7:PPKCS7; certs:Pstack_st_X509; store: Pointer; indata:PBIO; _out:PBIO;  flags:longint):longint;
-  _PKCS7_encrypt : function(certs:Pstack_st_X509; _in:PBIO; cipher:PEVP_CIPHER; flags:longint):PPKCS7;
-  _PKCS7_decrypt : function(p7:PPKCS7; pkey:PEVP_PKEY; cert:PX509; data:PBIO; flags:longint):longint;
-  _PKCS7_add_attrib_smimecap : function(si:PPKCS7_SIGNER_INFO; cap:Pstack_st_X509_ALGOR):longint;
-  _PKCS7_simple_smimecap : function(sk:Pstack_st_X509_ALGOR; nid:longint; arg:longint):longint;
-  _PKCS7_add_attrib_content_type : function(si:PPKCS7_SIGNER_INFO; coid:Pointer):longint;
-  _PKCS7_add0_attrib_signing_time : function(si:PPKCS7_SIGNER_INFO; t:PASN1_TIME):longint;
-  _PKCS7_add1_attrib_digest : function(si:PPKCS7_SIGNER_INFO; md:Pbyte; mdlen:longint):longint;
-  _BIO_new_PKCS7 : function(_out:PBIO; p7:PPKCS7):PBIO;
-  _ERR_load_PKCS7_strings : procedure;
+  _PKCS7_ISSUER_AND_SERIAL_new : function: PPKCS7_ISSUER_AND_SERIAL;cdecl;
+  _PKCS7_ISSUER_AND_SERIAL_free : procedure(a:PPKCS7_ISSUER_AND_SERIAL);cdecl;
+  _PKCS7_ISSUER_AND_SERIAL_digest : function(data:PPKCS7_ISSUER_AND_SERIAL; _type:PEVP_MD; md:Pbyte; len:Pdword):longint;cdecl;
+  _PKCS7_dup : function(p7:PPKCS7):PPKCS7;cdecl;
+  _PEM_write_bio_PKCS7_stream : function(_out:PBIO; p7:PPKCS7; _in:PBIO; flags:longint):longint;cdecl;
+  _PKCS7_SIGNER_INFO_new : function:PPKCS7_SIGNER_INFO;cdecl;
+  _PKCS7_SIGNER_INFO_free : procedure(a:PPKCS7_SIGNER_INFO);cdecl;
+  _PKCS7_RECIP_INFO_new : function:PPKCS7_RECIP_INFO;cdecl;
+  _PKCS7_RECIP_INFO_free : procedure(a:PPKCS7_RECIP_INFO);cdecl;
+  _PKCS7_SIGNED_new : function:PPKCS7_SIGNED;cdecl;
+  _PKCS7_SIGNED_free : procedure(a:PPKCS7_SIGNED);cdecl;
+  _PKCS7_ENC_CONTENT_new : function:PPKCS7_ENC_CONTENT;cdecl;
+  _PKCS7_ENC_CONTENT_free : procedure(a:PPKCS7_ENC_CONTENT);cdecl;
+  _PKCS7_ENVELOPE_new : function:PPKCS7_ENVELOPE;cdecl;
+  _PKCS7_ENVELOPE_free : procedure(a:PPKCS7_ENVELOPE);cdecl;
+  _PKCS7_SIGN_ENVELOPE_new : function:PPKCS7_SIGN_ENVELOPE;cdecl;
+  _PKCS7_SIGN_ENVELOPE_free : procedure(a:PPKCS7_SIGN_ENVELOPE);cdecl;
+  _PKCS7_DIGEST_new : function:PPKCS7_DIGEST;cdecl;
+  _PKCS7_DIGEST_free : procedure(a:PPKCS7_DIGEST);cdecl;
+  _PKCS7_ENCRYPT_new : function:PPKCS7_ENCRYPT;cdecl;
+  _PKCS7_ENCRYPT_free : procedure(a:PPKCS7_ENCRYPT);cdecl;
+  _PKCS7_new : function:PPKCS7;cdecl;
+  _PKCS7_free : procedure(a:PPKCS7);cdecl;
+  _PKCS7_print_ctx : function(_out:PBIO; x:PPKCS7; indent:longint; pctx:Pointer):longint;cdecl;
+  _PKCS7_ctrl : function(p7:PPKCS7; cmd:longint; larg:longint; parg:Pchar):longint;cdecl;
+  _PKCS7_set_type : function(p7:PPKCS7; _type:longint):longint;cdecl;
+  _PKCS7_set0_type_other : function(p7:PPKCS7; _type:longint; other:PASN1_TYPE):longint;cdecl;
+  _PKCS7_set_content : function(p7:PPKCS7; p7_data:PPKCS7):longint;cdecl;
+  _PKCS7_SIGNER_INFO_set : function(p7i:PPKCS7_SIGNER_INFO; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):longint;cdecl;
+  _PKCS7_SIGNER_INFO_sign : function(si:PPKCS7_SIGNER_INFO):longint;cdecl;
+  _PKCS7_add_signer : function(p7:PPKCS7; p7i:PPKCS7_SIGNER_INFO):longint;cdecl;
+  _PKCS7_add_certificate : function(p7:PPKCS7; x509:PX509):longint;cdecl;
+  _PKCS7_add_crl : function(p7:PPKCS7; x509: Pointer):longint;cdecl;
+  _PKCS7_content_new : function(p7:PPKCS7; nid:longint):longint;cdecl;
+  _PKCS7_add_signature : function(p7:PPKCS7; x509:PX509; pkey:PEVP_PKEY; dgst:PEVP_MD):PPKCS7_SIGNER_INFO;cdecl;
+  _PKCS7_cert_from_signer_info : function(p7:PPKCS7; si:PPKCS7_SIGNER_INFO):PX509;cdecl;
+  _PKCS7_set_digest : function(p7:PPKCS7; md:PEVP_MD):longint;cdecl;
+  _PKCS7_add_recipient : function(p7:PPKCS7; x509:PX509):PPKCS7_RECIP_INFO;cdecl;
+  _PKCS7_add_recipient_info : function(p7:PPKCS7; ri:PPKCS7_RECIP_INFO):longint;cdecl;
+  _PKCS7_RECIP_INFO_set : function(p7i:PPKCS7_RECIP_INFO; x509:PX509):longint;cdecl;
+  _PKCS7_set_cipher : function(p7:PPKCS7; cipher:PEVP_CIPHER):longint;cdecl;
+  _PKCS7_get_issuer_and_serial : function(p7:PPKCS7; idx:longint):PPKCS7_ISSUER_AND_SERIAL;cdecl;
+  _PKCS7_digest_from_attributes : function(sk:Pstack_st_X509_ATTRIBUTE):Pointer;cdecl;
+  _PKCS7_add_signed_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; _type:longint; data:pointer):longint;cdecl;
+  _PKCS7_add_attribute : function(p7si:PPKCS7_SIGNER_INFO; nid:longint; atrtype:longint; value:pointer):longint;cdecl;
+  _PKCS7_get_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;cdecl;
+  _PKCS7_get_signed_attribute : function(si:PPKCS7_SIGNER_INFO; nid:longint):PASN1_TYPE;cdecl;
+  _PKCS7_set_signed_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;cdecl;
+  _PKCS7_set_attributes : function(p7si:PPKCS7_SIGNER_INFO; sk:Pstack_st_X509_ATTRIBUTE):longint;cdecl;
+  _PKCS7_sign : function(signcert:PX509; pkey:PEVP_PKEY; certs:Pstack_st_X509; data:PBIO; flags:longint):PPKCS7;cdecl;
+  _PKCS7_sign_add_signer : function(p7:PPKCS7; signcert:PX509; pkey:PEVP_PKEY; md:PEVP_MD; flags:longint):PPKCS7_SIGNER_INFO;cdecl;
+  _PKCS7_final : function(p7:PPKCS7; data:PBIO; flags:longint):longint;cdecl;
+  _PKCS7_verify : function(p7:PPKCS7; certs:Pstack_st_X509; store: Pointer; indata:PBIO; _out:PBIO;  flags:longint):longint;cdecl;
+  _PKCS7_encrypt : function(certs:Pstack_st_X509; _in:PBIO; cipher:PEVP_CIPHER; flags:longint):PPKCS7;cdecl;
+  _PKCS7_decrypt : function(p7:PPKCS7; pkey:PEVP_PKEY; cert:PX509; data:PBIO; flags:longint):longint;cdecl;
+  _PKCS7_add_attrib_smimecap : function(si:PPKCS7_SIGNER_INFO; cap:Pstack_st_X509_ALGOR):longint;cdecl;
+  _PKCS7_simple_smimecap : function(sk:Pstack_st_X509_ALGOR; nid:longint; arg:longint):longint;cdecl;
+  _PKCS7_add_attrib_content_type : function(si:PPKCS7_SIGNER_INFO; coid:Pointer):longint;cdecl;
+  _PKCS7_add0_attrib_signing_time : function(si:PPKCS7_SIGNER_INFO; t:PASN1_TIME):longint;cdecl;
+  _PKCS7_add1_attrib_digest : function(si:PPKCS7_SIGNER_INFO; md:Pbyte; mdlen:longint):longint;cdecl;
+  _BIO_new_PKCS7 : function(_out:PBIO; p7:PPKCS7):PBIO;cdecl;
+  _ERR_load_PKCS7_strings : procedure;cdecl;
 
 
   // BN
   // BN
   _BN_new : function():PBIGNUM; cdecl;
   _BN_new : function():PBIGNUM; cdecl;
@@ -3645,21 +3647,21 @@ end;
 
 
 function PEM_write_bio_PrivateKey(bp: pBIO; x: pEVP_PKEY;
 function PEM_write_bio_PrivateKey(bp: pBIO; x: pEVP_PKEY;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
                const enc: pEVP_CIPHER; kstr: PChar; klen: Integer; cb: Ppem_password_cb;
-               u: pointer): integer; 
+               u: pointer): integer;
 Begin
 Begin
    if InitSSLInterface and Assigned(_PEM_write_bio_PrivateKey) then
    if InitSSLInterface and Assigned(_PEM_write_bio_PrivateKey) then
     Result := _PEM_write_bio_PrivateKey(bp, x, enc ,kstr ,klen ,cb, u)
     Result := _PEM_write_bio_PrivateKey(bp, x, enc ,kstr ,klen ,cb, u)
   else
   else
     Result := -1;
     Result := -1;
-end;   
+end;
 
 
-function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer; 
+function PEM_write_bio_PUBKEY(bp: pBIO; x: pEVP_PKEY): integer;
 Begin
 Begin
    if InitSSLInterface and Assigned(_PEM_write_bio_PUBKEY) then
    if InitSSLInterface and Assigned(_PEM_write_bio_PUBKEY) then
     Result := _PEM_write_bio_PUBKEY(bp, x)
     Result := _PEM_write_bio_PUBKEY(bp, x)
   else
   else
     Result := -1;
     Result := -1;
-end; 
+end;
 
 
 function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
 function PEM_read_bio_X509(bp: PBIO; x: PPX509; cb: ppem_password_cb; u: pointer): PX509;
 begin
 begin
@@ -3677,6 +3679,15 @@ begin
     Result := 0;
     Result := 0;
 end;
 end;
 
 
+function PEM_write_bio_PKCS7(bp : PBIO; x : PPKCS7) : cint;
+
+begin
+  if InitSSLInterface and Assigned(_PEM_write_bio_PKCS7) then
+    Result := _PEM_write_bio_PKCS7(bp, x)
+  else
+    Result := 0;
+end;
+
 
 
 // BIO Functions
 // BIO Functions
 
 
@@ -4613,14 +4624,14 @@ var
   i: cInt;
   i: cInt;
 begin
 begin
   Result := NilHandle;
   Result := NilHandle;
-  
+
   for i := Low(DLLVersions) to High(DLLVersions) do begin
   for i := Low(DLLVersions) to High(DLLVersions) do begin
     {$IFDEF DARWIN}
     {$IFDEF DARWIN}
     Result := LoadLibrary(Value + DLLVersions[i] + '.dylib');
     Result := LoadLibrary(Value + DLLVersions[i] + '.dylib');
     {$ELSE}
     {$ELSE}
     Result := LoadLibrary(Value + '.so' + DLLVersions[i]);
     Result := LoadLibrary(Value + '.so' + DLLVersions[i]);
     {$ENDIF}
     {$ENDIF}
-    
+
     if Result <> NilHandle then
     if Result <> NilHandle then
       Break;
       Break;
   end;
   end;
@@ -4869,7 +4880,7 @@ begin
   _PEM_write_bio_PUBKEY := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PUBKEY');
   _PEM_write_bio_PUBKEY := GetProcAddr(SSLUtilHandle, 'PEM_write_bio_PUBKEY');
   _PEM_read_bio_X509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509');
   _PEM_read_bio_X509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509');
   _PEM_write_bio_X509 := GetProcAddr(SSLUtilHandle,'PEM_write_bio_X509');
   _PEM_write_bio_X509 := GetProcAddr(SSLUtilHandle,'PEM_write_bio_X509');
-
+  _PEM_write_bio_PKCS7 := GetProcAddr(SSLUtilHandle,'PEM_write_bio_PKCS7');
   // BIO
   // BIO
   _BIO_ctrl := GetProcAddr(SSLUtilHandle, 'BIO_ctrl');
   _BIO_ctrl := GetProcAddr(SSLUtilHandle, 'BIO_ctrl');
   _BIO_s_file := GetProcAddr(SSLUtilHandle, 'BIO_s_file');
   _BIO_s_file := GetProcAddr(SSLUtilHandle, 'BIO_s_file');
@@ -5333,6 +5344,7 @@ begin
   _PEM_write_bio_PrivateKey := nil;
   _PEM_write_bio_PrivateKey := nil;
   _PEM_read_bio_X509 := nil;
   _PEM_read_bio_X509 := nil;
   _PEM_write_bio_X509 := nil;
   _PEM_write_bio_X509 := nil;
+  _PEM_write_bio_PKCS7 := nil;
 
 
   // BIO
   // BIO
 
 

Разлика између датотеке није приказан због своје велике величине
+ 276 - 140
packages/pastojs/src/fppas2js.pp


+ 10 - 2
packages/pastojs/src/pas2jscompiler.pp

@@ -1138,6 +1138,7 @@ begin
     Result:=UseAnalyzer.IsUsed(El)
     Result:=UseAnalyzer.IsUsed(El)
   else
   else
     Result:=true;
     Result:=true;
+  if Sender=nil then ;
 end;
 end;
 
 
 function TPas2jsCompilerFile.OnConverterIsTypeInfoUsed(Sender: TObject;
 function TPas2jsCompilerFile.OnConverterIsTypeInfoUsed(Sender: TObject;
@@ -1150,6 +1151,7 @@ begin
     Result:=UseAnalyzer.IsTypeInfoUsed(El)
     Result:=UseAnalyzer.IsTypeInfoUsed(El)
   else
   else
     Result:=true;
     Result:=true;
+  if Sender=nil then ;
 end;
 end;
 
 
 procedure TPas2jsCompilerFile.OnPasResolverLog(Sender: TObject; const Msg: String);
 procedure TPas2jsCompilerFile.OnPasResolverLog(Sender: TObject; const Msg: String);
@@ -1160,6 +1162,7 @@ begin
   aResolver:=TPasResolver(Sender);
   aResolver:=TPasResolver(Sender);
   DoLogMsgAtEl(aResolver.LastMsgType,aResolver.LastMsg,aResolver.LastMsgNumber,
   DoLogMsgAtEl(aResolver.LastMsgType,aResolver.LastMsg,aResolver.LastMsgNumber,
           aResolver.LastElement);
           aResolver.LastElement);
+  if Sender=nil then ;
 end;
 end;
 
 
 procedure TPas2jsCompilerFile.OnParserLog(Sender: TObject; const Msg: String);
 procedure TPas2jsCompilerFile.OnParserLog(Sender: TObject; const Msg: String);
@@ -1172,6 +1175,7 @@ begin
   aScanner:=aParser.Scanner;
   aScanner:=aParser.Scanner;
   Log.Log(aParser.LastMsgType,aParser.LastMsg,aParser.LastMsgNumber,
   Log.Log(aParser.LastMsgType,aParser.LastMsg,aParser.LastMsgNumber,
           aScanner.CurFilename,aScanner.CurRow,aScanner.CurColumn);
           aScanner.CurFilename,aScanner.CurRow,aScanner.CurColumn);
+  if Sender=nil then ;
 end;
 end;
 
 
 procedure TPas2jsCompilerFile.OnScannerLog(Sender: TObject; const Msg: String);
 procedure TPas2jsCompilerFile.OnScannerLog(Sender: TObject; const Msg: String);
@@ -1182,12 +1186,14 @@ begin
   aScanner:=TPas2jsPasScanner(Sender);
   aScanner:=TPas2jsPasScanner(Sender);
   Log.Log(aScanner.LastMsgType,aScanner.LastMsg,aScanner.LastMsgNumber,
   Log.Log(aScanner.LastMsgType,aScanner.LastMsg,aScanner.LastMsgNumber,
           aScanner.CurFilename,aScanner.CurRow,aScanner.CurColumn);
           aScanner.CurFilename,aScanner.CurRow,aScanner.CurColumn);
+  if Sender=nil then ;
 end;
 end;
 
 
 procedure TPas2jsCompilerFile.OnUseAnalyzerMessage(Sender: TObject;
 procedure TPas2jsCompilerFile.OnUseAnalyzerMessage(Sender: TObject;
   Msg: TPAMessage);
   Msg: TPAMessage);
 begin
 begin
   Log.Log(Msg.MsgType,Msg.MsgText,Msg.MsgNumber,Msg.Filename,Msg.Row,Msg.Col);
   Log.Log(Msg.MsgType,Msg.MsgText,Msg.MsgNumber,Msg.Filename,Msg.Row,Msg.Col);
+  if Sender=nil then ;
 end;
 end;
 
 
 procedure TPas2jsCompilerFile.HandleEParserError(E: EParserError);
 procedure TPas2jsCompilerFile.HandleEParserError(E: EParserError);
@@ -1710,6 +1716,7 @@ begin
     exit(true);
     exit(true);
   end;
   end;
 
 
+  if Sender=nil then ;
   Result:=false;
   Result:=false;
 end;
 end;
 
 
@@ -3801,6 +3808,7 @@ function TPas2jsCompiler.OnMacroCfgDir(Sender: TObject; var Params: string;
   Lvl: integer): boolean;
   Lvl: integer): boolean;
 begin
 begin
   if Lvl=0 then ;
   if Lvl=0 then ;
+  if Sender=nil then ;
   Params:=ExtractFilePath(ConfigSupport.CurrentCfgFilename);
   Params:=ExtractFilePath(ConfigSupport.CurrentCfgFilename);
   Result:=true;
   Result:=true;
 end;
 end;
@@ -4245,8 +4253,8 @@ begin
   w('    m    : Enables macro replacements');
   w('    m    : Enables macro replacements');
   w('    2    : Same as -Mobjfpc (default)');
   w('    2    : Same as -Mobjfpc (default)');
   w('  -SI<x>  : Set interface style to <x>');
   w('  -SI<x>  : Set interface style to <x>');
-  w('    -SIcom  : COM compatible interface (default)');
-  w('    -SIcorba: CORBA compatible interface');
+  w('    -SIcom  : COM, reference counted interface (default)');
+  w('    -SIcorba: CORBA interface');
   w('  -T<x>  : Set target platform');
   w('  -T<x>  : Set target platform');
   w('    -Tbrowser: default');
   w('    -Tbrowser: default');
   w('    -Tnodejs : add pas.run(), includes -Jc');
   w('    -Tnodejs : add pas.run(), includes -Jc');

+ 31 - 17
packages/pastojs/src/pas2jsfiler.pp

@@ -71,12 +71,13 @@ uses
 
 
 const
 const
   PCUMagic = 'Pas2JSCache';
   PCUMagic = 'Pas2JSCache';
-  PCUVersion = 2;
+  PCUVersion = 3;
   { Version Changes:
   { Version Changes:
     1: initial version
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
        - pcsfAncestorResolved
        - pcsfAncestorResolved
        - removed msIgnoreInterfaces
        - removed msIgnoreInterfaces
+    3: changed records from function to objects
   }
   }
 
 
   BuiltInNodeName = 'BuiltIn';
   BuiltInNodeName = 'BuiltIn';
@@ -430,7 +431,8 @@ const
     'LogicalNot',
     'LogicalNot',
     'LogicalXor',
     'LogicalXor',
     'RightShift',
     'RightShift',
-    'Enumerator'
+    'Enumerator',
+    'In'
     );
     );
 
 
   PCUProcedureModifierNames: array[TProcedureModifier] of string = (
   PCUProcedureModifierNames: array[TProcedureModifier] of string = (
@@ -842,6 +844,7 @@ type
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
     procedure Set_Variant_Members(RefEl: TPasElement; Data: TObject);
     procedure Set_Variant_Members(RefEl: TPasElement; Data: TObject);
     procedure Set_RecordType_VariantEl(RefEl: TPasElement; Data: TObject);
     procedure Set_RecordType_VariantEl(RefEl: TPasElement; Data: TObject);
+    procedure Set_RecordScope_DefaultProperty(RefEl: TPasElement; Data: TObject);
     procedure Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
     procedure Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_NewInstanceFunction(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_NewInstanceFunction(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_DirectAncestor(RefEl: TPasElement; Data: TObject);
     procedure Set_ClassScope_DirectAncestor(RefEl: TPasElement; Data: TObject);
@@ -1699,11 +1702,11 @@ var
   El: TPasElement;
   El: TPasElement;
 begin
 begin
   El:=Scope.Element;
   El:=Scope.Element;
-  if El is TPasClassType then
+  if El is TPasMembersType then
     Result:=El
     Result:=El
   else if El is TPasModule then
   else if El is TPasModule then
     Result:=El
     Result:=El
-  else if (Scope is TPasProcedureScope) and (Scope.Element.Parent is TPasClassType) then
+  else if (Scope is TPasProcedureScope) and (Scope.Element.Parent is TPasMembersType) then
     Result:=Scope.Element.Parent
     Result:=Scope.Element.Parent
   else
   else
     Result:=nil;
     Result:=nil;
@@ -3324,6 +3327,7 @@ end;
 procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
 procedure TPCUWriter.WriteRecordTypeScope(Obj: TJSONObject;
   Scope: TPasRecordScope; aContext: TPCUWriterContext);
   Scope: TPasRecordScope; aContext: TPCUWriterContext);
 begin
 begin
+  AddReferenceToObj(Obj,'DefaultProperty',Scope.DefaultProperty);
   WriteIdentifierScope(Obj,Scope,aContext);
   WriteIdentifierScope(Obj,Scope,aContext);
 end;
 end;
 
 
@@ -3829,10 +3833,9 @@ begin
   C:=Parent.ClassType;
   C:=Parent.ClassType;
   if C.InheritsFrom(TPasDeclarations) then
   if C.InheritsFrom(TPasDeclarations) then
     WriteMemberIndex(TPasDeclarations(Parent).Declarations,Ref.Element,Ref.Obj)
     WriteMemberIndex(TPasDeclarations(Parent).Declarations,Ref.Element,Ref.Obj)
-  else if C=TPasClassType then
-    WriteMemberIndex(TPasClassType(Parent).Members,Ref.Element,Ref.Obj)
-  else if C=TPasRecordType then
-    WriteMemberIndex(TPasRecordType(Parent).Members,Ref.Element,Ref.Obj)
+  else if (C=TPasClassType)
+      or (C=TPasRecordType) then
+    WriteMemberIndex(TPasMembersType(Parent).Members,Ref.Element,Ref.Obj)
   else if C=TPasEnumType then
   else if C=TPasEnumType then
     WriteMemberIndex(TPasEnumType(Parent).Values,Ref.Element,Ref.Obj)
     WriteMemberIndex(TPasEnumType(Parent).Values,Ref.Element,Ref.Obj)
   else if C.InheritsFrom(TPasModule) then
   else if C.InheritsFrom(TPasModule) then
@@ -4212,6 +4215,17 @@ begin
     RaiseMsg(20180210205031,El,GetObjName(RefEl));
     RaiseMsg(20180210205031,El,GetObjName(RefEl));
 end;
 end;
 
 
+procedure TPCUReader.Set_RecordScope_DefaultProperty(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPasRecordScope absolute Data;
+begin
+  if RefEl is TPasProperty then
+    Scope.DefaultProperty:=TPasProperty(RefEl) // no AddRef
+  else
+    RaiseMsg(20190106213412,Scope.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
 procedure TPCUReader.Set_Argument_ArgType(RefEl: TPasElement; Data: TObject);
 var
 var
   El: TPasArgument absolute Data;
   El: TPasArgument absolute Data;
@@ -5230,10 +5244,8 @@ begin
     begin
     begin
     if El is TPasDeclarations then
     if El is TPasDeclarations then
       ReadExternalMembers(El,Arr,TPasDeclarations(El).Declarations)
       ReadExternalMembers(El,Arr,TPasDeclarations(El).Declarations)
-    else if El is TPasClassType then
-      ReadExternalMembers(El,Arr,TPasClassType(El).Members)
-    else if El is TPasRecordType then
-      ReadExternalMembers(El,Arr,TPasRecordType(El).Members)
+    else if El is TPasMembersType then
+      ReadExternalMembers(El,Arr,TPasMembersType(El).Members)
     else if El is TPasEnumType then
     else if El is TPasEnumType then
       ReadExternalMembers(El,Arr,TPasEnumType(El).Values)
       ReadExternalMembers(El,Arr,TPasEnumType(El).Values)
     else if El is TPasModule then
     else if El is TPasModule then
@@ -5459,9 +5471,7 @@ begin
       Section.ResStrings.Add(El)
       Section.ResStrings.Add(El)
     else if C=TPasConst then
     else if C=TPasConst then
       Section.Consts.Add(El)
       Section.Consts.Add(El)
-    else if C=TPasClassType then
-      Section.Classes.Add(El)
-    else if C=TPasRecordType then
+    else if (C=TPasClassType) or (C=TPasRecordType) then
       Section.Classes.Add(El)
       Section.Classes.Add(El)
     else if C.InheritsFrom(TPasType) then
     else if C.InheritsFrom(TPasType) then
       // not TPasClassType, TPasRecordType !
       // not TPasClassType, TPasRecordType !
@@ -6615,6 +6625,7 @@ end;
 procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
 procedure TPCUReader.ReadRecordScope(Obj: TJSONObject; Scope: TPasRecordScope;
   aContext: TPCUReaderContext);
   aContext: TPCUReaderContext);
 begin
 begin
+  ReadElementReference(Obj,Scope,'DefaultProperty',@Set_RecordScope_DefaultProperty);
   ReadIdentifierScope(Obj,Scope,aContext);
   ReadIdentifierScope(Obj,Scope,aContext);
 end;
 end;
 
 
@@ -6625,6 +6636,9 @@ var
   Id: Integer;
   Id: Integer;
   Scope: TPasRecordScope;
   Scope: TPasRecordScope;
 begin
 begin
+  if FileVersion<3 then
+    RaiseMsg(20190109214718,El,'record format changed');
+
   Scope:=TPasRecordScope(Resolver.CreateScope(El,TPasRecordScope));
   Scope:=TPasRecordScope(Resolver.CreateScope(El,TPasRecordScope));
   El.CustomData:=Scope;
   El.CustomData:=Scope;
 
 
@@ -7313,8 +7327,8 @@ begin
   // Scope.OverloadName is already set in ReadProcedure
   // Scope.OverloadName is already set in ReadProcedure
   ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
   ReadElementReference(Obj,Scope,'ImplProc',@Set_ProcedureScope_ImplProc);
   ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
   ReadElementReference(Obj,Scope,'Overridden',@Set_ProcedureScope_Overridden);
-  if Proc.Parent is TPasClassType then
-    Scope.ClassScope:=Proc.Parent.CustomData as TPas2JSClassScope; // no AddRef
+  if Proc.Parent is TPasMembersType then
+    Scope.ClassOrRecordScope:=Proc.Parent.CustomData as TPasClassOrRecordScope; // no AddRef
   // ClassScope: TPasClassScope; auto derived
   // ClassScope: TPasClassScope; auto derived
   // Scope.SelfArg only valid for method implementation
   // Scope.SelfArg only valid for method implementation
 
 

+ 2 - 1
packages/pastojs/src/pas2jsfscompiler.pp

@@ -27,7 +27,7 @@ uses
   PasUseAnalyzer,
   PasUseAnalyzer,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2JSFS,
   Pas2JSFS,
-  FPPas2Js, Pas2jsFileUtils;
+  Pas2jsFileUtils;
 
 
 Type
 Type
   TPas2jsFSCompiler = Class(TPas2JSCompiler)
   TPas2jsFSCompiler = Class(TPas2JSCompiler)
@@ -121,6 +121,7 @@ function TPas2jsFSCompiler.OnMacroEnv(Sender: TObject; var Params: string;
   Lvl: integer): boolean;
   Lvl: integer): boolean;
 begin
 begin
   if Lvl=0 then ;
   if Lvl=0 then ;
+  if Sender=nil then ;
   Params:=GetEnvironmentVariablePJ(Params);
   Params:=GetEnvironmentVariablePJ(Params);
   Result:=true;
   Result:=true;
 end;
 end;

+ 36 - 1
packages/pastojs/tests/tcfiler.pas

@@ -143,6 +143,7 @@ type
     procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_SetOfAnonymousEnumType;
     procedure TestPC_Record;
     procedure TestPC_Record;
     procedure TestPC_Record_InFunction;
     procedure TestPC_Record_InFunction;
+    procedure TestPC_RecordAdv;
     procedure TestPC_JSValue;
     procedure TestPC_JSValue;
     procedure TestPC_Array;
     procedure TestPC_Array;
     procedure TestPC_ArrayOfAnonymous;
     procedure TestPC_ArrayOfAnonymous;
@@ -705,6 +706,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
 procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
   Orig, Rest: TPasRecordScope);
   Orig, Rest: TPasRecordScope);
 begin
 begin
+  CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
   CheckRestoredIdentifierScope(Path,Orig,Rest);
 end;
 end;
 
 
@@ -808,7 +810,7 @@ begin
     AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
     AssertEquals(Path+'.ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
     CheckRestoredReference(Path+'.OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
     CheckRestoredReference(Path+'.OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
 
 
-    CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassScope,Rest.ClassScope);
+    CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassOrRecordScope,Rest.ClassOrRecordScope);
     CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
     CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
     if Orig.Flags<>Rest.Flags then
     if Orig.Flags<>Rest.Flags then
       Fail(Path+'.Flags');
       Fail(Path+'.Flags');
@@ -1753,6 +1755,39 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
+procedure TTestPrecompile.TestPC_RecordAdv;
+begin
+  StartUnit(false);
+  Add([
+  '{$ModeSwitch advancedrecords}',
+  'interface',
+  'type',
+  '  TRec = record',
+  '  private',
+  '    FInt: longint;',
+  '    procedure SetInt(Value: longint);',
+  '    function GetItems(Value: word): word;',
+  '    procedure SetItems(Index, Value: word);',
+  '  public',
+  '    property Int: longint read FInt write SetInt default 3;',
+  '    property Items[Index: word]: word read GetItems write SetItems; default;',
+  '  end;',
+  'var',
+  '  r: trec;',
+  'implementation',
+  'procedure TRec.SetInt(Value: longint);',
+  'begin',
+  'end;',
+  'function TRec.GetItems(Value: word): word;',
+  'begin',
+  'end;',
+  'procedure TRec.SetItems(Index, Value: word);',
+  'begin',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_JSValue;
 procedure TTestPrecompile.TestPC_JSValue;
 begin
 begin
   StartUnit(false);
   StartUnit(false);

Разлика између датотеке није приказан због своје велике величине
+ 968 - 368
packages/pastojs/tests/tcmodules.pas


+ 10 - 9
packages/pastojs/tests/tcoptimizations.pas

@@ -387,17 +387,17 @@ begin
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestWPO_OmitRecordMember',
   CheckSource('TestWPO_OmitRecordMember',
     LinesToStr([
     LinesToStr([
-    'this.TRec = function (s) {',
-    '  if (s) {',
-    '    this.a = s.a;',
-    '  } else {',
-    '    this.a = 0;',
-    '  };',
-    '  this.$equal = function (b) {',
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.a = 0;',
+    '  this.$eq = function (b) {',
     '    return this.a === b.a;',
     '    return this.a === b.a;',
     '  };',
     '  };',
-    '};',
-    'this.r = new $mod.TRec();',
+    '  this.$assign = function (s) {',
+    '    this.a = s.a;',
+    '    return this;',
+    '  };',
+    '});',
+    'this.r = $mod.TRec.$new();',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
     '$mod.r.a = 3;',
     '$mod.r.a = 3;',
@@ -936,6 +936,7 @@ begin
   '    };',
   '    };',
   '    this.Create = function (AColor) {',
   '    this.Create = function (AColor) {',
   '      this.FColor = AColor;',
   '      this.FColor = AColor;',
+  '      return this;',
   '    };',
   '    };',
   '  });',
   '  });',
   '  this.T = null;',
   '  this.T = null;',

+ 2 - 2
packages/rtl-console/src/unix/crt.pp

@@ -14,7 +14,7 @@
 unit Crt;
 unit Crt;
 
 
 Interface
 Interface
-
+{$mode fpc} // Shortstring is assumed
 {$i crth.inc}
 {$i crth.inc}
 
 
 Const
 Const
@@ -1263,8 +1263,8 @@ Begin
      i:=F.BufPos;
      i:=F.BufPos;
      if i>255 then
      if i>255 then
       i:=255;
       i:=255;
-     Move(F.BufPTR^[idx],Temp[1],i);
      SetLength(Temp,i);
      SetLength(Temp,i);
+     Move(F.BufPTR^[idx],Temp[1],i);
      DoWrite(Temp);
      DoWrite(Temp);
      dec(F.BufPos,i);
      dec(F.BufPos,i);
      inc(idx,i);
      inc(idx,i);

+ 1 - 1
packages/rtl-console/src/win/keyboard.pp

@@ -637,7 +637,7 @@ CONST
    (n : $00; s : $00; c : $00; a: $81),      {0B 0 }
    (n : $00; s : $00; c : $00; a: $81),      {0B 0 }
    (n : $00; s : $00; c : $00; a: $82),      {0C ß }
    (n : $00; s : $00; c : $00; a: $82),      {0C ß }
    (n : $00; s : $00; c : $00; a: $00),      {0D}
    (n : $00; s : $00; c : $00; a: $00),      {0D}
-   (n : $00; s : $09; c : $00; a: $00),      {0E Backspace}
+   (n : $00; s : $00; c : $00; a: $00),      {0E Backspace}
    (n : $00; s : $0F; c : $94; a: $00));     {0F Tab }
    (n : $00; s : $0F; c : $94; a: $00));     {0F Tab }
 
 
 
 

+ 1 - 1
packages/rtl-extra/src/unix/ipc.pp

@@ -179,7 +179,7 @@ type
         cgid  : kernel_gid_t;
         cgid  : kernel_gid_t;
         mode  : kernel_mode_t;
         mode  : kernel_mode_t;
 {$if sizeof(kernel_mode_t) < 4}
 {$if sizeof(kernel_mode_t) < 4}
-        __pad1    : array[1..4-sizeof(mode_t)];
+        __pad1    : array[1..4-sizeof(mode_t)] of byte;
 {$endif}
 {$endif}
 {$ifdef cpupowerpc}
 {$ifdef cpupowerpc}
         seq       : cuint;
         seq       : cuint;

+ 1 - 1
rtl/darwin/x86/x86hnd.inc

@@ -95,7 +95,7 @@ begin
       { the ABI expects the stack pointer to be 4 bytes off alignment }
       { the ABI expects the stack pointer to be 4 bytes off alignment }
       { due to the return address which has been pushed -- but take into account
       { due to the return address which has been pushed -- but take into account
         that esp may already unaligned in case of a leaf routine }
         that esp may already unaligned in case of a leaf routine }
-      if (sigcontext^.uc_mcontext^.ts.rsp and 15)=0 then
+      if (sigcontext^.uc_mcontext^.ts.esp and 15)=0 then
         dec(sigcontext^.uc_mcontext^.ts.esp,sizeof(pointer));
         dec(sigcontext^.uc_mcontext^.ts.esp,sizeof(pointer));
       { return to run time error handler }
       { return to run time error handler }
       sigcontext^.uc_mcontext^.ts.eip:=ptruint(@HandleErrorAddrFrame);
       sigcontext^.uc_mcontext^.ts.eip:=ptruint(@HandleErrorAddrFrame);

+ 1 - 1
rtl/embedded/Makefile

@@ -376,7 +376,7 @@ CPU_UNITS=lpc8xx lpc11xx lpc122x stm32f0xx nrf51 cortexm0
 CPU_UNITS_DEFINED=1
 CPU_UNITS_DEFINED=1
 endif
 endif
 ifeq ($(SUBARCH),armv7a)
 ifeq ($(SUBARCH),armv7a)
-CPU_UNITS=allwinner_a20 vexpress_a15
+CPU_UNITS=allwinner_a20
 CPU_UNITS_DEFINED=1
 CPU_UNITS_DEFINED=1
 endif
 endif
 ifeq ($(CPU_UNITS_DEFINED),)
 ifeq ($(CPU_UNITS_DEFINED),)

+ 1 - 0
rtl/embedded/system.pp

@@ -197,6 +197,7 @@ const calculated_cmdline:Pchar=nil;
 {$endif FPC_HAS_FEATURE_SOFTFPU}
 {$endif FPC_HAS_FEATURE_SOFTFPU}
 {$endif FPUNONE}
 {$endif FPUNONE}
 
 
+{$define FPC_SYSTEM_EXIT_NO_RETURN}
 {$I system.inc}
 {$I system.inc}
 
 
 {*****************************************************************************
 {*****************************************************************************

+ 93 - 99
rtl/haiku/Makefile

@@ -338,7 +338,7 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU_TARGET)
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNIXINC=$(RTL)/unix
 HAIKUINC=$(RTL)/haiku
 HAIKUINC=$(RTL)/haiku
-LOADERS=prt0 cprt0 dllcprt0 func dllprt
+LOADERS=cprt0 dllcprt0
 CPUUNITS=mmx
 CPUUNITS=mmx
 SYSINITUNITS=si_c si_dllc
 SYSINITUNITS=si_c si_dllc
 UNITPREFIX=rtl
 UNITPREFIX=rtl
@@ -353,280 +353,280 @@ override FPCOPT+=-dFPC_USE_LIBC
 OBJPASDIR=$(RTL)/objpas
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 GRAPHDIR=$(INC)/graph
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-win32)
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-os2)
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-beos)
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netware)
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-emx)
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-wince)
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-android)
 ifeq ($(FULL_TARGET),i386-android)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-aros)
 ifeq ($(FULL_TARGET),i386-aros)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-macos)
 ifeq ($(FULL_TARGET),m68k-macos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc-aix)
 ifeq ($(FULL_TARGET),powerpc-aix)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-haiku)
 ifeq ($(FULL_TARGET),x86_64-haiku)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
 ifeq ($(FULL_TARGET),x86_64-netbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-openbsd)
 ifeq ($(FULL_TARGET),x86_64-openbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-android)
 ifeq ($(FULL_TARGET),x86_64-android)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-aros)
 ifeq ($(FULL_TARGET),x86_64-aros)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-linux)
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-netbsd)
 ifeq ($(FULL_TARGET),arm-netbsd)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-wince)
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-gba)
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-nds)
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-android)
 ifeq ($(FULL_TARGET),arm-android)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),arm-aros)
 ifeq ($(FULL_TARGET),arm-aros)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),powerpc64-aix)
 ifeq ($(FULL_TARGET),powerpc64-aix)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),mips-linux)
 ifeq ($(FULL_TARGET),mips-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(FULL_TARGET),mipsel-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),mipsel-android)
 ifeq ($(FULL_TARGET),mipsel-android)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),jvm-java)
 ifeq ($(FULL_TARGET),jvm-java)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),jvm-android)
 ifeq ($(FULL_TARGET),jvm-android)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i8086-embedded)
 ifeq ($(FULL_TARGET),i8086-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 ifeq ($(FULL_TARGET),i8086-msdos)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i8086-win16)
 ifeq ($(FULL_TARGET),i8086-win16)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),aarch64-linux)
 ifeq ($(FULL_TARGET),aarch64-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
 ifeq ($(FULL_TARGET),aarch64-darwin)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),aarch64-android)
 ifeq ($(FULL_TARGET),aarch64-android)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),wasm-wasm)
 ifeq ($(FULL_TARGET),wasm-wasm)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),sparc64-linux)
 ifeq ($(FULL_TARGET),sparc64-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),riscv32-linux)
 ifeq ($(FULL_TARGET),riscv32-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),riscv32-embedded)
 ifeq ($(FULL_TARGET),riscv32-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),riscv64-linux)
 ifeq ($(FULL_TARGET),riscv64-linux)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),riscv64-embedded)
 ifeq ($(FULL_TARGET),riscv64-embedded)
-override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts syscall unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
+override TARGET_UNITS+=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings errors dos dl sysconst sysutils types charset cpall character typinfo classes fgl math cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf rtlconsts unix unixutil termio initc cmem dynlibs cwstring cthreads fpintres unixcp fpwidestring
 endif
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_IMPLICITUNITS+=exeinfo cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 cp437 cp646 cp737 cp775 cp850 cp852 cp855 cp856 cp857 cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 cp874 cp3021 cp8859_1 cp8859_2 cp8859_3 cp8859_4 cp8859_5 cp8859_6 cp8859_7 cp8859_8 cp8859_9 cp8859_10 cp8859_11 cp8859_13 cp8859_14 cp8859_15 cp8859_16 cpkoi8_r cpkoi8_u unicodedata unicodenumtable
 override TARGET_IMPLICITUNITS+=exeinfo cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 cp437 cp646 cp737 cp775 cp850 cp852 cp855 cp856 cp857 cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 cp874 cp3021 cp8859_1 cp8859_2 cp8859_3 cp8859_4 cp8859_5 cp8859_6 cp8859_7 cp8859_8 cp8859_9 cp8859_10 cp8859_11 cp8859_13 cp8859_14 cp8859_15 cp8859_16 cpkoi8_r cpkoi8_u unicodedata unicodenumtable
@@ -3518,16 +3518,10 @@ include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 SYSTEMUNIT=system
 SYSTEMUNIT=system
-prt0$(OEXT) : $(CPU_TARGET)/prt0.as
-	$(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
 dllcprt0$(OEXT) : $(CPU_TARGET)/dllcprt0.as
 dllcprt0$(OEXT) : $(CPU_TARGET)/dllcprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)dllcprt0$(OEXT) $(CPU_TARGET)/dllcprt0.as
 	$(AS) -o $(UNITTARGETDIRPREFIX)dllcprt0$(OEXT) $(CPU_TARGET)/dllcprt0.as
-func$(OEXT) : $(CPU_TARGET)/func.as
-	$(AS) -o $(UNITTARGETDIRPREFIX)func$(OEXT) $(CPU_TARGET)/func.as
-dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
-	$(AS) -o $(UNITTARGETDIRPREFIX)dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
 system$(PPUEXT) : system.pp $(SYSDEPS) $(UNIXINC)/sysunixh.inc
 system$(PPUEXT) : system.pp $(SYSDEPS) $(UNIXINC)/sysunixh.inc
 	$(COMPILER) $(FPC_SYSTEM_OPT) -Us -Sg $(SYSTEMUNIT).pp
 	$(COMPILER) $(FPC_SYSTEM_OPT) -Us -Sg $(SYSTEMUNIT).pp
 uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
 uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp

+ 5 - 11
rtl/haiku/Makefile.fpc

@@ -8,15 +8,17 @@ main=rtl
 [target]
 [target]
 loaders=$(LOADERS)
 loaders=$(LOADERS)
 units=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings \
 units=system $(SYSINITUNITS) uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings \
-#      beos \
       errors dos dl \
       errors dos dl \
       sysconst sysutils \
       sysconst sysutils \
       types charset cpall character typinfo classes fgl math \
       types charset cpall character typinfo classes fgl math \
       cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf \
       cpu $(CPUUNITS) getopts heaptrc lineinfo lnfodwrf \
-      rtlconsts syscall unix unixutil termio initc \
+      rtlconsts unix unixutil termio initc \
       cmem \
       cmem \
       dynlibs cwstring cthreads \
       dynlibs cwstring cthreads \
       fpintres unixcp fpwidestring
       fpintres unixcp fpwidestring
+
+# beos syscall
+
 rsts=math typinfo sysconst rtlconsts
 rsts=math typinfo sysconst rtlconsts
 implicitunits=exeinfo \
 implicitunits=exeinfo \
       cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
       cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
@@ -59,7 +61,7 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU_TARGET)
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNIXINC=$(RTL)/unix
 HAIKUINC=$(RTL)/haiku
 HAIKUINC=$(RTL)/haiku
-LOADERS=prt0 cprt0 dllcprt0 func dllprt
+LOADERS=cprt0 dllcprt0
 CPUUNITS=mmx
 CPUUNITS=mmx
 SYSINITUNITS=si_c si_dllc
 SYSINITUNITS=si_c si_dllc
 UNITPREFIX=rtl
 UNITPREFIX=rtl
@@ -103,8 +105,6 @@ SYSTEMUNIT=system
 # Loaders
 # Loaders
 #
 #
 
 
-prt0$(OEXT) : $(CPU_TARGET)/prt0.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
 
 
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
@@ -112,12 +112,6 @@ cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 dllcprt0$(OEXT) : $(CPU_TARGET)/dllcprt0.as
 dllcprt0$(OEXT) : $(CPU_TARGET)/dllcprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)dllcprt0$(OEXT) $(CPU_TARGET)/dllcprt0.as
         $(AS) -o $(UNITTARGETDIRPREFIX)dllcprt0$(OEXT) $(CPU_TARGET)/dllcprt0.as
 
 
-func$(OEXT) : $(CPU_TARGET)/func.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)func$(OEXT) $(CPU_TARGET)/func.as
-
-dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
-
 #
 #
 # system Units (system, Objpas, Strings)
 # system Units (system, Objpas, Strings)
 #
 #

+ 13 - 82
rtl/haiku/baseunix.pp

@@ -25,39 +25,22 @@ Uses UnixType;
 
 
 {$packrecords C}
 {$packrecords C}
 
 
-{$ifndef FPC_USE_LIBC}
-  {$define FPC_USE_SYSCALL}
-{$endif}
-
 {$i errno.inc}          { Error numbers }
 {$i errno.inc}          { Error numbers }
 {$i ostypes.inc}
 {$i ostypes.inc}
 
 
-{$ifdef FPC_USE_LIBC}
-  const clib = 'root';
-  const netlib = 'network';
-  {$i oscdeclh.inc}
-{$ELSE}
-  {$i bunxh.inc}		{ Functions}
-{$ENDIF}
+const
+  clib = 'root';
+  netlib = 'network';
 
 
-function fpgeterrno:longint; 
-procedure fpseterrno(err:longint); 
+{$i oscdeclh.inc}
 
 
-{$ifndef ver1_0}
-property errno : cint read fpgeterrno write fpseterrno;
-{$endif}
+  function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+  procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+  property errno : cint read fpgeterrno write fpseterrno;
 
 
 {$i bunxovlh.inc}
 {$i bunxovlh.inc}
 
 
-{$ifdef FPC_USE_LIBC}
-{$ifdef beos}
-function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
-Function fpFlock (var fd : text; mode : longint) : cint; 
-Function fpFlock (var fd : File; mode : longint) : cint; 
-Function fpFlock (fd, mode : longint) : cint; 
-Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
-{$endif}
-{$endif}
+function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
 
 
 {$i genfunch.inc}
 {$i genfunch.inc}
 
 
@@ -73,7 +56,7 @@ Const
 
 
 // MAP_ANON(YMOUS) is OS dependant but used in the RTL and in ostypes.inc
 // MAP_ANON(YMOUS) is OS dependant but used in the RTL and in ostypes.inc
 // Under BSD without -YMOUS, so alias it:
 // Under BSD without -YMOUS, so alias it:
-  MAP_ANON	= MAP_ANONYMOUS;
+  MAP_ANON      = MAP_ANONYMOUS;
 
 
   PROT_READ     =  $1;          { page can be read }
   PROT_READ     =  $1;          { page can be read }
   PROT_WRITE    =  $2;          { page can be written }
   PROT_WRITE    =  $2;          { page can be written }
@@ -90,70 +73,18 @@ Uses Sysctl;
 {$I gensigset.inc}     // general sigset funcs implementation.
 {$I gensigset.inc}     // general sigset funcs implementation.
 {$I genfdset.inc}      // general fdset funcs.
 {$I genfdset.inc}      // general fdset funcs.
 
 
-{$ifdef FPC_USE_LIBC}
-  {$i oscdecl.inc}        // implementation of wrappers in oscdeclh.inc
-{$else}
-  {$i syscallh.inc}       // do_syscall declarations themselves
-  {$i sysnr.inc}          // syscall numbers.
-  {$i bsyscall.inc}       // cpu specific syscalls
-  {$i bunxsysc.inc}       // syscalls in system unit.
-//  {$i settimeo.inc}
-{$endif}
-{$i settimeo.inc}
+{$i oscdecl.inc}        // implementation of wrappers in oscdeclh.inc
+
 {$i osmacro.inc}        { macro implenenations }
 {$i osmacro.inc}        { macro implenenations }
 {$i bunxovl.inc}        { redefs and overloads implementation }
 {$i bunxovl.inc}        { redefs and overloads implementation }
 
 
-{$ifndef ver1_0}
-function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
-procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
-{$else}
-// workaround for 1.0.10 bugs.
-
-function intgeterrno:longint; external name 'FPC_SYS_GETERRNO';
-procedure intseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
-
-function fpgeterrno:longint; 
-begin
-  fpgeterrno:=intgeterrno;
-end;
-
-procedure fpseterrno(err:longint); 
-begin
-  intseterrno(err);
-end;
 
 
-{$endif}
+function stime(t: ptime_t): cint; cdecl; external clib name 'stime';
 
 
 function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
 function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
 begin
 begin
-  fpsettimeofday := settimeofday(tp, tzp);
-end;
-
-Function fpFlock (var fd : File; mode : longint) : cint; 
-begin
-  {$warning TODO BeOS fpFlock implementation}  
-end;
-
-Function fpFlock (var fd : Text; mode : longint) : cint; 
-begin
-  {$warning TODO BeOS fpFlock implementation}  
-end;
-
-Function fpFlock (fd, mode : longint) : cint; 
-begin
-  {$warning TODO BeOS fpFlock implementation}  
+  fpsettimeofday:=stime(@tp^.tv_sec);
 end;
 end;
 
 
-function snooze(microseconds : bigtime_t) : status_t; cdecl; external 'root' name 'snooze';
-
-Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
-begin
-  case snooze((req^.tv_nsec div 1000) + (req^.tv_sec * 1000 * 1000)) of
-    B_OK : FpNanoSleep := 0;
-    B_INTERRUPTED : FpNanoSleep := - 1;
-    else
-      FpNanoSleep := - 1;
-  end;
-end;
 
 
 end.
 end.

+ 0 - 519
rtl/haiku/bethreads.pp

@@ -1,519 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2002 by Peter Vreman,
-    member of the Free Pascal development team.
-
-    BeOS (bethreads) threading support implementation
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-{$mode objfpc}
-
-unit bethreads;
-interface
-{$S-}
-
-Procedure SetBeThreadManager;
-
-implementation
-
-Uses
-  systhrds,
-  BaseUnix,
-  unix,
-  unixtype,
-  sysutils;
-
-{*****************************************************************************
-                             Generic overloaded
-*****************************************************************************}
-
-{ Include OS specific parts. }
-
-{*****************************************************************************
-                             Threadvar support
-*****************************************************************************}
-
-{$ifdef HASTHREADVAR}
-    const
-      threadvarblocksize : dword = 0;
-
-    var
-      TLSKey : pthread_key_t;
-
-    procedure BeInitThreadvar(var offset : dword;size : dword);
-      begin
-        offset:=threadvarblocksize;
-        inc(threadvarblocksize,size);
-      end;
-
-    function BeRelocateThreadvar(offset : dword) : pointer;
-      begin
-        BeRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
-      end;
-
-
-    procedure BeAllocateThreadVars;
-      var
-        dataindex : pointer;
-      begin
-        { we've to allocate the memory from system  }
-        { because the FPC heap management uses      }
-        { exceptions which use threadvars but       }
-        { these aren't allocated yet ...            }
-        { allocate room on the heap for the thread vars }
-        DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
-        FillChar(DataIndex^,threadvarblocksize,0);
-        pthread_setspecific(tlskey,dataindex);
-      end;
-
-
-    procedure BeReleaseThreadVars;
-      begin
-        {$ifdef ver1_0}
-        Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize);
-        {$else}
-        Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
-        {$endif}
-      end;
-
-{ Include OS independent Threadvar initialization }
-
-{$endif HASTHREADVAR}
-
-
-{*****************************************************************************
-                            Thread starting
-*****************************************************************************}
-
-    type
-      pthreadinfo = ^tthreadinfo;
-      tthreadinfo = record
-        f : tthreadfunc;
-        p : pointer;
-        stklen : cardinal;
-      end;
-
-    procedure DoneThread;
-      begin
-        { Release Threadvars }
-{$ifdef HASTHREADVAR}
-        CReleaseThreadVars;
-{$endif HASTHREADVAR}
-      end;
-
-
-    function ThreadMain(param : pointer) : pointer;cdecl;
-      var
-        ti : tthreadinfo;
-{$ifdef DEBUG_MT}
-        // in here, don't use write/writeln before having called
-        // InitThread! I wonder if anyone ever debugged these routines,
-        // because they will have crashed if DEBUG_MT was enabled!
-        // this took me the good part of an hour to figure out
-        // why it was crashing all the time!
-        // this is kind of a workaround, we simply write(2) to fd 0
-        s: string[100]; // not an ansistring
-{$endif DEBUG_MT}
-      begin
-{$ifdef DEBUG_MT}
-        s := 'New thread started, initing threadvars'#10;
-        fpwrite(0,s[1],length(s));
-{$endif DEBUG_MT}
-{$ifdef HASTHREADVAR}
-        { Allocate local thread vars, this must be the first thing,
-          because the exception management and io depends on threadvars }
-        CAllocateThreadVars;
-{$endif HASTHREADVAR}
-        { Copy parameter to local data }
-{$ifdef DEBUG_MT}
-        s := 'New thread started, initialising ...'#10;
-        fpwrite(0,s[1],length(s));
-{$endif DEBUG_MT}
-        ti:=pthreadinfo(param)^;
-        dispose(pthreadinfo(param));
-        { Initialize thread }
-        InitThread(ti.stklen);
-        { Start thread function }
-{$ifdef DEBUG_MT}
-        writeln('Jumping to thread function');
-{$endif DEBUG_MT}
-        ThreadMain:=pointer(ti.f(ti.p));
-        DoneThread;
-        pthread_detach(pthread_t(pthread_self()));
-      end;
-
-
-    function BeBeginThread(sa : Pointer;stacksize : dword;
-                         ThreadFunction : tthreadfunc;p : pointer;
-                         creationFlags : dword; var ThreadId : THandle) : DWord;
-      var
-        ti : pthreadinfo;
-        thread_attr : pthread_attr_t;
-      begin
-{$ifdef DEBUG_MT}
-        writeln('Creating new thread');
-{$endif DEBUG_MT}
-        { Initialize multithreading if not done }
-        if not IsMultiThread then
-         begin
-{$ifdef HASTHREADVAR}
-          { We're still running in single thread mode, setup the TLS }
-           pthread_key_create(@TLSKey,nil);
-           InitThreadVars(@CRelocateThreadvar);
-{$endif HASTHREADVAR}
-           IsMultiThread:=true;
-         end;
-        { the only way to pass data to the newly created thread
-          in a MT safe way, is to use the heap }
-        new(ti);
-        ti^.f:=ThreadFunction;
-        ti^.p:=p;
-        ti^.stklen:=stacksize;
-        { call pthread_create }
-{$ifdef DEBUG_MT}
-        writeln('Starting new thread');
-{$endif DEBUG_MT}
-        pthread_attr_init(@thread_attr);
-        pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
-
-        // will fail under linux -- apparently unimplemented
-        pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
-
-        // don't create detached, we need to be able to join (waitfor) on
-        // the newly created thread!
-        //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
-        if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
-          threadid := 0;
-        end;
-        BeBeginThread:=threadid;
-{$ifdef DEBUG_MT}
-        writeln('BeginThread returning ',BeBeginThread);
-{$endif DEBUG_MT}
-      end;
-
-
-    procedure BeEndThread(ExitCode : DWord);
-      begin
-        DoneThread;
-        pthread_detach(pthread_t(pthread_self()));
-        pthread_exit(pointer(ExitCode));
-      end;
-
-
-{$warning threadhandle can be larger than a dword}
-    function  BeSuspendThread (threadHandle : dword) : dword;
-    begin
-      {$Warning SuspendThread needs to be implemented}
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeResumeThread  (threadHandle : dword) : dword;
-    begin
-      {$Warning ResumeThread needs to be implemented}
-    end;
-
-    procedure CThreadSwitch;  {give time to other threads}
-    begin
-      {extern int pthread_yield (void) __THROW;}
-      {$Warning ThreadSwitch needs to be implemented}
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeKillThread (threadHandle : dword) : dword;
-    begin
-      pthread_detach(pthread_t(threadHandle));
-      CKillThread := pthread_cancel(pthread_t(threadHandle));
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;  {0=no timeout}
-    var
-      LResultP: Pointer;
-      LResult: DWord;
-    begin
-      LResult := 0;
-      LResultP := @LResult;
-      pthread_join(pthread_t(threadHandle), @LResultP);
-      CWaitForThreadTerminate := LResult;
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
-    begin
-      {$Warning ThreadSetPriority needs to be implemented}
-    end;
-
-
-{$warning threadhandle can be larger than a dword}
-    function  BeThreadGetPriority (threadHandle : dword): Integer;
-    begin
-      {$Warning ThreadGetPriority needs to be implemented}
-    end;
-
-{$warning threadhandle can be larger than a dword}
-    function  BeGetCurrentThreadId : dword;
-    begin
-      CGetCurrentThreadId:=dword(pthread_self());
-    end;
-
-
-{*****************************************************************************
-                          Delphi/Win32 compatibility
-*****************************************************************************}
-
-    procedure BeInitCriticalSection(var CS);
-
-    var
-      MAttr : pthread_mutexattr_t;
-      res: longint;
-    begin
-      res:=pthread_mutexattr_init(@MAttr);
-      if res=0 then
-        begin
-          res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
-          if res=0 then
-            res := pthread_mutex_init(@CS,@MAttr)
-          else
-            { No recursive mutex support :/ }
-            res := pthread_mutex_init(@CS,NIL);
-        end
-      else 
-        res:= pthread_mutex_init(@CS,NIL);
-      pthread_mutexattr_destroy(@MAttr);
-      if res <> 0 then
-        runerror(6);
-    end;                           
-
-    procedure BeEnterCriticalSection(var CS);
-      begin
-         if pthread_mutex_lock(@CS) <> 0 then
-           runerror(6);
-      end;
-
-    procedure BeLeaveCriticalSection(var CS);
-      begin
-         if pthread_mutex_unlock(@CS) <> 0 then
-           runerror(6)
-      end;
-
-    procedure BeDoneCriticalSection(var CS);
-      begin
-         if pthread_mutex_destroy(@CS) <> 0 then
-           runerror(6);
-      end;
-
-
-{*****************************************************************************
-                           Heap Mutex Protection
-*****************************************************************************}
-
-    var
-      HeapMutex : pthread_mutex_t;
-
-    procedure BeThreadHeapMutexInit;
-      begin
-         pthread_mutex_init(@heapmutex,nil);
-      end;
-
-    procedure BeThreadHeapMutexDone;
-      begin
-         pthread_mutex_destroy(@heapmutex);
-      end;
-
-    procedure BeThreadHeapMutexLock;
-      begin
-         pthread_mutex_lock(@heapmutex);
-      end;
-
-    procedure BeThreadHeapMutexUnlock;
-      begin
-         pthread_mutex_unlock(@heapmutex);
-      end;
-
-    const
-      BeThreadMemoryMutexManager : TMemoryMutexManager = (
-        MutexInit : @BeThreadHeapMutexInit;
-        MutexDone : @BeThreadHeapMutexDone;
-        MutexLock : @BeThreadHeapMutexLock;
-        MutexUnlock : @BeThreadHeapMutexUnlock;
-      );
-
-    procedure InitHeapMutexes;
-      begin
-        SetMemoryMutexManager(BeThreadMemoryMutexManager);
-      end;
-
-Function BeInitThreads : Boolean;
-
-begin
-{$ifdef DEBUG_MT}
-  Writeln('Entering InitThreads.');
-{$endif}  
-{$ifndef dynpthreads}
-  Result:=True;
-{$else}
-  Result:=LoadPthreads;
-{$endif}
-  ThreadID := SizeUInt (pthread_self);
-{$ifdef DEBUG_MT}
-  Writeln('InitThreads : ',Result);
-{$endif DEBUG_MT}
-end;
-
-Function BeDoneThreads : Boolean;
-
-begin
-{$ifndef dynpthreads}
-  Result:=True;
-{$else}
-  Result:=UnloadPthreads;
-{$endif}
-end;
-
-type
-     TPthreadMutex = pthread_mutex_t;
-     Tbasiceventstate=record
-         FSem: Pointer;
-         FManualReset: Boolean;
-         FEventSection: TPthreadMutex;
-	end;
-     plocaleventstate = ^tbasiceventstate;  
-//     peventstate=pointer;
-
-Const 
-	wrSignaled = 0;
-	wrTimeout  = 1;
-	wrAbandoned= 2;
-	wrError	   = 3;
-
-function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
-
-var
-  MAttr : pthread_mutexattr_t;
-  res   : cint;
-
-
-begin
-  new(plocaleventstate(result));
-  plocaleventstate(result)^.FManualReset:=AManualReset;
-  plocaleventstate(result)^.FSem:=New(PSemaphore);  //sem_t.
-//  plocaleventstate(result)^.feventsection:=nil;
-  res:=pthread_mutexattr_init(@MAttr);
-  if res=0 then
-    begin
-      res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
-      if Res=0 then
-        Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr)
-      else
-        res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
-    end
-  else
-    res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
-  pthread_mutexattr_destroy(@MAttr);
-  if res <> 0 then
-    runerror(6);
-  if sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState)) <> 0 then
-    runerror(6);
-end;
-
-procedure Intbasiceventdestroy(state:peventstate);
-
-begin
-  sem_destroy(psem_t(  plocaleventstate(state)^.FSem));
-end;
-
-procedure IntbasiceventResetEvent(state:peventstate);
-
-begin
-  While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
-    ;
-end;
-
-procedure IntbasiceventSetEvent(state:peventstate);
-
-Var
-  Value : Longint;
-
-begin
-  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
-  Try
-    sem_getvalue(plocaleventstate(state)^.FSem,@value);
-    if Value=0 then
-      sem_post(psem_t( plocaleventstate(state)^.FSem));
-  finally
-    pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
-  end;
-end;
-
-function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
-
-begin
-  If TimeOut<>Cardinal($FFFFFFFF) then
-    result:=wrError
-  else
-    begin
-      sem_wait(psem_t(plocaleventstate(state)^.FSem));
-      result:=wrSignaled;
-      if plocaleventstate(state)^.FManualReset then
-        begin
-          pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
-          Try
-              intbasiceventresetevent(State);
-              sem_post(psem_t( plocaleventstate(state)^.FSem));
-            Finally
-          pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
-        end;
-      end;
-    end;
-end;
-
-Var
-  BeThreadManager : TThreadManager;
-
-Procedure SetBeThreadManager;
-
-begin
-  With BeThreadManager do
-    begin
-    InitManager            :=@BeInitThreads;
-    DoneManager            :=@BeDoneThreads;
-    BeginThread            :=@BeBeginThread;
-    EndThread              :=@BeEndThread;
-    SuspendThread          :=@BeSuspendThread;
-    ResumeThread           :=@BeResumeThread;
-    KillThread             :=@BeKillThread;
-    ThreadSwitch           :=@BeThreadSwitch;
-    WaitForThreadTerminate :=@BeWaitForThreadTerminate;
-    ThreadSetPriority      :=@BeThreadSetPriority;
-    ThreadGetPriority      :=@BeThreadGetPriority;
-    GetCurrentThreadId     :=@BeGetCurrentThreadId;
-    InitCriticalSection    :=@BeInitCriticalSection;
-    DoneCriticalSection    :=@BeDoneCriticalSection;
-    EnterCriticalSection   :=@BeEnterCriticalSection;
-    LeaveCriticalSection   :=@BeLeaveCriticalSection;
-{$ifdef hasthreadvar}
-    InitThreadVar          :=@BeInitThreadVar;
-    RelocateThreadVar      :=@BeRelocateThreadVar;
-    AllocateThreadVars     :=@BeAllocateThreadVars;
-    ReleaseThreadVars      :=@BeReleaseThreadVars;
-{$endif}
-    BasicEventCreate       :=@intBasicEventCreate;       
-    BasicEventDestroy      :=@intBasicEventDestroy;
-    BasicEventResetEvent   :=@intBasicEventResetEvent;
-    BasicEventSetEvent     :=@intBasicEventSetEvent;
-    BasiceventWaitFor      :=@intBasiceventWaitFor;
-    end;
-  SetThreadManager(BeThreadManager);
-  InitHeapMutexes;
-end;
-
-initialization
-  SetBeThreadManager;
-end.

+ 0 - 159
rtl/haiku/i386/cprt0.as

@@ -57,165 +57,6 @@ _haltproc:
         call exit
         call exit
 
 
 
 
-/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
-.globl sys_open
-.type sys_open,@function
-sys_open:
-xorl %eax,%eax
-int $0x25
-ret
-
-/* int sys_close (int handle) */
-.globl sys_close
-.type sys_close,@function
-sys_close:
-mov $0x01,%eax
-int $0x25
-ret
-
-/* int sys_read (int handle, void * buffer, int length) */
-.globl sys_read
-.type sys_read,@function
-sys_read:
-movl $0x02,%eax
-int $0x25
-ret
-
-/* int sys_write (int handle, void * buffer, int length) */
-.globl sys_write
-.type sys_write,@function
-sys_write:
-movl $0x3,%eax
-int $0x25
-ret
-
-/* int sys_lseek (int handle, long long pos, int whence) */
-.globl sys_lseek
-.type sys_lseek,@function
-sys_lseek:
-movl $0x5,%eax
-int $0x25
-ret
-
-/* int sys_time(void) */
-.globl sys_time
-.type sys_time,@function
-sys_time:
-movl $0x7,%eax
-int $0x25
-ret
-
-/* int sys_resize_area */
-.globl sys_resize_area
-.type sys_resize_area,@function
-sys_resize_area:
-movl $0x8,%eax
-int $0x25
-ret
-
-/* int sys_opendir (0xFF000000, chra * name, 0) */
-.globl sys_opendir
-.type sys_opendir,@function
-sys_opendir:
-movl $0xC,%eax
-int $0x25
-ret
-
-
-/* int sys_create_area */
-.globl sys_create_area
-.type sys_create_area,@function
-sys_create_area:
-movl $0x14,%eax
-int $0x25
-ret
-
-/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
-.globl sys_readdir
-.type sys_readdir,@function
-sys_readdir:
-movl $0x1C,%eax
-int $0x25
-ret
-
-/* int sys_mkdir (char=0xFF, char * name, int mode) */
-.globl sys_mkdir
-.type sys_mkdir,@function
-sys_mkdir:
-movl $0x1E,%eax
-int $0x25
-ret
-
-/* int sys_wait_for_thread */
-.globl sys_wait_for_thread
-.type sys_wait_for_thread,@function
-sys_wait_for_thread:
-movl $0x22,%eax
-int $0x25
-ret
-
-/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
-.globl sys_rename
-.type sys_rename,@function
-sys_rename:
-movl $0x26,%eax
-int $0x25
-ret
-
-/* int sys_unlink (int=0xFF000000, char * name) */
-.globl sys_unlink
-.type sys_unlink,@function
-sys_unlink:
-movl $0x27,%eax
-int $0x25
-ret
-
-/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
-.globl sys_stat
-.type sys_stat,@function
-sys_stat:
-movl $0x30,%eax
-int $0x25
-ret
-
-/* int sys_load_image */
-.globl sys_load_image
-.type sys_load_image,@function
-sys_load_image:
-movl $0x34,%eax
-int $0x25
-ret
-
-/* void sys_exit (int exitcode) */
-.globl sys_exit
-.type sys_exit,@function
-sys_exit:
-movl $0x3F,%eax
-int $0x25
-
-/* void sys_chdir (char 0xFF, char * name) */
-.globl sys_chdir
-.type sys_chdir,@function
-sys_chdir:
-movl $0x57,%eax
-int $0x25
-ret
-
-/* void sys_rmdir (char 0xFF, char * name) */
-.globl sys_rmdir
-.type sys_rmdir,@function
-sys_rmdir:
-movl $0x60,%eax
-int $0x25
-ret
-
-/* actual syscall */
-.globl sys_call
-.type sys_call,@function
-sys_call:
-int $0x25
-ret
-
 .bss
 .bss
         .comm operatingsystem_parameter_envp,4
         .comm operatingsystem_parameter_envp,4
         .comm operatingsystem_parameter_argc,4
         .comm operatingsystem_parameter_argc,4

+ 3 - 163
rtl/haiku/i386/dllcprt0.as

@@ -7,8 +7,8 @@ default_environ:
 .globl initialize_after
 .globl initialize_after
         .type    initialize_after,@function
         .type    initialize_after,@function
 initialize_after:
 initialize_after:
-	.globl FPC_SHARED_LIB_START
-	.type FPC_SHARED_LIB_START,@function
+        .globl FPC_SHARED_LIB_START
+        .type FPC_SHARED_LIB_START,@function
 FPC_SHARED_LIB_START:
 FPC_SHARED_LIB_START:
         /* We are in a library if we link something against this code */
         /* We are in a library if we link something against this code */
         movb $1,operatingsystem_islibrary
         movb $1,operatingsystem_islibrary
@@ -40,168 +40,8 @@ _haltproc:
         pushl %ebx
         pushl %ebx
         call exit
         call exit
 
 
-
-/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
-.globl sys_open
-.type sys_open,@function
-sys_open:
-xorl %eax,%eax
-int $0x25
-ret
-
-/* int sys_close (int handle) */
-.globl sys_close
-.type sys_close,@function
-sys_close:
-mov $0x01,%eax
-int $0x25
-ret
-
-/* int sys_read (int handle, void * buffer, int length) */
-.globl sys_read
-.type sys_read,@function
-sys_read:
-movl $0x02,%eax
-int $0x25
-ret
-
-/* int sys_write (int handle, void * buffer, int length) */
-.globl sys_write
-.type sys_write,@function
-sys_write:
-movl $0x3,%eax
-int $0x25
-ret
-
-/* int sys_lseek (int handle, long long pos, int whence) */
-.globl sys_lseek
-.type sys_lseek,@function
-sys_lseek:
-movl $0x5,%eax
-int $0x25
-ret
-
-/* int sys_time(void) */
-.globl sys_time
-.type sys_time,@function
-sys_time:
-movl $0x7,%eax
-int $0x25
-ret
-
-/* int sys_resize_area */
-.globl sys_resize_area
-.type sys_resize_area,@function
-sys_resize_area:
-movl $0x8,%eax
-int $0x25
-ret
-
-/* int sys_opendir (0xFF000000, chra * name, 0) */
-.globl sys_opendir
-.type sys_opendir,@function
-sys_opendir:
-movl $0xC,%eax
-int $0x25
-ret
-
-
-/* int sys_create_area */
-.globl sys_create_area
-.type sys_create_area,@function
-sys_create_area:
-movl $0x14,%eax
-int $0x25
-ret
-
-/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
-.globl sys_readdir
-.type sys_readdir,@function
-sys_readdir:
-movl $0x1C,%eax
-int $0x25
-ret
-
-/* int sys_mkdir (char=0xFF, char * name, int mode) */
-.globl sys_mkdir
-.type sys_mkdir,@function
-sys_mkdir:
-movl $0x1E,%eax
-int $0x25
-ret
-
-/* int sys_wait_for_thread */
-.globl sys_wait_for_thread
-.type sys_wait_for_thread,@function
-sys_wait_for_thread:
-movl $0x22,%eax
-int $0x25
-ret
-
-/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
-.globl sys_rename
-.type sys_rename,@function
-sys_rename:
-movl $0x26,%eax
-int $0x25
-ret
-
-/* int sys_unlink (int=0xFF000000, char * name) */
-.globl sys_unlink
-.type sys_unlink,@function
-sys_unlink:
-movl $0x27,%eax
-int $0x25
-ret
-
-/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
-.globl sys_stat
-.type sys_stat,@function
-sys_stat:
-movl $0x30,%eax
-int $0x25
-ret
-
-/* int sys_load_image */
-.globl sys_load_image
-.type sys_load_image,@function
-sys_load_image:
-movl $0x34,%eax
-int $0x25
-ret
-
-/* void sys_exit (int exitcode) */
-.globl sys_exit
-.type sys_exit,@function
-sys_exit:
-movl $0x3F,%eax
-int $0x25
-
-/* void sys_chdir (char 0xFF, char * name) */
-.globl sys_chdir
-.type sys_chdir,@function
-sys_chdir:
-movl $0x57,%eax
-int $0x25
-ret
-
-/* void sys_rmdir (char 0xFF, char * name) */
-.globl sys_rmdir
-.type sys_rmdir,@function
-sys_rmdir:
-movl $0x60,%eax
-int $0x25
-ret
-
-/* actual syscall */
-.globl sys_call
-.type sys_call,@function
-sys_call:
-int $0x25
-ret
-
 .bss
 .bss
         .comm operatingsystem_parameter_envp,4
         .comm operatingsystem_parameter_envp,4
         .comm operatingsystem_parameter_argc,4
         .comm operatingsystem_parameter_argc,4
         .comm operatingsystem_parameter_argv,4
         .comm operatingsystem_parameter_argv,4
-	
+

+ 0 - 170
rtl/haiku/i386/dllprt.as

@@ -1,170 +0,0 @@
-       .file   "dllprt.cpp"
-.text
-        .p2align 2
-.globl _._7FPC_DLL
-        .type    _._7FPC_DLL,@function
-_._7FPC_DLL:
-.LFB1:
-        pushl %ebp
-.LCFI0:
-        movl %esp,%ebp
-.LCFI1:
-        pushl %esi
-.LCFI2:
-        pushl %ebx
-.LCFI3:
-        call .L7
-.L7:
-        popl %ebx
-        addl $_GLOBAL_OFFSET_TABLE_+[.-.L7],%ebx
-        movl 8(%ebp),%esi
-.L3:
-        movl 12(%ebp),%eax
-        andl $1,%eax
-        testl %eax,%eax
-        je .L5
-        pushl %esi
-.LCFI4:
-        call __builtin_delete@PLT
-        addl $4,%esp
-        jmp .L5
-        .p2align 4,,7
-.L4:
-.L5:
-.L2:
-        leal -8(%ebp),%esp
-        popl %ebx
-        popl %esi
-        movl %ebp,%esp
-        popl %ebp
-        ret
-.LFE1:
-.Lfe1:
-        .size    _._7FPC_DLL,.Lfe1-_._7FPC_DLL
-.section        .rodata
-.LC0:
-        .string "dll"
-.data
-        .align 4
-        .type    _argv,@object
-        .size    _argv,8
-_argv:
-        .long .LC0
-        .long 0
-        .align 4
-        .type    _envp,@object
-        .size    _envp,4
-_envp:
-        .long 0
-.text
-        .p2align 2
-.globl __7FPC_DLL
-        .type    __7FPC_DLL,@function
-__7FPC_DLL:
-.LFB2:
-        pushl %ebp
-.LCFI5:
-        movl %esp,%ebp
-.LCFI6:
-        pushl %ebx
-.LCFI7:
-        call .L11
-.L11:
-        popl %ebx
-        addl $_GLOBAL_OFFSET_TABLE_+[.-.L11],%ebx
-        movl operatingsystem_parameter_argc@GOT(%ebx),%eax
-        movl $0,(%eax)
-        movl operatingsystem_parameter_argv@GOT(%ebx),%eax
-        movl %ebx,%ecx
-        addl $_argv@GOTOFF,%ecx
-        movl %ecx,%edx
-        movl %edx,(%eax)
-        movl operatingsystem_parameter_envp@GOT(%ebx),%eax
-        movl %ebx,%ecx
-        addl $_envp@GOTOFF,%ecx
-        movl %ecx,%edx
-        movl %edx,(%eax)
-        call PASCALMAIN__Fv@PLT
-.L9:
-        movl 8(%ebp),%eax
-        jmp .L8
-.L8:
-        movl -4(%ebp),%ebx
-        movl %ebp,%esp
-        popl %ebp
-        ret
-.LFE2:
-.Lfe2:
-        .size    __7FPC_DLL,.Lfe2-__7FPC_DLL
-
-.section        .eh_frame,"aw",@progbits
-__FRAME_BEGIN__:
-        .4byte  .LLCIE1
-.LSCIE1:
-        .4byte  0x0
-        .byte   0x1
-        .byte   0x0
-        .byte   0x1
-        .byte   0x7c
-        .byte   0x8
-        .byte   0xc
-        .byte   0x4
-        .byte   0x4
-        .byte   0x88
-        .byte   0x1
-        .align 4
-.LECIE1:
-        .set    .LLCIE1,.LECIE1-.LSCIE1
-        .4byte  .LLFDE1
-.LSFDE1:
-        .4byte  .LSFDE1-__FRAME_BEGIN__
-        .4byte  .LFB1
-        .4byte  .LFE1-.LFB1
-        .byte   0x4
-        .4byte  .LCFI0-.LFB1
-        .byte   0xe
-        .byte   0x8
-        .byte   0x85
-        .byte   0x2
-        .byte   0x4
-        .4byte  .LCFI1-.LCFI0
-        .byte   0xd
-        .byte   0x5
-        .byte   0x4
-        .4byte  .LCFI2-.LCFI1
-        .byte   0x86
-        .byte   0x3
-        .byte   0x4
-        .4byte  .LCFI3-.LCFI2
-        .byte   0x83
-        .byte   0x4
-        .byte   0x4
-        .4byte  .LCFI4-.LCFI3
-        .byte   0x2e
-        .byte   0x4
-        .align 4
-.LEFDE1:
-        .set    .LLFDE1,.LEFDE1-.LSFDE1
-        .4byte  .LLFDE3
-.LSFDE3:
-        .4byte  .LSFDE3-__FRAME_BEGIN__
-        .4byte  .LFB2
-        .4byte  .LFE2-.LFB2
-        .byte   0x4
-        .4byte  .LCFI5-.LFB2
-        .byte   0xe
-        .byte   0x8
-        .byte   0x85
-        .byte   0x2
-        .byte   0x4
-        .4byte  .LCFI6-.LCFI5
-        .byte   0xd
-        .byte   0x5
-        .byte   0x4
-        .4byte  .LCFI7-.LCFI6
-        .byte   0x83
-        .byte   0x3
-        .align 4
-.LEFDE3:
-        .set    .LLFDE3,.LEFDE3-.LSFDE3
-        .ident  "GCC: (GNU) 2.9-beos-991026"

+ 0 - 39
rtl/haiku/i386/dllprt.cpp

@@ -1,39 +0,0 @@
-#include <stdio.h>
-
-class FPC_DLL
-{
-  public:
-    FPC_DLL();
-//    ~FPC_DLL();
-};
-
-static FPC_DLL fpc_dll();
-
-//FPC_DLL::~FPC_DLL()
-//{
-//      printf ("main thread ended.");
-//}
-
-
-extern "C" void PASCALMAIN(void);
-extern int operatingsystem_parameter_argc;
-extern void * operatingsystem_parameter_argv;
-extern void * operatingsystem_parameter_envp;
-
-static char * _argv[] = {"dll",0};
-static char * _envp[] = {0};
-
-extern "C" void BEGIN()
-{
-        printf ("init\n");
-        operatingsystem_parameter_argc=0;
-        operatingsystem_parameter_argv = (void *)_argv;
-        operatingsystem_parameter_envp = (void *)_envp;
-        PASCALMAIN();
-}
-
-FPC_DLL::FPC_DLL()
-{
-  BEGIN();
-}
-

Неке датотеке нису приказане због велике количине промена