瀏覽代碼

* synchronised with trunk till r42095

git-svn-id: branches/debug_eh@42096 -
Jonas Maebe 6 年之前
父節點
當前提交
9e9a982bfe
共有 50 個文件被更改,包括 1454 次插入821 次删除
  1. 4 2
      .gitattributes
  2. 2 2
      compiler/aasmtai.pas
  3. 14 2
      compiler/aggas.pas
  4. 1 0
      compiler/arm/aasmcpu.pas
  5. 10 4
      compiler/dbgdwarf.pas
  6. 31 12
      compiler/hlcgobj.pas
  7. 49 18
      compiler/msg/errord.msg
  8. 52 20
      compiler/msg/errordu.msg
  9. 3 1
      compiler/ncgnstld.pas
  10. 17 8
      compiler/ncgnstmm.pas
  11. 15 3
      compiler/nset.pas
  12. 12 2
      compiler/optdfa.pas
  13. 22 18
      compiler/parser.pas
  14. 9 9
      compiler/pmodules.pas
  15. 9 5
      compiler/scanner.pas
  16. 7 1
      compiler/symdef.pas
  17. 1 0
      compiler/utils/ppuutils/ppudump.pp
  18. 2 1
      compiler/utils/ppuutils/ppuout.pp
  19. 7 9
      packages/fcl-fpcunit/src/fpcunit.pp
  20. 48 0
      packages/gdbint/src/gdbint.pp
  21. 301 66
      packages/libffi/src/ffi.manager.pp
  22. 192 1
      packages/rtl-objpas/src/inc/rtti.pp
  23. 1 0
      packages/rtl-objpas/tests/testrunner.rtlobjpas.pp
  24. 259 0
      packages/rtl-objpas/tests/tests.rtti.impl.pas
  25. 2 2
      rtl/darwin/aarch64/sighnd.inc
  26. 1 1
      rtl/haiku/Makefile
  27. 1 1
      rtl/haiku/Makefile.fpc
  28. 1 8
      rtl/inc/system.inc
  29. 106 94
      rtl/macos/Makefile
  30. 22 3
      rtl/macos/Makefile.fpc
  31. 46 0
      rtl/macos/classes.pp
  32. 4 1
      rtl/macos/sysutils.pp
  33. 86 0
      rtl/macos/tthread.inc
  34. 7 7
      rtl/objpas/classes/classesh.inc
  35. 4 4
      rtl/objpas/classes/streams.inc
  36. 2 6
      rtl/openbsd/Makefile
  37. 2 7
      rtl/openbsd/Makefile.fpc
  38. 0 206
      rtl/openbsd/i386/cprt0.as
  39. 7 6
      rtl/openbsd/i386/prt0.as
  40. 9 8
      rtl/openbsd/i386/si_c.inc
  41. 9 8
      rtl/openbsd/i386/si_g.inc
  42. 9 8
      rtl/openbsd/i386/si_prc.inc
  43. 0 244
      rtl/openbsd/x86_64/cprt0.as
  44. 0 2
      rtl/openbsd/x86_64/prt0.as
  45. 7 6
      rtl/openbsd/x86_64/si_c.inc
  46. 7 6
      rtl/openbsd/x86_64/si_g.inc
  47. 2 4
      rtl/openbsd/x86_64/si_prc.inc
  48. 10 5
      rtl/unix/scripts/check_rtl_types.sh
  49. 20 0
      tests/test/opt/tdfa19.pp
  50. 22 0
      tests/test/opt/tdfa20.pp

+ 4 - 2
.gitattributes

@@ -9893,6 +9893,7 @@ rtl/macos/MPWmake -text
 rtl/macos/Makefile svneol=native#text/plain
 rtl/macos/Makefile.fpc svneol=native#text/plain
 rtl/macos/README.txt svneol=native#text/plain
+rtl/macos/classes.pp svneol=native#text/plain
 rtl/macos/dos.pp svneol=native#text/plain
 rtl/macos/macos.pp svneol=native#text/plain
 rtl/macos/macostp.inc svneol=native#text/plain
@@ -9907,6 +9908,7 @@ rtl/macos/sysos.inc svneol=native#text/plain
 rtl/macos/sysosh.inc svneol=native#text/plain
 rtl/macos/system.pp svneol=native#text/plain
 rtl/macos/sysutils.pp svneol=native#text/plain
+rtl/macos/tthread.inc svneol=native#text/plain
 rtl/mips/cpuh.inc svneol=native#text/plain
 rtl/mips/int64p.inc svneol=native#text/plain
 rtl/mips/makefile.cpu svneol=native#text/plain
@@ -10262,7 +10264,6 @@ rtl/openbsd/Makefile.fpc svneol=native#text/plain
 rtl/openbsd/errno.inc svneol=native#text/plain
 rtl/openbsd/errnostr.inc svneol=native#text/plain
 rtl/openbsd/i386/bsyscall.inc svneol=native#text/plain
-rtl/openbsd/i386/cprt0.as svneol=native#text/plain
 rtl/openbsd/i386/openbsd_ident.inc svneol=native#text/plain
 rtl/openbsd/i386/prt0.as svneol=native#text/plain
 rtl/openbsd/i386/si_c.inc svneol=native#text/plain
@@ -10298,7 +10299,6 @@ rtl/openbsd/unxconst.inc svneol=native#text/plain
 rtl/openbsd/unxfunc.inc svneol=native#text/plain
 rtl/openbsd/unxsysc.inc svneol=native#text/plain
 rtl/openbsd/x86_64/bsyscall.inc svneol=native#text/plain
-rtl/openbsd/x86_64/cprt0.as svneol=native#text/plain
 rtl/openbsd/x86_64/openbsd_ident.inc svneol=native#text/plain
 rtl/openbsd/x86_64/prt0.as svneol=native#text/plain
 rtl/openbsd/x86_64/si_c.inc svneol=native#text/plain
@@ -12750,7 +12750,9 @@ tests/test/opt/tdfa15.pp svneol=native#text/pascal
 tests/test/opt/tdfa16.pp svneol=native#text/pascal
 tests/test/opt/tdfa17.pp svneol=native#text/pascal
 tests/test/opt/tdfa18.pp svneol=native#text/pascal
+tests/test/opt/tdfa19.pp svneol=native#text/plain
 tests/test/opt/tdfa2.pp svneol=native#text/pascal
+tests/test/opt/tdfa20.pp svneol=native#text/plain
 tests/test/opt/tdfa3.pp svneol=native#text/pascal
 tests/test/opt/tdfa4.pp svneol=native#text/pascal
 tests/test/opt/tdfa5.pp svneol=native#text/pascal

+ 2 - 2
compiler/aasmtai.pas

@@ -396,7 +396,7 @@ interface
           ash_pushnv,ash_savenv
         );
 
-      TSymbolPairKind = (spk_set, spk_thumb_set, spk_localentry);
+      TSymbolPairKind = (spk_set, spk_set_global, spk_thumb_set, spk_localentry);
 
 
     const
@@ -437,7 +437,7 @@ interface
         '.pushnv','.savenv'
       );
       symbolpairkindstr: array[TSymbolPairKind] of string[11]=(
-        '.set', '.thumb_set', '.localentry'
+        '.set', '.set', '.thumb_set', '.localentry'
       );
 
     type

+ 14 - 2
compiler/aggas.pas

@@ -1315,14 +1315,26 @@ implementation
                if replaceforbidden then
                  begin
                    { avoid string truncation }
-                   writer.AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_symbolpair(hp).sym^)+s);
+                   writer.AsmWrite(ReplaceForbiddenAsmSymbolChars(tai_symbolpair(hp).sym^));
+                   writer.AsmWrite(s);
                    writer.AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbolpair(hp).value^));
+                   if tai_symbolpair(hp).kind=spk_set_global then
+                     begin
+                       writer.AsmWrite(#9'.globl ');
+                       writer.AsmWriteLn(ReplaceForbiddenAsmSymbolChars(tai_symbolpair(hp).sym^));
+                     end;
                  end
                else
                  begin
                    { avoid string truncation }
-                   writer.AsmWrite(tai_symbolpair(hp).sym^+s);
+                   writer.AsmWrite(tai_symbolpair(hp).sym^);
+                   writer.AsmWrite(s);
                    writer.AsmWriteLn(tai_symbolpair(hp).value^);
+                   if tai_symbolpair(hp).kind=spk_set_global then
+                     begin
+                       writer.AsmWrite(#9'.globl ');
+                       writer.AsmWriteLn(tai_symbolpair(hp).sym^);
+                     end;
                  end;
              end;
            ait_symbol_end :

+ 1 - 0
compiler/arm/aasmcpu.pas

@@ -5577,6 +5577,7 @@ implementation
                     bytes:=bytes or (1 shl 24);
 
                   case oppostfix of
+                    PF_S: bytes:=bytes or (0 shl 22) or (0 shl 15);
                     PF_D: bytes:=bytes or (0 shl 22) or (1 shl 15);
                     PF_E: bytes:=bytes or (1 shl 22) or (0 shl 15);
                     PF_P: bytes:=bytes or (1 shl 22) or (1 shl 15);

+ 10 - 4
compiler/dbgdwarf.pas

@@ -4272,7 +4272,7 @@ implementation
               if not (is_widestring(def) and (tf_winlikewidestring in target_info.flags)) then
                 upperopcodes:=13
               else
-                upperopcodes:=15;
+                upperopcodes:=16;
               { lower bound is always 1, upper bound (length) needs to be calculated }
               append_entry(DW_TAG_subrange_type,false,[
                 DW_AT_lower_bound,DW_FORM_udata,1,
@@ -4291,16 +4291,22 @@ implementation
               current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip)));
               current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit_unaligned(3));
               { no -> load length }
-              if upperopcodes=15 then
+              if upperopcodes=16 then
                 { for Windows WideString the size is always a DWORD }
                 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit4)))
               else
                 current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizesinttype.size));
               current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus)));
-              current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
+              if upperopcodes=16 then
+                begin
+                  current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size)));
+                  current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4));
+                end
+              else
+                current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref)));
 
               { for widestrings, the length is specified in bytes, so divide by two }
-              if (upperopcodes=15) then
+              if (upperopcodes=16) then
                 begin
                   current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1)));
                   current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shr)));

+ 31 - 12
compiler/hlcgobj.pas

@@ -4479,9 +4479,18 @@ implementation
     var
       firstitem,
       item: TCmdStrListItem;
+      global: boolean;
     begin
       item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first);
       firstitem:=item;
+      global:=
+        (cs_profile in current_settings.moduleswitches) or
+        { smart linking using a library requires to promote
+          all non-nested procedures to AB_GLOBAL
+          otherwise you get undefined symbol error at linking
+          for msdos  target with -CX option for instance }
+        (create_smartlink_library and not is_nested_pd(current_procinfo.procdef)) or
+        (po_global in current_procinfo.procdef.procoptions);
       while assigned(item) do
         begin
 {$ifdef arm}
@@ -4493,19 +4502,29 @@ implementation
             subsections and be reordered }
           if (item<>firstitem) and
              (target_info.system in systems_darwin) then
-            list.concat(tai_symbolpair.create(spk_set,item.str,firstitem.str));
-          if (cs_profile in current_settings.moduleswitches) or
-             { smart linking using a library requires to promote
-               all non-nested procedures to AB_GLOBAL
-               otherwise you get undefined symbol error at linking
-               for msdos  target with -CX option for instance }
-             (create_smartlink_library and not is_nested_pd(current_procinfo.procdef)) or
-             (po_global in current_procinfo.procdef.procoptions) then
-            list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0,current_procinfo.procdef))
+            begin
+              { the .set already defines the symbol, so can't emit a tai_symbol as that will redefine it }
+              if global then
+                begin
+                  list.concat(tai_symbolpair.create(spk_set_global,item.str,firstitem.str));
+                  { needed for generating the tai_symbol_end }
+                  current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION,current_procinfo.procdef);
+                end
+              else
+                begin
+                  list.concat(tai_symbolpair.create(spk_set,item.str,firstitem.str));
+                  current_asmdata.DefineAsmSymbol(item.str,AB_LOCAL,AT_FUNCTION,current_procinfo.procdef);
+                end;
+            end
           else
-            list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0,current_procinfo.procdef));
-          if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
-            list.concat(Tai_function_name.create(item.str));
+            begin
+              if global then
+                list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0,current_procinfo.procdef))
+              else
+                list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0,current_procinfo.procdef));
+              if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then
+                list.concat(Tai_function_name.create(item.str));
+            end;
           item:=TCmdStrListItem(item.next);
         end;
       current_procinfo.procdef.procstarttai:=tai(list.last);

+ 49 - 18
compiler/msg/errord.msg

@@ -3,10 +3,10 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of SVN revision 39700
+#   Based on errore.msg of SVN revision 42047
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2018 by the Free Pascal Development team
+#   Copyright (c) 1998-2019 by the Free Pascal Development team
 #
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
@@ -127,9 +127,9 @@ general_e_path_does_not_exist=01017_E_Der Pfad "$1" existiert nicht
 % The specified path does not exist.
 general_f_compilation_aborted=01018_F_šbersetzen abgebrochen
 % Compilation was aborted.
-general_text_bytes_code=01019_bytes Code
+general_text_bytes_code=01019_Byte Code
 % The size of the generated executable code, in bytes.
-general_text_bytes_data=01020_bytes Daten
+general_text_bytes_data=01020_Byte Daten
 % The size of the generated program data, in bytes.
 general_i_number_of_warnings=01021_I_$1 Warnung(en) ausgegeben
 % Total number of warnings issued during compilation.
@@ -449,7 +449,7 @@ scan_n_changecputype=02105_N_Ge
 #
 # Parser
 #
-# 03348 is the last used one
+# 03350 is the last used one
 #
 # BeginOfTeX
 %
@@ -721,7 +721,7 @@ parser_e_no_such_assignment=03083_E_Es ist nicht m
 parser_e_overload_impossible=03084_E_Unm”gliche Operator-.berladung
 % The combination of operator, arguments and return type are
 % incompatible.
-parser_e_no_reraise_possible=03085_E_Ausl”sen einer Exception an dieser Stelle nicht m”glich
+parser_e_no_reraise_possible=03085_E_Ausl”sen einer Ausnahme (exception) an dieser Stelle nicht m”glich
 % You are trying to re-raise an exception where it is not allowed. You can only
 % re-raise exceptions in an \var{except} block.
 parser_e_no_new_or_dispose_for_classes=03086_E_Die erweiterte Syntax von New oder Dispose ist f�r Klassen unzul„ssig
@@ -1598,6 +1598,22 @@ parser_w_operator_overloaded_hidden_3=03347_W_
 % (in case of dynamic arrays that is the modeswitch \var{ArrayOperators}).
 parser_e_threadvar_must_be_class=03348_E_Threadvariablen in Klassen oder Records m�ssen Klassenvariablen sein
 % 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_Nur statische Methoden und Variablen k”nnen mit einem Objekttyp referenziert werden
+% 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.
+parse_e_callthrough_varargs=03350_E_Kann die variadische Funktion "$1" im C-Stil auf dieser Platform nicht als external redeklarieren; schon die erste Deklaration muss external sein
+% If a function is declared normally in the interface or as a forward declaration, and then later as external, the compiler
+% must generate a stub that calls the external function. Due to code generation limitations, this cannot be done on some
+% platforms. Even on platforms where it is supported, this is quite inefficient.
 %
 % \end{description}
 # EndOfTeX
@@ -1773,7 +1789,7 @@ type_w_mixed_signed_unsigned2=04036_W_Mischen von signed Ausdr
 type_e_typecast_wrong_size_for_assignment=04037_E_Typecast hat verschiedene GrӇen ($1 -> $2) in der Zuweisung
 % Type casting to a type with a different size is not allowed when the variable is
 % used in an assignment.
-type_e_array_index_enums_with_assign_not_possible=04038_E_enums mit Zuweisungen k”nnen nicht als Array-Index verwendet werden
+type_e_array_index_enums_with_assign_not_possible=04038_E_Enums mit Zuweisungen k”nnen nicht als Array-Index verwendet werden
 % When you declared an enumeration type which has C-like
 % assignments, such as in the following:
 % \begin{verbatim}
@@ -2050,7 +2066,7 @@ type_w_empty_constant_range_set=04125_W_Der erste Wert des Bereichs f
 #
 # Symtable
 #
-# 05097 is the last used one
+# 05098 is the last used one
 #
 # BeginOfTeX
 %
@@ -2368,6 +2384,8 @@ sym_e_generic_type_param_mismatch=05096_E_Der generische Typparameter "$1" passt
 sym_e_generic_type_param_decl=05097_E_Generischer Typparameter deklariert als "$1"
 % Shows what the generic type parameter was originally declared as if a mismatch
 % is found between a declaration and the definition.
+sym_e_type_must_be_rec_or_object=05098_E_Record- oder Objecttyp erwartet
+% The variable or expression isn't of the type \var{record} or \var{object}.
 %
 % \end{description}
 # EndOfTeX
@@ -2375,7 +2393,7 @@ sym_e_generic_type_param_decl=05097_E_Generischer Typparameter deklariert als "$
 #
 # Codegenerator
 #
-# 06058 is the last used one
+# 06060 is the last used one
 #
 # BeginOfTeX
 %
@@ -2514,7 +2532,7 @@ cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprozedurale g
 % from a subroutine to the main program
 cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label m�ssen im selben Bereich definiert werden, in dem sie deklariert werden
 % In ISO mode, labels must be defined in the same scope as they are declared.
-cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Excpetion Frames enth„lt, darf nicht mit einem goto verlassen werden
+cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Exception-Frames enth„lt, darf nicht mit einem goto verlassen werden
 % Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures
 % which use automated types like ansistrings or class constructurs are affected by this too.
 cg_e_mod_only_defined_for_pos_quotient=06054_E_Im ISO-Modus ist der Operator mod nur f�r positive Quotienten definiert
@@ -2532,6 +2550,9 @@ cg_n_no_inline=06058_N_Der Aufruf der Routine "$1" ist als "inline" markiert, wi
 % The directive inline is only a hint to the compiler. Sometimes the compiler ignores this hint, a subroutine
 % marked as inline is not inlined. In this case, this hint is given. Compiling with \var{-vd} might result in more information why
 % the directive inline is ignored.
+cg_e_case_incomplete=06059_E_Case-Anweisung deckt nicht alle m”glichen F„lle ab
+cg_w_case_incomplete=06060_W_Case-Anweisung deckt nicht alle m”glichen F„lle ab
+% The case statement does not contain labels for all possible values of the operand, and no else statement is present.
 %
 % \end{description}
 # EndOfTeX
@@ -3042,6 +3063,9 @@ exec_n_backquote_cat_file_not_found=09033_N_Die Datei "$1" wurde mit dem Kommand
 exec_w_init_file_not_found=09034_W_"$1" nicht gefunden; dies wird wahrscheinlich zu einem Fehler beim Linken f�hren
 % The compiler adds certain startup code files to the linker only when they are found.
 % If they are not found, they are not added and this might cause a linking failure.
+% If the system has gcc installed, running \var{gcc --print-file-name <filename>} might return the path to the file.
+% Add this path in your \var{fpc.cfg} using the switch \var{-Fl} to fix this error. This requires though,
+% that gcc targets the same target as FPC.
 exec_e_static_lib_not_supported=09035_E_Statische Bibliotheken nicht unterst�tzt
 % Creating static libraries is not supported for this platform, because it was
 % not yet implemented in the compiler.
@@ -3064,15 +3088,15 @@ execinfo_f_cant_process_executable=09128_F_Kann ausf
 % Fatal error when the compiler is unable to post-process an executable.
 execinfo_f_cant_open_executable=09129_F_Kann ausf�hrbare Datei nicht ”ffnen: $1
 % Fatal error when the compiler cannot open the file for the executable.
-execinfo_x_codesize=09130_X_GrӇe des Codes: $1 Bytes
+execinfo_x_codesize=09130_X_GrӇe des Codes: $1 Byte
 % Informational message showing the size of the produced code section.
-execinfo_x_initdatasize=09131_X_GrӇe der initialisierten Daten: $1 Bytes
+execinfo_x_initdatasize=09131_X_GrӇe der initialisierten Daten: $1 Byte
 % Informational message showing the size of the initialized data section.
-execinfo_x_uninitdatasize=09132_X_GrӇe der nicht initialisierten Daten: $1 Bytes
+execinfo_x_uninitdatasize=09132_X_GrӇe der nicht initialisierten Daten: $1 Byte
 % Informational message showing the size of the uninitialized data section.
-execinfo_x_stackreserve=09133_X_Stack Bereich "reserved": $1 Bytes
+execinfo_x_stackreserve=09133_X_Stack Bereich "reserved": $1 Byte
 % Informational message showing the stack size that the compiler reserved for the executable.
-execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Bytes
+execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Byte
 % Informational message showing the stack size that the compiler committed for the executable.
 %
 % \end{description}
@@ -3210,7 +3234,6 @@ unit_e_illegal_unit_name=10018_E_Ung
 % the name of a unit with a longer name. However, this unit is not found. Example: Program contains
 % \var{uses mytestunit;}, the unit file or source of mytestunit are not available but there is a source
 % with the name \var{mytestun}. Then compiler tries to compile and use that one, however the expected unit name does not match.
-% The name of the unit doesn't match the file name.
 unit_f_too_much_units=10019_F_Zu viele Units
 % \fpc has a limit of 1024 units in a program. You can change this behavior
 % by changing the \var{maxunits} constant in the \file{files.pas} file of the
@@ -3467,7 +3490,7 @@ option_end_reading_configfile=11031_H_Ende des Lesens der Konfigurationsdatei $1
 % End of configuration file parsing.
 option_interpreting_option=11032_D_Option "$1" interpretieren
 % The compiler is interpreting an option
-option_interpreting_firstpass_option=11036_D_firstpass Option "$1" interpretieren
+option_interpreting_firstpass_option=11036_D_Firstpass Option "$1" interpretieren
 % The compiler is interpreting an option for the first time.
 option_interpreting_file_option=11033_D_Datei Option "$1" interpretieren
 % The compiler is interpreting an option which it read from the configuration file.
@@ -3862,9 +3885,10 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 **2Cc<x>_Setze "default calling convention" zu <x>
 **2CD_Erzeuge auch eine dynamische Bibliothek (nicht unterst�tzt)
 **2Ce_šbersetze mit emulierten Fliesskomma opcodes
+**2CE_Erzeuge FPU Code, der Ausnahmen (exceptions) ausl”sen kann
 **2Cf<x>_W„hle den Fliesskomma-Befehlssatz aus; fpc -i oder fpc -if geben die m”glichen Werte aus
 **2CF<x>_Minimale Pr„zission von Fliesskommakonstanten (default, 32, 64)
-**2Cg_Erzeuge PIC code
+**2Cg_Erzeuge PIC Code
 **2Ch<n>[,m]_<n> Minimale GrӇe des Heap in Byte (zwischen 1023 und 67107840) und optional [m] maximale GrӇe des Heap
 **2Ci_I/O-Pr�fung
 A*2CI<x>_W„hle den Befehlssatz f�r ARM aus: ARM oder THUMB
@@ -4127,6 +4151,12 @@ p*2Taix_AIX
 p*2Tdarwin_Darwin/Mac OS X
 p*2Tembedded_Embedded
 p*2Tlinux_Linux
+# riscv32 targets
+R*2Tlinux_Linux
+R*2Tembedded_Embedded
+# riscv64 targets
+r*2Tlinux_Linux
+r*2Tembedded_Embedded
 # sparc targets
 S*2Tlinux_Linux
 S*2Tsolaris_Solaris
@@ -4135,6 +4165,7 @@ s*2Tlinux_Linux
 # not yet ready s*2Tsolaris_Solaris
 # avr targets
 V*2Tembedded_Embedded
+# end of targets section
 **1u<x>_Entferne die Definition f�r das Symbol <x>
 **1U<x>_Unit-Optionen:
 **2Un_Pr�fe den Unitnamen nicht

+ 52 - 20
compiler/msg/errordu.msg

@@ -3,10 +3,10 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of SVN revision 39700
+#   Based on errore.msg of SVN revision 42047
 #
 #   This file is part of the Free Pascal Compiler
-#   Copyright (c) 1998-2018 by the Free Pascal Development team
+#   Copyright (c) 1998-2019 by the Free Pascal Development team
 #
 #   See the file COPYING.v2, included in this distribution,
 #   for details about the copyright.
@@ -127,9 +127,9 @@ general_e_path_does_not_exist=01017_E_Der Pfad "$1" existiert nicht
 % The specified path does not exist.
 general_f_compilation_aborted=01018_F_Übersetzen abgebrochen
 % Compilation was aborted.
-general_text_bytes_code=01019_bytes Code
+general_text_bytes_code=01019_Byte Code
 % The size of the generated executable code, in bytes.
-general_text_bytes_data=01020_bytes Daten
+general_text_bytes_data=01020_Byte Daten
 % The size of the generated program data, in bytes.
 general_i_number_of_warnings=01021_I_$1 Warnung(en) ausgegeben
 % Total number of warnings issued during compilation.
@@ -449,7 +449,7 @@ scan_n_changecputype=02105_N_Geänderter CPU-Typ muss zum angegebenen Controller
 #
 # Parser
 #
-# 03348 is the last used one
+# 03350 is the last used one
 #
 # BeginOfTeX
 %
@@ -721,7 +721,7 @@ parser_e_no_such_assignment=03083_E_Es ist nicht möglich, die Zuweisung für gl
 parser_e_overload_impossible=03084_E_Unmögliche Operator-.berladung
 % The combination of operator, arguments and return type are
 % incompatible.
-parser_e_no_reraise_possible=03085_E_Auslösen einer Exception an dieser Stelle nicht möglich
+parser_e_no_reraise_possible=03085_E_Auslösen einer Ausnahme (exception) an dieser Stelle nicht möglich
 % You are trying to re-raise an exception where it is not allowed. You can only
 % re-raise exceptions in an \var{except} block.
 parser_e_no_new_or_dispose_for_classes=03086_E_Die erweiterte Syntax von New oder Dispose ist für Klassen unzulässig
@@ -1598,6 +1598,22 @@ parser_w_operator_overloaded_hidden_3=03347_W_Überladen eines Operators durch i
 % (in case of dynamic arrays that is the modeswitch \var{ArrayOperators}).
 parser_e_threadvar_must_be_class=03348_E_Threadvariablen in Klassen oder Records müssen Klassenvariablen sein
 % 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_Nur statische Methoden und Variablen können mit einem Objekttyp referenziert werden
+% 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.
+parse_e_callthrough_varargs=03350_E_Kann die variadische Funktion "$1" im C-Stil auf dieser Platform nicht als external redeklarieren; schon die erste Deklaration muss external sein
+% If a function is declared normally in the interface or as a forward declaration, and then later as external, the compiler
+% must generate a stub that calls the external function. Due to code generation limitations, this cannot be done on some
+% platforms. Even on platforms where it is supported, this is quite inefficient.
 %
 % \end{description}
 # EndOfTeX
@@ -1773,7 +1789,7 @@ type_w_mixed_signed_unsigned2=04036_W_Mischen von signed Ausdrücken und kardina
 type_e_typecast_wrong_size_for_assignment=04037_E_Typecast hat verschiedene Größen ($1 -> $2) in der Zuweisung
 % Type casting to a type with a different size is not allowed when the variable is
 % used in an assignment.
-type_e_array_index_enums_with_assign_not_possible=04038_E_enums mit Zuweisungen können nicht als Array-Index verwendet werden
+type_e_array_index_enums_with_assign_not_possible=04038_E_Enums mit Zuweisungen können nicht als Array-Index verwendet werden
 % When you declared an enumeration type which has C-like
 % assignments, such as in the following:
 % \begin{verbatim}
@@ -2050,7 +2066,7 @@ type_w_empty_constant_range_set=04125_W_Der erste Wert des Bereichs für den Men
 #
 # Symtable
 #
-# 05097 is the last used one
+# 05098 is the last used one
 #
 # BeginOfTeX
 %
@@ -2368,6 +2384,8 @@ sym_e_generic_type_param_mismatch=05096_E_Der generische Typparameter "$1" passt
 sym_e_generic_type_param_decl=05097_E_Generischer Typparameter deklariert als "$1"
 % Shows what the generic type parameter was originally declared as if a mismatch
 % is found between a declaration and the definition.
+sym_e_type_must_be_rec_or_object=05098_E_Record- oder Objecttyp erwartet
+% The variable or expression isn't of the type \var{record} or \var{object}.
 %
 % \end{description}
 # EndOfTeX
@@ -2375,7 +2393,7 @@ sym_e_generic_type_param_decl=05097_E_Generischer Typparameter deklariert als "$
 #
 # Codegenerator
 #
-# 06058 is the last used one
+# 06060 is the last used one
 #
 # BeginOfTeX
 %
@@ -2514,7 +2532,7 @@ cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprozedurale g
 % from a subroutine to the main program
 cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label müssen im selben Bereich definiert werden, in dem sie deklariert werden
 % In ISO mode, labels must be defined in the same scope as they are declared.
-cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Excpetion Frames enthält, darf nicht mit einem goto verlassen werden
+cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Exception-Frames enthält, darf nicht mit einem goto verlassen werden
 % Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures
 % which use automated types like ansistrings or class constructurs are affected by this too.
 cg_e_mod_only_defined_for_pos_quotient=06054_E_Im ISO-Modus ist der Operator mod nur für positive Quotienten definiert
@@ -2532,6 +2550,9 @@ cg_n_no_inline=06058_N_Der Aufruf der Routine "$1" ist als "inline" markiert, wi
 % The directive inline is only a hint to the compiler. Sometimes the compiler ignores this hint, a subroutine
 % marked as inline is not inlined. In this case, this hint is given. Compiling with \var{-vd} might result in more information why
 % the directive inline is ignored.
+cg_e_case_incomplete=06059_E_Case-Anweisung deckt nicht alle möglichen Fälle ab
+cg_w_case_incomplete=06060_W_Case-Anweisung deckt nicht alle möglichen Fälle ab
+% The case statement does not contain labels for all possible values of the operand, and no else statement is present.
 %
 % \end{description}
 # EndOfTeX
@@ -3042,7 +3063,10 @@ exec_n_backquote_cat_file_not_found=09033_N_Die Datei "$1" wurde mit dem Kommand
 exec_w_init_file_not_found=09034_W_"$1" nicht gefunden; dies wird wahrscheinlich zu einem Fehler beim Linken führen
 % The compiler adds certain startup code files to the linker only when they are found.
 % If they are not found, they are not added and this might cause a linking failure.
-exec_e_static_lib_not_supported=09035_E_Statische Bibliotheken nicht unterstützt
+% If the system has gcc installed, running \var{gcc --print-file-name <filename>} might return the path to the file.
+% Add this path in your \var{fpc.cfg} using the switch \var{-Fl} to fix this error. This requires though,
+% that gcc targets the same target as FPC.
+exec_e_static_lib_not_supported=09035_E_Statische Bibliotheken nicht unterstützt
 % Creating static libraries is not supported for this platform, because it was
 % not yet implemented in the compiler.
 %
@@ -3064,15 +3088,15 @@ execinfo_f_cant_process_executable=09128_F_Kann ausführbare Datei nicht nachbea
 % Fatal error when the compiler is unable to post-process an executable.
 execinfo_f_cant_open_executable=09129_F_Kann ausführbare Datei nicht öffnen: $1
 % Fatal error when the compiler cannot open the file for the executable.
-execinfo_x_codesize=09130_X_Größe des Codes: $1 Bytes
+execinfo_x_codesize=09130_X_Größe des Codes: $1 Byte
 % Informational message showing the size of the produced code section.
-execinfo_x_initdatasize=09131_X_Größe der initialisierten Daten: $1 Bytes
+execinfo_x_initdatasize=09131_X_Größe der initialisierten Daten: $1 Byte
 % Informational message showing the size of the initialized data section.
-execinfo_x_uninitdatasize=09132_X_Größe der nicht initialisierten Daten: $1 Bytes
+execinfo_x_uninitdatasize=09132_X_Größe der nicht initialisierten Daten: $1 Byte
 % Informational message showing the size of the uninitialized data section.
-execinfo_x_stackreserve=09133_X_Stack Bereich "reserved": $1 Bytes
+execinfo_x_stackreserve=09133_X_Stack Bereich "reserved": $1 Byte
 % Informational message showing the stack size that the compiler reserved for the executable.
-execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Bytes
+execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Byte
 % Informational message showing the stack size that the compiler committed for the executable.
 %
 % \end{description}
@@ -3466,7 +3490,7 @@ option_end_reading_configfile=11031_H_Ende des Lesens der Konfigurationsdatei $1
 % End of configuration file parsing.
 option_interpreting_option=11032_D_Option "$1" interpretieren
 % The compiler is interpreting an option
-option_interpreting_firstpass_option=11036_D_firstpass Option "$1" interpretieren
+option_interpreting_firstpass_option=11036_D_Firstpass Option "$1" interpretieren
 % The compiler is interpreting an option for the first time.
 option_interpreting_file_option=11033_D_Datei Option "$1" interpretieren
 % The compiler is interpreting an option which it read from the configuration file.
@@ -3861,9 +3885,10 @@ S*2Aas_Assembliere mit Hilfe von GNU AS
 **2Cc<x>_Setze "default calling convention" zu <x>
 **2CD_Erzeuge auch eine dynamische Bibliothek (nicht unterstützt)
 **2Ce_Übersetze mit emulierten Fliesskomma opcodes
+**2CE_Erzeuge FPU Code, der Ausnahmen (exceptions) auslösen kann
 **2Cf<x>_Wähle den Fliesskomma-Befehlssatz aus; fpc -i oder fpc -if geben die möglichen Werte aus
 **2CF<x>_Minimale Präzission von Fliesskommakonstanten (default, 32, 64)
-**2Cg_Erzeuge PIC code
+**2Cg_Erzeuge PIC Code
 **2Ch<n>[,m]_<n> Minimale Größe des Heap in Byte (zwischen 1023 und 67107840) und optional [m] maximale Größe des Heap
 **2Ci_I/O-Prüfung
 A*2CI<x>_Wähle den Befehlssatz für ARM aus: ARM oder THUMB
@@ -4104,8 +4129,8 @@ a*2Tlinux_Linux
 # jvm targets
 J*2Tandroid_Android
 J*2Tjava_Java
-m# mipsel targets
-*2Tandroid_Android
+# mipsel targets
+m*2Tandroid_Android
 m*2Tembedded_Embedded
 m*2Tlinux_Linux
 # mipseb targets
@@ -4126,6 +4151,12 @@ p*2Taix_AIX
 p*2Tdarwin_Darwin/Mac OS X
 p*2Tembedded_Embedded
 p*2Tlinux_Linux
+# riscv32 targets
+R*2Tlinux_Linux
+R*2Tembedded_Embedded
+# riscv64 targets
+r*2Tlinux_Linux
+r*2Tembedded_Embedded
 # sparc targets
 S*2Tlinux_Linux
 S*2Tsolaris_Solaris
@@ -4134,6 +4165,7 @@ s*2Tlinux_Linux
 # not yet ready s*2Tsolaris_Solaris
 # avr targets
 V*2Tembedded_Embedded
+# end of targets section
 **1u<x>_Entferne die Definition für das Symbol <x>
 **1U<x>_Unit-Optionen:
 **2Un_Prüfe den Unitnamen nicht

+ 3 - 1
compiler/ncgnstld.pas

@@ -91,7 +91,9 @@ implementation
         nestedvars: tsym;
       begin
         result:=inherited pass_typecheck;
-        if assigned(result) then
+        if assigned(result) or
+           (assigned(current_procinfo) and
+            (df_generic in current_procinfo.procdef.defoptions)) then
           exit;
         case symtableentry.typ of
           paravarsym,

+ 17 - 8
compiler/ncgnstmm.pas

@@ -60,10 +60,15 @@ implementation
         nextpi      : tprocinfo;
       begin
         result:=inherited;
-        if assigned(result) then
+        if assigned(result) or
+           (assigned(current_procinfo) and
+            (df_generic in current_procinfo.procdef.defoptions)) then
           exit;
         currpi:=current_procinfo.parent;
-        while (currpi.procdef.parast.symtablelevel>=parentpd.parast.symtablelevel) do
+        { current_procinfo.parent is not assigned for specialised generic routines in the
+          top-level scope }
+        while assigned(currpi) and
+              (currpi.procdef.parast.symtablelevel>=parentpd.parast.symtablelevel) do
           begin
             if not assigned(currpi.procdef.parentfpstruct) then
               build_parentfpstruct(currpi.procdef);
@@ -72,13 +77,17 @@ implementation
         { mark all parent parentfp parameters for inclusion in the struct that
           holds all locals accessed from nested routines }
         currpi:=current_procinfo.parent;
-        nextpi:=currpi.parent;
-        while (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
+        if assigned(currpi) then
           begin
-            hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
-            maybe_add_sym_to_parentfpstruct(currpi.procdef,hsym,nextpi.procdef.parentfpstructptrtype,false);
-            currpi:=nextpi;
-            nextpi:=nextpi.parent;
+            nextpi:=currpi.parent;
+            while assigned(currpi) and
+                  (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
+              begin
+                hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
+                maybe_add_sym_to_parentfpstruct(currpi.procdef,hsym,nextpi.procdef.parentfpstructptrtype,false);
+                currpi:=nextpi;
+                nextpi:=nextpi.parent;
+              end;
           end;
       end;
 

+ 15 - 3
compiler/nset.pas

@@ -131,6 +131,8 @@ interface
           procedure addelseblock(instr:tnode);
 
           property labelcnt: cardinal read getlabelcnt;
+          { returns one less than the covered case range, so that it
+            does not overflow for a fully covered qword range }
           property labelcoverage: qword read getlabelcoverage;
          protected
           flabels    : pcaselabel;
@@ -1095,13 +1097,20 @@ implementation
     procedure tcasenode.updatecoverage;
 
       var
-        isord: boolean;
+        isord, first: boolean;
 
       procedure count(p : pcaselabel);
         begin
            inc(flabelcnt);
            if isord then
-             inc(flabelcoverage, (p^._high.svalue - p^._low.svalue) + 1);
+             begin
+               flabelcoverage:=flabelcoverage + (p^._high - p^._low);
+               { ensure we don't overflow in case it covers the
+                 full range of qword }
+               if not first then
+                 inc(flabelcoverage);
+               first:=false;
+             end;
            if assigned(p^.less) then
              count(p^.less);
            if assigned(p^.greater) then
@@ -1112,6 +1121,7 @@ implementation
         isord:=is_ordinal(left.resultdef);
         flabelcnt:=0;
         flabelcoverage:=0;
+        first:=true;
         count(flabels);
         fcountsuptodate:=true;
       end;
@@ -1133,10 +1143,12 @@ implementation
           dec(packedbitsize);
           if is_signed(def) then
             begin
+{$push}{$q-}
               if def.low<>(-(int64(1) shl packedbitsize)) then
                 exit;
               if def.high<>((int64(1) shl packedbitsize)-1) then
                 exit;
+{$pop}
             end
           else
             begin
@@ -1155,7 +1167,7 @@ implementation
       begin
         { Check label type coverage for enumerations and small types }
         getrange(left.resultdef,lv,hv);
-        typcount:=hv.svalue-lv.svalue+1;
+        typcount:=hv-lv;
         if not assigned(elseblock) then
           begin
             { unless cs_check_all_case_coverage is set, only check for enums, booleans and

+ 12 - 2
compiler/optdfa.pas

@@ -53,7 +53,7 @@ unit optdfa;
   implementation
 
     uses
-      globtype,
+      globtype,constexp,
       verbose,
       symconst,symdef,symsym,
       defutil,
@@ -225,6 +225,7 @@ unit optdfa;
           dfainfo : tdfainfo;
           l : TDFASet;
           save: TDFASet;
+          lv, hv: TConstExprInt;
           i : longint;
           counteruse_after_loop : boolean;
         begin
@@ -485,7 +486,16 @@ unit optdfa;
                 if assigned(tcasenode(node).elseblock) then
                   DFASetIncludeSet(l,tcasenode(node).elseblock.optinfo^.life)
                 else if assigned(node.successor) then
-                  DFASetIncludeSet(l,node.successor.optinfo^.life);
+                  begin
+                    if is_ordinal(tcasenode(node).left.resultdef) then
+                      begin
+                        getrange(tcasenode(node).left.resultdef,lv,hv);
+                        if tcasenode(node).labelcoverage<(hv-lv) then
+                          DFASetIncludeSet(l,node.successor.optinfo^.life);
+                      end
+                    else
+                      DFASetIncludeSet(l,node.successor.optinfo^.life);
+                  end;
 
                 { add use info from the "case" expression }
                 DFASetIncludeSet(l,tcasenode(node).optinfo^.use);

+ 22 - 18
compiler/parser.pas

@@ -225,31 +225,35 @@ implementation
       var
         i : longint;
       begin
-         new(preprocfile,init('pre'));
+         preprocfile:=tpreprocfile.create('pre_'+filename);
        { initialize a module }
-         set_current_module(new(pmodule,init(filename,false)));
+         set_current_module(tppumodule.create(nil,'',filename,false));
+         macrosymtablestack:=TSymtablestack.create;
+
+         current_scanner:=tscannerfile.Create(filename);
+         current_scanner.firstfile;
+         current_module.scanner:=current_scanner;
 
-         macrosymtablestack:= initialmacrosymtable;
+         { init macros before anything in the file is parsed.}
          current_module.localmacrosymtable:= tmacrosymtable.create(false);
-         current_module.localmacrosymtable.next:= initialmacrosymtable;
-         macrosymtablestack:= current_module.localmacrosymtable;
+         macrosymtablestack.push(initialmacrosymtable);
+         macrosymtablestack.push(current_module.localmacrosymtable);
+
+         { read the first token }
+         // current_scanner.readtoken(false);
 
          main_module:=current_module;
-       { startup scanner, and save in current_module }
-         current_scanner:=new(pscannerfile,Init(filename));
-         current_module.scanner:=current_scanner;
-       { loop until EOF is found }
          repeat
-           current_scanner^.readtoken(true);
-           preprocfile^.AddSpace;
+           current_scanner.readtoken(true);
+           preprocfile.AddSpace;
            case token of
              _ID :
                begin
-                 preprocfile^.Add(orgpattern);
+                 preprocfile.Add(orgpattern);
                end;
              _REALNUMBER,
              _INTCONST :
-               preprocfile^.Add(pattern);
+               preprocfile.Add(pattern);
              _CSTRING :
                begin
                  i:=0;
@@ -262,7 +266,7 @@ implementation
                        inc(i);
                      end;
                   end;
-                 preprocfile^.Add(''''+cstringpattern+'''');
+                 preprocfile.Add(''''+cstringpattern+'''');
                end;
              _CCHAR :
                begin
@@ -278,19 +282,19 @@ implementation
                    else
                      pattern:=''''+pattern[1]+'''';
                  end;
-                 preprocfile^.Add(pattern);
+                 preprocfile.Add(pattern);
                end;
              _EOF :
                break;
              else
-               preprocfile^.Add(tokeninfo^[token].str)
+               preprocfile.Add(tokeninfo^[token].str)
            end;
          until false;
        { free scanner }
-         dispose(current_scanner,done);
+         current_scanner.destroy;
          current_scanner:=nil;
        { close }
-         dispose(preprocfile,done);
+         preprocfile.destroy;
       end;
 {$endif PREPROCWRITE}
 

+ 9 - 9
compiler/pmodules.pas

@@ -733,14 +733,14 @@ implementation
           mf_init :
             begin
               result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit$'),potype_unitinit,st);
-              result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
+              result.procdef.aliasnames.concat(make_mangledname('INIT$',current_module.localsymtable,''));
             end;
           mf_finalize :
             begin
               result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit$'),potype_unitfinalize,st);
-              result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
+              result.procdef.aliasnames.concat(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               if (not current_module.is_unit) then
-                result.procdef.aliasnames.insert('PASCALFINALIZE');
+                result.procdef.aliasnames.concat('PASCALFINALIZE');
             end;
           else
             internalerror(200304253);
@@ -1085,7 +1085,7 @@ type
 
              { Compile the unit }
              init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init$'),potype_unitinit,current_module.localsymtable);
-             init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
+             init_procinfo.procdef.aliasnames.concat(make_mangledname('INIT$',current_module.localsymtable,''));
              init_procinfo.parse_body;
              { save file pos for debuginfo }
              current_module.mainfilepos:=init_procinfo.entrypos;
@@ -1095,7 +1095,7 @@ type
                begin
                  { Compile the finalize }
                  finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize$'),potype_unitfinalize,current_module.localsymtable);
-                 finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
+                 finalize_procinfo.procdef.aliasnames.concat(make_mangledname('FINALIZE$',current_module.localsymtable,''));
                  finalize_procinfo.parse_body;
                end
            end;
@@ -2132,9 +2132,9 @@ type
             main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
             { Win32 startup code needs a single name }
             if not(target_info.system in (systems_darwin+systems_aix)) then
-              main_procinfo.procdef.aliasnames.insert('PASCALMAIN')
+              main_procinfo.procdef.aliasnames.concat('PASCALMAIN')
             else
-              main_procinfo.procdef.aliasnames.insert(target_info.Cprefix+'PASCALMAIN');
+              main_procinfo.procdef.aliasnames.concat(target_info.Cprefix+'PASCALMAIN');
 
             { ToDo: systems that use indirect entry info, but check back with Windows! }
             if target_info.system in systems_darwin then
@@ -2166,7 +2166,7 @@ type
          else
            begin
              main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
-             main_procinfo.procdef.aliasnames.insert('PASCALMAIN');
+             main_procinfo.procdef.aliasnames.concat('PASCALMAIN');
            end;
          main_procinfo.parse_body;
          { save file pos for debuginfo }
@@ -2178,7 +2178,7 @@ type
               { Parse the finalize }
               finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize$'),potype_unitfinalize,current_module.localsymtable);
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
-              finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE');
+              finalize_procinfo.procdef.aliasnames.concat('PASCALFINALIZE');
               finalize_procinfo.parse_body;
            end;
 

+ 9 - 5
compiler/scanner.pas

@@ -234,7 +234,7 @@ interface
          spacefound,
          eolfound : boolean;
          constructor create(const fn:string);
-         destructor  destroy;
+         destructor  destroy; override;
          procedure Add(const s:string);
          procedure AddSpace;
        end;
@@ -2572,6 +2572,7 @@ type
 {$ifdef PREPROCWRITE}
     constructor tpreprocfile.create(const fn:string);
       begin
+        inherited create;
       { open outputfile }
         assign(f,fn);
         {$push}{$I-}
@@ -3947,11 +3948,14 @@ type
 {$ifdef PREPROCWRITE}
          if parapreprocess then
           begin
-            t:=Get_Directive(hs);
-            if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
+            if not (m_mac in current_settings.modeswitches) then
+              t:=tdirectiveitem(turbo_scannerdirectives.Find(hs))
+            else
+              t:=tdirectiveitem(mac_scannerdirectives.Find(hs));
+            if assigned(t) and not(t.is_conditional) then
              begin
-               preprocfile^.AddSpace;
-               preprocfile^.Add('{$'+hs+current_scanner.readcomment+'}');
+               preprocfile.AddSpace;
+               preprocfile.Add('{$'+hs+current_scanner.readcomment+'}');
                exit;
              end;
           end;

+ 7 - 1
compiler/symdef.pas

@@ -3408,7 +3408,13 @@ implementation
       begin
         inherited create(pointerdef,def);
         has_pointer_math:=cs_pointermath in current_settings.localswitches;
-        if df_specialization in tstoreddef(def).defoptions then
+        if (df_specialization in tstoreddef(def).defoptions)
+{$ifndef genericdef_for_nested}
+           { currently, nested procdefs of generic routines get df_specialisation,
+             but no genericdef }
+           and assigned(tstoreddef(def).genericdef)
+{$endif}
+           then
           genericdef:=cpointerdef.getreusable(tstoreddef(def).genericdef);
       end;
 

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

@@ -1176,6 +1176,7 @@ begin
      break;
     write([s,'(',slstr[sl],') ']);
     case sl of
+      sl_none : ;
       sl_call,
       sl_load,
       sl_subscript :

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

@@ -473,7 +473,7 @@ const
     ('dynamic');
 
   ConstTypeNames: array[TPpuConstType] of string =
-    ('', 'int', 'float', 'string', 'set', 'pointer');
+    ('unknown', 'int', 'float', 'string', 'set', 'pointer');
 
   OrdTypeNames: array[TPpuOrdType] of string =
     ('void', 'uint', 'sint', 'pasbool', 'bool', 'char', 'currency');
@@ -695,6 +695,7 @@ begin
     WriteStr('ValType', ConstTypeNames[ConstType]);
     s:='Value';
     case ConstType of
+      ctUnknown: ;
       ctInt:
         WriteInt(s, VInt);
       ctFloat:

+ 7 - 9
packages/fcl-fpcunit/src/fpcunit.pp

@@ -376,16 +376,14 @@ Const
 function CallerAddr: Pointer;
 
 Var
-  bp,pcaddr : pointer;
-  
+  address: CodePointer;
+  nframes: sizeint;
 begin
-  Result:=Nil;
-  bp:=get_frame;
-  pcaddr:=get_pc_addr;
-  get_caller_stackinfo(bp,pcaddr);
-  if bp<>Nil then
-    get_caller_stackinfo(bp,pcaddr);
-  result:=pcaddr;
+  nframes:=CaptureBacktrace(2,1,@address);
+  if nframes=1 then
+    result:=address
+  else
+    result:=nil;
 end;
 
 function AddrsToStr(Addrs: Pointer): string;

+ 48 - 0
packages/gdbint/src/gdbint.pp

@@ -70,6 +70,9 @@ interface
   {$info using gdb 7.12.x}
   {$define GDB_VERSION_RECOGNIZED}
   {$define GDB_VER_GE_712}
+  {$define GDB_NO_INSTREAM_VAR}
+  {$define GDB_CURRENT_UIOUT_MACRO}
+  {$define GDB_NEW_UI}
 {$endif}
 
 {$ifdef GDB_VER_GE_712}
@@ -81,6 +84,7 @@ interface
   {$info using gdb 7.11.x}
   {$define GDB_VERSION_RECOGNIZED}
   {$define GDB_VER_GE_711}
+  {$define GDB_HAS_SAVED_COMMAND_LINE_SIZE}
 {$endif}
 
 {$ifdef GDB_VER_GE_711}
@@ -1009,6 +1013,32 @@ function  inferior_pid : longint;
 {$ifdef GDB_V6}
 type
   ui_out = pointer;
+{$ifdef GDB_CURRENT_UIOUT_MACRO}
+type
+  pui_out = ^ui_out;
+function current_ui_current_uiout_ptr : ui_out;cdecl;external;
+var
+  cli_uiout : ui_out;
+  current_uiout : ui_out;
+  { out local copy for catch_exceptions call }
+  our_uiout : ui_out;
+
+type
+  pui = ^ui;
+  ui  = record
+   { ui record }
+   next : pui;
+   num : longint;
+  end;
+
+{$ifdef GDB_NEW_UI}
+var
+  local_ui : pui;
+
+function new_ui (instream, outstream,errstream: pui_file) : pui; cdecl;external;
+{$endif GDB_NEW_UI}
+
+{$else not GDB_CURRENT_UIOUT_MACRO}
 {$ifndef GDB_NO_UIOUT}
 var
   uiout : ui_out;cvar;external;
@@ -1019,6 +1049,7 @@ var
   { out local copy for catch_exceptions call }
   our_uiout : ui_out;
 {$endif GDB_NO_UIOUT}
+{$endif not GDB_CURRENT_UIOUT_MACRO}
 function cli_out_new (stream : pui_file):ui_out;cdecl;external;
 {$endif GDB_V6}
 
@@ -1838,16 +1869,23 @@ var
 {$endif GDB_HAS_DB_COMMANDS}
 
 {$ifdef GDB_NEEDS_SET_INSTREAM}
+{$ifndef GDB_NO_INSTREAM_VAR}
 var
   instream : P_C_FILE;cvar;external;
+{$endif not GDB_NO_INSTREAM_VAR}
+
   function gdb_fopen (filename : pchar; mode : pchar) : pui_file;cdecl;external;
 {$ifdef LIBGDB_HAS_GET_STDIN}
   { this function is generated by the gen-libgdb-inc.sh script
     in a object called gdb_get_stdin.o added to the libgdb.a archive }
   function gdb_get_stdin : P_C_FILE; cdecl; external;
+{$ifdef GDB_HAS_SAVED_COMMAND_LINE_SIZE}
+  { In some GDB versions, saved_command_line needs to 
+    be explicitly allocated at startup }
 var
   saved_command_line : pchar;cvar;external; { defined in top.c source }
   saved_command_line_size : longint;cvar;external; {defined in top.c source }
+{$endif def GDB_HAS_SAVED_COMMAND_LINE_SIZE}
 {$endif}
 {$endif GDB_NEEDS_SET_INSTREAM}
 var
@@ -3514,8 +3552,12 @@ begin
   gdb_stdin:=mem_fileopen;
   save_gdb_stdin:=gdb_stdin;
 {$ifdef LIBGDB_HAS_GET_STDIN}
+{$ifndef GDB_NO_INSTREAM_VAR}
   instream:=gdb_get_stdin;
+{$endif ndef GDB_NO_INSTREAM_VAR}
+{$ifdef GDB_HAS_SAVED_COMMAND_LINE_SIZE}
   saved_command_line:=xmalloc(saved_command_line_size);
+{$endif def GDB_HAS_SAVED_COMMAND_LINE_SIZE}
 {$else}
   dummy_file :=gdb_fopen('dummy.$$$','a');
   {in captured_main code, this is simply
@@ -3558,6 +3600,9 @@ begin
   uiout := cli_out_new (gdb_stdout);
 {$endif not GDB_NO_UIOUT}
 {$endif GDB_V6}
+{$ifdef GDB_NEW_UI}
+  local_ui := new_ui (gdb_stdin,gdb_stdout,gdb_stderr);
+{$endif not GDB_NEW_UI}
 {$ifdef GDB_INIT_HAS_ARGV0}
   getmem(argv0,length(paramstr(0))+1);
   strpcopy(argv0,paramstr(0));
@@ -3591,6 +3636,9 @@ begin
   current_uiout:=cli_uiout;
   our_uiout:=cli_uiout;
 {$endif GDB_NO_UIOUT}
+{$ifdef GDB_NEW_UI}
+  local_ui := new_ui (gdb_stdin,gdb_stdout,gdb_stderr);
+{$endif not GDB_NEW_UI}
 {$endif GDB_NEEDS_INTERPRETER_SETUP}
 {$ifdef supportexceptions}
   {$ifdef unix}

+ 301 - 66
packages/libffi/src/ffi.manager.pp

@@ -280,7 +280,7 @@ begin
     Result := @ffi_type_pointer;
 end;
 
-function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Pointer;
+function ArgIsIndirect(aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Boolean;
 const
   ResultTypeNeedsIndirection = [
    tkAString,
@@ -290,12 +290,12 @@ const
    tkDynArray
   ];
 begin
-  Result := aValue;
+  Result := False;
   if (aKind = tkSString) or
       (aIsResult and (aKind in ResultTypeNeedsIndirection)) or
       (aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) or
       ((aKind = tkUnknown) and (pfConst in aFlags)) then
-    Result := @aValue;
+    Result := True;
 end;
 
 procedure FFIValueToValue(Source, Dest: Pointer; TypeInfo: PTypeInfo);
@@ -391,41 +391,47 @@ begin
   end;
 end;
 
-procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
-            aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
-
-  function CallConvName: String; inline;
-  begin
-    WriteStr(Result, aCallConv);
-  end;
-
 { on X86 platforms Currency and Comp results are passed by the X87 if the
   Extended type is available }
 {$if (defined(CPUI8086) or defined(CPUI386) or defined(CPUX86_64)) and defined(FPC_HAS_TYPE_EXTENDED) and (not defined(FPC_COMP_IS_INT64) or not defined(FPC_CURRENCY_IS_INT64))}
 {$define USE_EXTENDED_AS_COMP_CURRENCY_RES}
 {$endif}
 
+type
+  TFFIData = record
+    Types: array of pffi_type;
+    Values: array of Pointer;
+    Indirect: array of Boolean;
+    ResultType: pffi_type;
+    ResultValue: Pointer;
+    ResultIndex: SizeInt;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    ResultTypeData: PTypeData;
+    ResultExtended: Extended;
+{$endif}
+    { put this at the end just in case we messed up the size }
+    CIF: ffi_cif;
+  end;
+
+procedure CreateCIF(constref aArgInfos: array of TFunctionCallParameterInfo; constref aArgValues: array of Pointer; aCallConv: TCallConv; aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags; out aData: TFFIData);
+
+  function CallConvName: String; inline;
+  begin
+    WriteStr(Result, aCallConv);
+  end;
+
 var
   abi: ffi_abi;
-  argtypes: array of pffi_type;
-  argvalues: array of Pointer;
-  rtype: pffi_type;
-  rvalue: Pointer;
-  i, arglen, argoffset, retidx, argstart: LongInt;
-  cif: ffi_cif;
-  retparam: Boolean;
+  i, arglen, argoffset, argstart: LongInt;
+  usevalues, retparam: Boolean;
   kind: TTypeKind;
-{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
-  restypedata: PTypeData;
-  resextended: Extended;
-{$endif}
+  types: ppffi_type;
 begin
-  if Assigned(aResultType) and not Assigned(aResultValue) then
-    raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
-
-  if not (fcfStatic in aFlags) and (Length(aArgs) = 0) then
+  if not (fcfStatic in aFlags) and (Length(aArgInfos) = 0) then
     raise EInvocationError.Create(SErrMissingSelfParam);
 
+  Assert((Length(aArgInfos) = Length(aArgValues)) or (Length(aArgValues) = 0), 'Amount of arguments does not match needed arguments');
+
   case aCallConv of
 {$if defined(CPUI386)}
     ccReg:
@@ -457,112 +463,341 @@ begin
       raise EInvocationError.CreateFmt(SErrCallConvNotSupported, [CallConvName]);
   end;
 
+  { if no values are provided we are called to prepare a callback, otherwise
+    we are asked to prepare a invokation }
+  usevalues := (Length(aArgInfos) > 0) and (Length(aArgValues) > 0);
+
   retparam := RetInParam(aCallConv, aResultType);
 
-  arglen := Length(aArgs);
+  arglen := Length(aArgInfos);
   if retparam then begin
     Inc(arglen);
+    usevalues := True;
     argoffset := 1;
-    retidx := 0;
+    aData.ResultIndex := 0;
   end else begin
     argoffset := 0;
-    retidx := -1;
+    aData.ResultIndex := -1;
   end;
 
-  SetLength(argtypes, arglen);
-  SetLength(argvalues, arglen);
+  SetLength(aData.Types, arglen);
+  SetLength(aData.Indirect, arglen);
+  if usevalues then
+    SetLength(aData.Values, arglen);
 
   { the order is Self/Vmt (if any), Result param (if any), other params }
 
   if not (fcfStatic in aFlags) and retparam then begin
-    argtypes[0] := TypeInfoToFFIType(aArgs[0].Info.ParamType, aArgs[0].Info.ParamFlags);
-    if Assigned(aArgs[0].Info.ParamType) then
-      kind := aArgs[0].Info.ParamType^.Kind
+    aData.Types[0] := TypeInfoToFFIType(aArgInfos[0].ParamType, aArgInfos[0].ParamFlags);
+    if Assigned(aArgInfos[0].ParamType) then
+      kind := aArgInfos[0].ParamType^.Kind
     else
       kind := tkUnknown;
-    argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, kind, aArgs[0].Info.ParamFlags, False);
+    aData.Indirect[0] := ArgIsIndirect(kind, aArgInfos[0].ParamFlags, False);
+    if usevalues then
+      if aData.Indirect[0] then
+        aData.Values[0] := @aArgValues[0]
+      else
+        aData.Values[0] := aArgValues[0];
     if retparam then
-      Inc(retidx);
+      Inc(aData.ResultIndex);
     argstart := 1;
   end else
     argstart := 0;
 
-  for i := Low(aArgs) + argstart to High(aArgs) do begin
-    argtypes[i - Low(aArgs) + Low(argtypes) + argoffset] := TypeInfoToFFIType(aArgs[i].Info.ParamType, aArgs[i].Info.ParamFlags);
-    if Assigned(aArgs[i].Info.ParamType) then
-      kind := aArgs[i].Info.ParamType^.Kind
+  for i := argstart to High(aArgInfos) do begin
+    aData.Types[i + argoffset] := TypeInfoToFFIType(aArgInfos[i].ParamType, aArgInfos[i].ParamFlags);
+    if (pfResult in aArgInfos[i].ParamFlags) and not retparam then
+      aData.ResultIndex := i + argoffset;
+    if Assigned(aArgInfos[i].ParamType) then
+      kind := aArgInfos[i].ParamType^.Kind
     else
       kind := tkUnknown;
-    argvalues[i - Low(aArgs) + Low(argtypes) + argoffset] := ValueToFFIValue(aArgs[i].ValueRef, kind, aArgs[i].Info.ParamFlags, False);
+    aData.Indirect[i + argoffset] := ArgIsIndirect(kind, aArgInfos[i].ParamFlags, False);
+    if usevalues then
+      if aData.Indirect[i + argoffset] then
+        aData.Values[i + argoffset] := @aArgValues[i]
+      else
+        aData.Values[i + argoffset] := aArgValues[i];
   end;
 
   if retparam then begin
-    argtypes[retidx] := TypeInfoToFFIType(aResultType, []);
-    argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True);
-    rtype := @ffi_type_void;
-    rvalue := Nil;
+    aData.Types[aData.ResultIndex] := TypeInfoToFFIType(aResultType, []);
+    aData.Indirect[aData.ResultIndex] := ArgIsIndirect(aResultType^.Kind, [], True);
+    if usevalues then
+      if aData.Indirect[aData.ResultIndex] then
+        aData.Values[aData.ResultIndex] := @aResultValue
+      else
+        aData.Values[aData.ResultIndex] := aResultValue;
+    aData.ResultType := @ffi_type_void;
+    aData.ResultValue := Nil;
 {$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
-    restypedata := Nil;
+    aData.ResultTypeData := Nil;
 {$endif}
   end else begin
-    rvalue := Nil;
+    aData.ResultValue := Nil;
 {$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
     { special case for Comp/Currency as such arguments are passed as Int64,
       but the result is handled through the X87 }
     if Assigned(aResultType) and (aResultType^.Kind = tkFloat) then begin
-      restypedata := GetTypeData(aResultType);
-      case restypedata^.FloatType of
+      aData.ResultTypeData := GetTypeData(aResultType);
+      case aData.ResultTypeData^.FloatType of
 {$ifndef FPC_CURRENCY_IS_INT64}
         ftCurr: begin
-          rtype := @ffi_type_longdouble;
-          rvalue := @resextended;
+          aData.ResultType := @ffi_type_longdouble;
+          aData.ResultValue := @aData.ResultExtended;
         end;
 {$endif}
 {$ifndef FPC_COMP_IS_INT64}
         ftComp: begin
-          rtype := @ffi_type_longdouble;
-          rvalue := @resextended;
+          aData.ResultType := @ffi_type_longdouble;
+          aData.ResultValue := @aData.ResultExtended;
         end;
 {$endif}
       end;
     end else
-      restypedata := Nil;
+      aData.ResultTypeData := Nil;
 {$endif}
-    if not Assigned(rvalue) then begin
-      rtype := TypeInfoToFFIType(aResultType, []);
+    if not Assigned(aData.ResultValue) then begin
+      aData.ResultType := TypeInfoToFFIType(aResultType, []);
       if Assigned(aResultType) then
-        rvalue := aResultValue
+        aData.ResultValue := aResultValue
       else
-        rvalue := Nil;
+        aData.ResultValue := Nil;
     end;
   end;
 
-  if ffi_prep_cif(@cif, abi, arglen, rtype, @argtypes[0]) <> FFI_OK then
+  if Assigned(aData.Types) then
+    types := @aData.Types[0]
+  else
+    types := Nil;
+
+  if ffi_prep_cif(@aData.CIF, abi, arglen, aData.ResultType, types) <> FFI_OK then
     raise EInvocationError.Create(SErrInvokeFailed);
+end;
+
+procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
+            aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
+var
+  ffidata: TFFIData;
+  i: SizeInt;
+  arginfos: array of TFunctionCallParameterInfo;
+  argvalues: array of Pointer;
+begin
+  if Assigned(aResultType) and not Assigned(aResultValue) then
+    raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
+
+  SetLength(arginfos, Length(aArgs));
+  SetLength(argvalues, Length(aArgs));
+  for i := 0 to High(aArgs) do begin
+    arginfos[i] := aArgs[i].Info;
+    argvalues[i] := aArgs[i].ValueRef;
+  end;
+  CreateCIF(arginfos, argvalues, aCallConv, aResultType, aResultValue, aFlags, ffidata);
 
-  ffi_call(@cif, ffi_fn(aCodeAddress), rvalue, @argvalues[0]);
+  arginfos := Nil;
+  argvalues := Nil;
+
+  ffi_call(@ffidata.CIF, ffi_fn(aCodeAddress), ffidata.ResultValue, @ffidata.Values[0]);
 
 {$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
-  if Assigned(restypedata) then begin
-    case restypedata^.FloatType of
+  if Assigned(ffidata.ResultTypeData) then begin
+    case ffidata.ResultTypeData^.FloatType of
 {$ifndef FPC_CURRENCY_IS_INT64}
       ftCurr:
-        PCurrency(aResultValue)^ := Currency(resextended) / 10000;
+        PCurrency(aResultValue)^ := Currency(ffidata.ResultExtended / 10000);
 {$endif}
 {$ifndef FPC_COMP_IS_INT64}
       ftComp:
-        PComp(aResultValue)^ := Comp(resextended);
+        PComp(aResultValue)^ := Comp(ffidata.ResultExtended);
 {$endif}
     end;
   end;
 {$endif}
 end;
 
+type
+  TFFIFunctionCallback = class(TFunctionCallCallback)
+  private
+    fFFIData: TFFIData;
+    fData: Pointer;
+    fCode: CodePointer;
+    fContext: Pointer;
+  private
+    class procedure ClosureFunc(aCIF: pffi_cif; aRet: Pointer; aArgs: PPointer; aUserData: Pointer); cdecl; static;
+    procedure PassToHandler(aRet: Pointer; aArgs: PPointer);
+  protected
+    function GetCodeAddress: CodePointer; override;
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); virtual; abstract;
+  public
+    constructor Create(aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+    destructor Destroy; override;
+  end;
+
+  TFFIFunctionCallbackMethod = class(TFFIFunctionCallback)
+  private
+    fHandler: TFunctionCallMethod;
+  protected
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); override;
+  public
+    constructor Create(aHandler: TFunctionCallMethod; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+  end;
+
+  TFFIFunctionCallbackProc = class(TFFIFunctionCallback)
+  private
+    fHandler: TFunctionCallProc;
+  protected
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); override;
+  public
+    constructor Create(aHandler: TFunctionCallProc; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+  end;
+
+class procedure TFFIFunctionCallback.ClosureFunc(aCIF: pffi_cif; aRet: Pointer; aArgs: PPointer; aUserData: Pointer); cdecl;
+var
+  this: TFFIFunctionCallback absolute aUserData;
+begin
+  this.PassToHandler(aRet, aArgs);
+end;
+
+procedure TFFIFunctionCallback.PassToHandler(aRet: Pointer; aArgs: PPointer);
+var
+  args: array of Pointer;
+  i, arglen, argidx: SizeInt;
+  resptr: Pointer;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+{$ifndef FPC_COMP_IS_INT64}
+  rescomp: Comp;
+{$endif}
+{$ifndef FPC_CURR_IS_INT64}
+  rescurr: Currency;
+{$endif}
+{$endif}
+begin
+  arglen := Length(fFFIData.Types);
+  if fFFIData.ResultIndex >= 0 then
+    Dec(arglen);
+  SetLength(args, arglen);
+  argidx := 0;
+  for i := 0 to High(fFFIData.Types) do begin
+    if i = fFFIData.ResultIndex then
+      Continue;
+    args[argidx] := aArgs[i];
+    if fFFIData.Indirect[i] then
+      args[argidx] := PPointer(aArgs[i])^
+    else
+      args[argidx] := aArgs[i];
+    Inc(argidx);
+  end;
+
+  if fFFIData.ResultIndex >= 0 then begin
+    if fFFIData.Indirect[fFFIData.ResultIndex] then
+      resptr := PPointer(aArgs[fFFIData.ResultIndex])^
+    else
+      resptr := aArgs[fFFIData.ResultIndex];
+  end else begin
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    resptr := Nil;
+    if Assigned(fFFIData.ResultTypeData) then begin
+      case fFFIData.ResultTypeData^.FloatType of
+{$ifndef FPC_COMP_IS_INT64}
+        ftComp:
+          resptr := @rescomp;
+{$endif}
+{$ifndef FPC_CURR_IS_INT64}
+        ftCurr:
+          resptr := @rescurr;
+{$endif}
+      end;
+    end;
+    if not Assigned(resptr) then
+{$endif}
+      resptr := aRet;
+  end;
+
+  CallHandler(args, resptr, fContext);
+
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+  if Assigned(fFFIData.ResultTypeData) then begin
+    case fFFIData.ResultTypeData^.FloatType of
+{$ifndef FPC_COMP_IS_INT64}
+      ftComp:
+        PExtended(aRet)^ := rescomp;
+{$endif}
+{$ifndef FPC_CURR_IS_INT64}
+      ftCurr:
+        PExtended(aRet) ^ := rescurr * 10000;
+{$endif}
+    end;
+  end;
+{$endif}
+end;
+
+function TFFIFunctionCallback.GetCodeAddress: CodePointer;
+begin
+  Result := fData;
+end;
+
+constructor TFFIFunctionCallback.Create(aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+var
+  res: ffi_status;
+begin
+  fContext := aContext;
+
+  CreateCIF(aArgs, [], aCallConv, aResultType, Nil, aFlags, fFFIData);
+
+  fData := ffi_closure_alloc(SizeOf(ffi_closure), @fCode);
+  if not Assigned(fData) or not Assigned(fCode) then
+    raise ERTTI.Create(SErrMethodImplCreateFailed);
+
+  res := ffi_prep_closure_loc(pffi_closure(fData), @fFFIData.CIF, @ClosureFunc, Self, fCode);
+  if res <> FFI_OK then
+    raise ERTTI.Create(SErrMethodImplCreateFailed);
+end;
+
+destructor TFFIFunctionCallback.Destroy;
+begin
+  if Assigned(fData) then
+    ffi_closure_free(fData);
+end;
+
+constructor TFFIFunctionCallbackProc.Create(aHandler: TFunctionCallProc; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+begin
+  inherited Create(aContext, aCallConv, aArgs, aResultType, aFlags);
+  fHandler := aHandler;
+end;
+
+procedure TFFIFunctionCallbackProc.CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
+begin
+  fHandler(aArgs, aResult, aContext);
+end;
+
+constructor TFFIFunctionCallbackMethod.Create(aHandler: TFunctionCallMethod; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+begin
+  inherited Create(aContext, aCallConv, aArgs, aResultType, aFlags);
+  fHandler := aHandler;
+end;
+
+procedure TFFIFunctionCallbackMethod.CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
+begin
+  fHandler(aArgs, aResult, aContext);
+end;
+
+function FFICreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
+begin
+  Result := TFFIFunctionCallbackProc.Create(aHandler, aContext, aCallConv, aArgs, aResultType, aFlags);
+end;
+
+function FFICreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
+begin
+  Result := TFFIFunctionCallbackMethod.Create(aHandler, aContext, aCallConv, aArgs, aResultType, aFlags);
+end;
+
+
 const
   FFIManager: TFunctionCallManager = (
     Invoke: @FFIInvoke;
-    CreateCallbackProc: Nil;
-    CreateCallbackMethod: Nil;
+    CreateCallbackProc: @FFICreateCallbackProc;
+    CreateCallbackMethod: @FFICreateCallbackMethod;
   );
 
 var

+ 192 - 1
packages/rtl-objpas/src/inc/rtti.pp

@@ -485,6 +485,31 @@ type
     property DeclaringUnitName: string read GetDeclaringUnitName;
   end;
 
+  TVirtualInterfaceInvokeEvent = procedure(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue) of object;
+
+  TVirtualInterface = class(TInterfacedObject, IInterface)
+  private
+    fGUID: TGUID;
+    fOnInvoke: TVirtualInterfaceInvokeEvent;
+    fContext: TRttiContext;
+    fImpls: array of TMethodImplementation;
+    fVmt: PCodePointer;
+    fQueryInterfaceType: TRttiType;
+    fAddRefType: TRttiType;
+    fReleaseType: TRttiType;
+  protected
+    function QueryInterface(constref aIID: TGuid; out aObj): LongInt;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+    procedure HandleIInterfaceCallback(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
+    procedure HandleUserCallback(aUserData: Pointer; const aArgs: TValueArray; out aResult: TValue);
+  public
+    constructor Create(aPIID: PTypeInfo);
+    constructor Create(aPIID: PTypeInfo; aInvokeEvent: TVirtualInterfaceInvokeEvent);
+    destructor Destroy; override;
+    property OnInvoke: TVirtualInterfaceInvokeEvent read fOnInvoke write fOnInvoke;
+  end;
+
+
   ERtti = class(Exception);
   EInsufficientRtti = class(ERtti);
   EInvocationError = class(ERtti);
@@ -539,6 +564,7 @@ resourcestring
   SErrInvokeNotImplemented = 'Invoke functionality is not implemented';
   SErrInvokeResultTypeNoValue = 'Function has a result type, but no result pointer provided';
   SErrInvokeFailed = 'Invoke call failed';
+  SErrMethodImplCreateFailed  = 'Failed to create method implementation';
   SErrCallbackNotImplemented = 'Callback functionality is not implemented';
   SErrCallConvNotSupported = 'Calling convention not supported: %s';
   SErrTypeKindNotSupported = 'Type kind is not supported: %s';
@@ -702,8 +728,17 @@ resourcestring
   SErrInvokeCallableNotMethod = 'The callable value is not a method variable for: %s';
   SErrMethodImplNoCallback    = 'No callback specified for method implementation';
   SErrMethodImplInsufficientRtti = 'Insufficient RTTI to create method implementation';
-  SErrMethodImplCreateFailed  = 'Failed to create method implementation';
   SErrMethodImplCreateNoArg   = 'TMethodImplementation can not be created this way';
+  SErrVirtIntfTypeNil = 'No type information provided for TVirtualInterface';
+  SErrVirtIntfTypeMustBeIntf = 'Type ''%s'' is not an interface type';
+  SErrVirtIntfTypeNotFound = 'Type ''%s'' is not valid';
+  SErrVirtIntfNotAllMethodsRTTI = 'Not all methods of ''%s'' or its parents have the required RTTI';
+  SErrVirtIntfRetrieveIInterface = 'Failed to retrieve IInterface information';
+  SErrVirtIntfCreateImpl = 'Failed to create implementation for method ''%1:s'' of ''%0:s''';
+  SErrVirtIntfInvalidVirtIdx = 'Virtual index %2:d for method ''%1:s'' of ''%0:s'' is invalid';
+  SErrVirtIntfMethodNil = 'Method %1:d of ''%0:s'' is Nil';
+  SErrVirtIntfCreateVmt = 'Failed to create VMT for ''%s''';
+  SErrVirtIntfIInterface = 'Failed to prepare IInterface method callbacks';
 
 var
   PoolRefCount : integer;
@@ -3654,6 +3689,162 @@ begin
   result := (FContextToken as IPooltoken).RttiPool.GetTypes;
 end;}
 
+type
+  TQueryInterface = function(constref aIID: TGUID; out aObj): LongInt of object;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+  TAddRef = function: LongInt of object;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+  TRelease = function: LongInt of object;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+{ TVirtualInterface }
+
+{.$define DEBUG_VIRTINTF}
+
+constructor TVirtualInterface.Create(aPIID: PTypeInfo);
+
+  function GetIInterfaceMethod(aTypeInfo: PTypeInfo; const aName: String; out aType: TRttiType): TMethodImplementation;
+  begin
+    aType := fContext.GetType(aTypeInfo);
+    if not (aType is TRttiMethodType) then
+      raise EInsufficientRtti.Create(SErrVirtIntfIInterface) at get_caller_addr(get_frame), get_caller_frame(get_frame);
+
+    Result := TRttiMethodType(aType).CreateImplementation(@HandleIInterfaceCallback);
+    if not Assigned(Result) then
+      raise ERtti.CreateFmt(SErrVirtIntfCreateImpl, [aPIID^.Name, aName]) at get_caller_addr(get_frame), get_caller_frame(get_frame);
+  end;
+
+var
+  t: TRttiType;
+  ti: PTypeInfo;
+  td: PInterfaceData;
+  methods: specialize TArray<TRttiMethod>;
+  m: TRttiMethod;
+  mt: PIntfMethodTable;
+  count, i: SizeInt;
+begin
+  if not Assigned(aPIID) then
+    raise EArgumentNilException.Create(SErrVirtIntfTypeNil);
+  { ToDo: add support for raw interfaces once they support RTTI }
+  if aPIID^.Kind <> tkInterface then
+    raise EArgumentException.CreateFmt(SErrVirtIntfTypeMustBeIntf, [aPIID^.Name]);
+
+  fContext := TRttiContext.Create;
+  t := fContext.GetType(aPIID);
+  if not Assigned(t) then
+    raise EInsufficientRtti.CreateFmt(SErrVirtIntfTypeNotFound, [aPIID^.Name]);
+
+  { check whether the interface and all its parents have RTTI enabled (the only
+    exception is IInterface as we know the methods of that) }
+  td := PInterfaceData(GetTypeData(aPIID));
+
+  fGUID := td^.GUID;
+
+  ti := aPIID;
+  { we have at least the three methods of IInterface }
+  count := 3;
+  while ti <> TypeInfo(IInterface) do begin
+    mt := td^.MethodTable;
+    if (mt^.Count > 0) and (mt^.RTTICount <> mt^.Count) then
+      raise EInsufficientRtti.CreateFmt(SErrVirtIntfNotAllMethodsRTTI, [aPIID^.Name]);
+    Inc(count, mt^.Count);
+    ti := td^.Parent^;
+    td := PInterfaceData(GetTypeData(ti));
+  end;
+
+  SetLength(fImpls, count);
+
+  fImpls[0] := GetIInterfaceMethod(TypeInfo(TQueryInterface), 'QueryInterface', fQueryInterfaceType);
+  fImpls[1] := GetIInterfaceMethod(TypeInfo(TAddRef), 'AddRef', fAddRefType);
+  fImpls[2] := GetIInterfaceMethod(TypeInfo(TRelease), 'Release', fReleaseType);
+
+  methods := t.GetMethods;
+  for m in methods do begin
+    if m.VirtualIndex > High(fImpls) then
+      raise ERtti.CreateFmt(SErrVirtIntfInvalidVirtIdx, [aPIID^.Name, m.Name]);
+    { we use the childmost entry, except for the IInterface methods }
+    if Assigned(fImpls[m.VirtualIndex]) then begin
+      {$IFDEF DEBUG_VIRTINTF}Writeln('Ignoring duplicate implementation for index ', m.VirtualIndex);{$ENDIF}
+      Continue;
+    end;
+    fImpls[m.VirtualIndex] := m.CreateImplementation(m, @HandleUserCallback);
+  end;
+
+  for i := 0 to High(fImpls) do
+    if not Assigned(fImpls) then
+      raise ERtti.CreateFmt(SErrVirtIntfMethodNil, [aPIID^.Name, i]);
+
+  fVmt := GetMem(Length(fImpls) * SizeOf(CodePointer));
+  if not Assigned(fVmt) then
+    raise ERtti.CreateFmt(SErrVirtIntfCreateVmt, [aPIID^.Name]);
+
+  for i := 0 to High(fImpls) do begin
+    fVmt[i] := fImpls[i].CodeAddress;
+    {$IFDEF DEBUG_VIRTINTF}Writeln('VMT ', i, ': ', HexStr(fVmt[i]));{$ENDIF}
+  end;
+end;
+
+constructor TVirtualInterface.Create(aPIID: PTypeInfo; aInvokeEvent: TVirtualInterfaceInvokeEvent);
+begin
+  Create(aPIID);
+  OnInvoke := aInvokeEvent;
+end;
+
+destructor TVirtualInterface.Destroy;
+var
+  impl: TMethodImplementation;
+begin
+  {$IFDEF DEBUG_VIRTINTF}Writeln('Freeing implementations');{$ENDIF}
+  for impl in fImpls do
+    impl.Free;
+  {$IFDEF DEBUG_VIRTINTF}Writeln('Freeing VMT');{$ENDIF}
+  if Assigned(fVmt) then
+    FreeMem(fVmt);
+  {$IFDEF DEBUG_VIRTINTF}Writeln('Freeing Context');{$ENDIF}
+  fContext.Free;
+  {$IFDEF DEBUG_VIRTINTF}Writeln('Done');{$ENDIF}
+  inherited Destroy;
+end;
+
+function TVirtualInterface.QueryInterface(constref aIID: TGuid; out aObj): LongInt;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+  {$IFDEF DEBUG_VIRTINTF}Writeln('QueryInterface for ', GUIDToString(aIID));{$ENDIF}
+  if IsEqualGUID(aIID, fGUID) then begin
+    {$IFDEF DEBUG_VIRTINTF}Writeln('Returning ', HexStr(@fVmt));{$ENDIF}
+    Pointer(aObj) := @fVmt;
+    { QueryInterface increases the reference count }
+    _AddRef;
+    Result := S_OK;
+  end else
+    Result := inherited QueryInterface(aIID, aObj);
+end;
+
+procedure TVirtualInterface.HandleIInterfaceCallback(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
+var
+  res: LongInt;
+  guid: TGuid;
+begin
+  {$IFDEF DEBUG_VIRTINTF}Writeln(aInvokable.Name);{$ENDIF}
+  if aInvokable = fQueryInterfaceType then begin
+    {$IFDEF DEBUG_VIRTINTF}Writeln('Call for QueryInterface');{$ENDIF}
+    Move(aArgs[1].GetReferenceToRawData^, guid, SizeOf(guid));
+    res := QueryInterface(guid, PPointer(aArgs[2].GetReferenceToRawData)^);
+    TValue.Make(@res, TypeInfo(LongInt), aResult);
+  end else if aInvokable = fAddRefType then begin
+    {$IFDEF DEBUG_VIRTINTF}Writeln('Call for AddRef');{$ENDIF}
+    res := _AddRef;
+    TValue.Make(@res, TypeInfo(LongInt), aResult);
+  end else if aInvokable = fReleaseType then begin
+    {$IFDEF DEBUG_VIRTINTF}Writeln('Call for Release');{$ENDIF}
+    res := _Release;
+    TValue.Make(@res, TypeInfo(LongInt), aResult);
+  end;
+end;
+
+procedure TVirtualInterface.HandleUserCallback(aUserData: Pointer; const aArgs: TValueArray; out aResult: TValue);
+begin
+  {$IFDEF DEBUG_VIRTINTF}Writeln('Call for ', TRttiMethod(aUserData).Name);{$ENDIF}
+  if Assigned(fOnInvoke) then
+    fOnInvoke(TRttiMethod(aUserData), aArgs, aResult);
+end;
+
 {$ifndef InLazIDE}
 {$if defined(CPUI386) or (defined(CPUX86_64) and defined(WIN64))}
 {$I invoke.inc}

+ 1 - 0
packages/rtl-objpas/tests/testrunner.rtlobjpas.pp

@@ -14,6 +14,7 @@ program testrunner.rtlobjpas;
 {$else}
 {$ifdef useffi}
 {$define testinvoke}
+{$define testimpl}
 {$endif}
 {$endif}
 

+ 259 - 0
packages/rtl-objpas/tests/tests.rtti.impl.pas

@@ -28,12 +28,16 @@ type
     ResultValue: TValue;
     InOutMapping: array of SizeInt;
     InputUntypedTypes: array of PTypeInfo;
+    InvokedMethodName: String;
 
+    procedure OnHandleIntfMethod(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue);
+    procedure DoIntfImpl(aIntf: IInterface; aTypeInfo: PTypeInfo; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 {$ifdef fpc}
     procedure OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
     procedure DoMethodImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
     procedure DoProcImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 {$ifndef InLazIDE}
+    {$ifdef fpc}generic{$endif} procedure GenDoIntfImpl<T: IInterface>(aIntf: T; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
     {$ifdef fpc}generic{$endif} procedure GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
     {$ifdef fpc}generic{$endif} procedure GenDoProcImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 {$endif}
@@ -43,6 +47,7 @@ type
     procedure Status(const aMsg: String; const aArgs: array of const); inline;
 {$endif}
   published
+    procedure TestIntfMethods;
 {$ifdef fpc}
     procedure TestMethodVars;
     procedure TestProcVars;
@@ -52,6 +57,34 @@ type
 implementation
 
 type
+  {$push}
+  {$M+}
+  ITestInterface = interface
+    ['{1DE799BB-BEE9-405F-9AF3-D55DE978C793}']
+    procedure TestMethod1;
+    function  TestMethod2(aArg1: SizeInt): SizeInt;
+    procedure TestMethod3(aArg1: AnsiString);
+    procedure TestMethod4(aArg1: ShortString);
+    function  TestMethod5: AnsiString;
+    function  TestMethod6: ShortString;
+    procedure TestMethod7(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt);
+    procedure TestMethod8(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString);
+    procedure TestMethod9(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString);
+    procedure TestMethod10(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single);
+    procedure TestMethod11(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double);
+    procedure TestMethod12(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended);
+    procedure TestMethod13(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp);
+    procedure TestMethod14(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency);
+    function  TestMethod15(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
+    function  TestMethod16(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
+    function  TestMethod17(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
+    function  TestMethod18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
+    function  TestMethod19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
+    function  TestMethod20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
+    procedure TestMethod21(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+  end;
+  {$pop}
+
   TTestMethod1 = procedure of object;
   TTestMethod2 = function(aArg1: SizeInt): SizeInt of object;
   TTestMethod3 = procedure(aArg1: AnsiString) of object;
@@ -210,6 +243,110 @@ begin
 end;
 {$endif}
 
+procedure TTestImpl.OnHandleIntfMethod(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue);
+var
+  selfofs, i: SizeInt;
+  name: String;
+begin
+  selfofs := 1;
+
+  Status('In Callback');
+  InvokedMethodName :=  aMethod.Name;
+  Status('Self: ' + HexStr(Self));
+  if Assigned(aMethod.ReturnType) then
+    aResult := CopyValue(ResultValue);
+  Status('Setting input args');
+  SetLength(InputArgs, Length(aArgs));
+  for i := 0 to High(aArgs) do begin
+    Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]);
+    if Assigned(InputUntypedTypes[i]) then
+      TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i])
+    else
+      InputArgs[i] := CopyValue(aArgs[i]);
+  end;
+  Status('Setting output args');
+  { Note: account for Self }
+  for i := 0 to High(InOutMapping) do begin
+    Status('OutputArg %d -> Arg %d', [i, InOutMapping[i] + selfofs]);
+    { check input arg type? }
+    Move(OutputArgs[i].GetReferenceToRawData^, aArgs[InOutMapping[i] + selfofs].GetReferenceToRawData^, OutputArgs[i].DataSize);
+  end;
+  Status('Callback done');
+end;
+
+procedure TTestImpl.DoIntfImpl(aIntf: IInterface; aTypeInfo: PTypeInfo; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
+var
+  context: TRttiContext;
+  t: TRttiType;
+  instance, res: TValue;
+  method: TRttiMethod;
+  i: SizeInt;
+  input: array of TValue;
+  intf: TRttiInterfaceType;
+  mrec: TMethod;
+  name: String;
+  params: array of TRttiParameter;
+begin
+  name := 'TestMethod' + IntToStr(aIndex);
+
+  context := TRttiContext.Create;
+  try
+    t := context.GetType(aTypeInfo);
+    Check(t is TRttiInterfaceType, 'Not a interface type: ' + aTypeInfo^.Name);
+    intf := t as TRttiInterfaceType;
+
+    method := intf.GetMethod(name);
+    Check(Assigned(method), 'Method not found: ' + name);
+
+    Status('Executing method %s', [name]);
+
+    CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
+    Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
+
+    params := method.GetParameters;
+
+    TValue.Make(@aIntf, aTypeInfo, instance);
+
+    { arguments might be modified by Invoke (Note: Copy() does not uniquify the
+      IValueData of managed types) }
+    SetLength(input, Length(aInputArgs) + 1);
+    SetLength(InputUntypedTypes, Length(aInputArgs) + 1);
+    input[0] := instance;
+    InputUntypedTypes[0] := Nil;
+    for i := 0 to High(aInputArgs) do begin
+      input[i + 1] := CopyValue(aInputArgs[i]);
+      if not Assigned(params[i].ParamType) then
+        InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo
+      else
+        InputUntypedTypes[i + 1] := Nil;
+    end;
+
+    SetLength(InOutMapping, Length(aInOutMapping));
+    for i := 0 to High(InOutMapping) do
+      InOutMapping[i] := aInOutMapping[i];
+    SetLength(OutputArgs, Length(aOutputArgs));
+    for i := 0 to High(OutputArgs) do
+      OutputArgs[i] := CopyValue(aOutputArgs[i]);
+    ResultValue := aResult;
+
+    res := method.Invoke(instance, aInputArgs);
+    Status('After invoke');
+
+    CheckEquals(name, InvokedMethodName, 'Invoked method name differs for ' + name);
+    Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name);
+    Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
+    CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name);
+    for i := 0 to High(input) do begin
+      Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
+    end;
+    for i := 0 to High(aOutputArgs) do begin
+      Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
+    end;
+  finally
+    context.Free;
+  end;
+end;
+
 {$ifdef fpc}
 procedure TTestImpl.OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out
   aResult: TValue);
@@ -398,6 +535,11 @@ end;
 {$endif}
 
 {$ifndef InLazIDE}
+{$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoIntfImpl<T>(aIntf: T; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
+begin
+  DoIntfImpl(aIntf, TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aInOutMapping, aResult);
+end;
+
 {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 begin
   DoMethodImpl(TypeInfo(T), aInputArgs, aOutputArgs, aInOutMapping, aResult);
@@ -409,6 +551,123 @@ begin
 end;
 {$endif}
 
+procedure TTestImpl.TestIntfMethods;
+var
+  intf: ITestInterface;
+begin
+  intf := TVirtualInterface.Create(PTypeInfo(TypeInfo(ITestInterface)), {$ifdef fpc}@{$endif}OnHandleIntfMethod) as ITestInterface;
+  Check(Assigned(intf), 'ITestInterface instance is Nil');
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 1, [], [], [], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 2, [GetIntValue(42)], [], [], GetIntValue(21));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 3, [GetAnsiString('Hello World')], [], [], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 4, [GetShortString('Hello World')], [], [], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 5, [], [], [], GetAnsiString('Hello World'));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 6, [], [], [], GetShortString('Hello World'));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 7, [
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 8, [
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 9, [
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 10, [
+    GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
+  ], [
+    GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 11, [
+    GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
+  ], [
+    GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 12, [
+    GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
+  ], [
+    GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 13, [
+    GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
+  ], [
+    GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 14, [
+    GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
+  ], [
+    GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 15, [
+    GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5),
+    GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10)
+  ], [], [], GetIntValue(11));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 16, [
+    GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
+    GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
+  ], [], [], GetSingleValue(SingleAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 17, [
+    GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
+    GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
+  ], [], [], GetDoubleValue(DoubleAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 18, [
+    GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
+    GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
+  ], [], [], GetExtendedValue(ExtendedAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 19, [
+    GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
+    GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
+  ], [], [], GetCompValue(CompAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 20, [
+    GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
+    GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
+  ], [], [], GetCurrencyValue(CurrencyAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [0, 1], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [0, 1], TValue.Empty);
+
+  { for some reason this fails, though it fails in Delphi as well :/ }
+  {{$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [0, 1], TValue.Empty);}
+end;
+
 {$ifdef fpc}
 procedure TTestImpl.TestMethodVars;
 begin

+ 2 - 2
rtl/darwin/aarch64/sighnd.inc

@@ -23,8 +23,8 @@ begin
     SIGFPE :
       begin
         Case Info^.si_code Of
-          FPE_FLTDIV : Res:=200;  { floating point divide by zero }
-          FPE_INTDIV : Res:=208;  { integer divide by zero }
+          FPE_FLTDIV : Res:=208;  { floating point divide by zero }
+          FPE_INTDIV : Res:=200;  { integer divide by zero }
           FPE_FLTOVF : Res:=205;  { floating point overflow }
           FPE_FLTUND : Res:=206;  { floating point underflow }
           FPE_FLTRES,             { floating point inexact result }

+ 1 - 1
rtl/haiku/Makefile

@@ -3536,7 +3536,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 		   $(SYSTEMUNIT)$(PPUEXT)
 unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixtype.pp
-baseunix$(PPUEXT) : $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : baseunix.pp $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Fi$(UNIXINC) -Fu$(UNIXINC) baseunix.pp
 syscall$(PPUEXT) : $(UNIXINC)/syscall.pp $(SYSNRINC)  $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/syscall.pp

+ 1 - 1
rtl/haiku/Makefile.fpc

@@ -137,7 +137,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/unixtype.pp
 
-baseunix$(PPUEXT) : $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
+baseunix$(PPUEXT) : baseunix.pp unixtype$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Fi$(UNIXINC) -Fu$(UNIXINC) baseunix.pp
 
 syscall$(PPUEXT) : $(UNIXINC)/syscall.pp $(SYSNRINC)  $(SYSTEMUNIT)$(PPUEXT)

+ 1 - 8
rtl/inc/system.inc

@@ -949,23 +949,16 @@ var
 procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; compilerproc;
 var
   i : ALUUInt;
-{$ifdef DEBUG}
   pt : PInitFinalTable;
-{$endif}
 begin
   { call cpu/fpu initialisation routine }
   fpc_cpuinit;
 {$ifdef FPC_HAS_INDIRECT_ENTRY_INFORMATION}
-{$ifdef DEBUG}
   pt := PInitFinalTable(EntryInformation.InitFinalTable);
-{$endif}
-  with PInitFinalTable(EntryInformation.InitFinalTable)^ do
 {$else FPC_HAS_INDIRECT_ENTRY_INFORMATION}
-{$ifdef DEBUG}
   pt := @InitFinalTable;
-{$endif}
-  with InitFinalTable do
 {$endif FPC_HAS_INDIRECT_ENTRY_INFORMATION}
+  with pt^ do
    begin
      for i:=1 to ALUUInt(TableCount) do
       begin

+ 106 - 94
rtl/macos/Makefile

@@ -349,280 +349,280 @@ endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-android)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-aros)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-macos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc-aix)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-haiku)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-openbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-android)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-aros)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-netbsd)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-android)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),arm-aros)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),powerpc64-aix)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),mips-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),mipsel-android)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),jvm-java)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),jvm-android)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i8086-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i8086-msdos)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i8086-win16)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),aarch64-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),aarch64-android)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),wasm-wasm)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),sparc64-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),riscv32-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),riscv32-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),riscv64-linux)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),riscv64-embedded)
-override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst softfpu macpas
+override TARGET_UNITS+=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils unixutil dos extpas cmem charset cpall ctypes sysconst sortbase softfpu macpas classes fgl types
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_IMPLICITUNITS+=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
@@ -2956,6 +2956,18 @@ softfpu$(PPUEXT) : $(INC)/softfpu.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 	$(COMPILER) $(INC)/softfpu.pp
 rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+		   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) \
+		   sysconst$(PPUEXT) fgl$(PPUEXT) sortbase$(PPUEXT)
+	$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT) sortbase$(PPUEXT)
+	$(COMPILER) $(OBJPASDIR)/fgl.pp
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+	$(COMPILER) $(OBJPASDIR)/math.pp
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $(OBJPASDIR)/types.pp
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
 dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
@@ -2978,5 +2990,5 @@ cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(INC)/cmem.pp
 ctypes$(PPUEXT) :  $(INC)/ctypes.pp system$(PPUEXT)
 	$(COMPILER) $(INC)/ctypes.pp
-math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-	$(COMPILER) $(OBJPASDIR)/math.pp
+sortbase$(PPUEXT) : $(INC)/sortbase.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<

+ 22 - 3
rtl/macos/Makefile.fpc

@@ -9,7 +9,7 @@ main=rtl
 loaders=
 units=system uuchar strings objpas iso7185 heaptrc getopts macostp macutils \
       unixutil dos extpas cmem charset cpall ctypes sysconst \
-	  softfpu macpas
+      sortbase softfpu macpas classes fgl types
 #	   sysutils 
 #     macpas \
 #      exec  \
@@ -131,6 +131,24 @@ softfpu$(PPUEXT) : $(INC)/softfpu.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
 
 rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+                   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) \
+		   sysconst$(PPUEXT) fgl$(PPUEXT) sortbase$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
+fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT) sortbase$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/fgl.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+        $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/math.pp
+
+types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/types.pp
+
 #
 # Mac Pascal Model
 #
@@ -186,5 +204,6 @@ cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
 ctypes$(PPUEXT) :  $(INC)/ctypes.pp system$(PPUEXT)
 	$(COMPILER) $(INC)/ctypes.pp
 
-math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/math.pp
+sortbase$(PPUEXT) : $(INC)/sortbase.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) $<
+

+ 46 - 0
rtl/macos/classes.pp

@@ -0,0 +1,46 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for BeOS
+
+    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}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  sysutils,
+  rtlconsts,
+  types,  
+  typinfo,
+  sortbase;
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+  CommonInit;
+
+finalization
+  CommonCleanup;
+
+end.

+ 4 - 1
rtl/macos/sysutils.pp

@@ -33,7 +33,7 @@ interface
 uses
   MacOSTP;
 
-//{$DEFINE HAS_SLEEP}     TODO
+{$DEFINE HAS_SLEEP}   {Dummy implementation:  TODO }
 //{$DEFINE HAS_OSERROR}   TODO
 //{$DEFINE HAS_OSCONFIG}  TODO
 
@@ -827,8 +827,11 @@ begin
 end;
 
 
+procedure C_usleep(val : uint32); external 'StdCLib' name 'usleep';
+
 procedure Sleep(milliseconds: Cardinal);
 begin
+  C_usleep(milliseconds*1000);
 end;
 
 (*

+ 86 - 0
rtl/macos/tthread.inc

@@ -0,0 +1,86 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{****************************************************************************}
+{*                             TThread                                      *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+  GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt);
+
+begin
+ {IsMultiThread := TRUE; }
+end;
+
+
+procedure TThread.SysDestroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+procedure TThread.Terminate;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+  WaitFor:=0;
+end;
+
+

+ 7 - 7
rtl/objpas/classes/classesh.inc

@@ -899,19 +899,19 @@ type
     function WriteMaxSizeData(Const Buffer; aSize,aCount : NativeInt) : NativeInt;
     Procedure WriteExactSizeData(Const Buffer; aSize,aCount : NativeInt);
   public
-    function Read(var Buffer; Count: Longint): Longint; virtual;
-    function Read(Buffer: TBytes; Count: Longint): Longint; overload;
-    function Read(Buffer : TBytes; aOffset, Count: Longint): Longint; overload;
+    function Read(var Buffer; Count: Longint): Longint; virtual; overload;
+    function Read(var Buffer: TBytes; Count: Longint): Longint; overload;
+    function Read( Buffer : TBytes; aOffset, Count: Longint): Longint; overload;
 
     function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; overload;
     function Write(const Buffer: TBytes; Count: Longint): Longint; overload;
-    function Write(const Buffer; Count: Longint): Longint; virtual;
+    function Write(const Buffer; Count: Longint): Longint; virtual; overload;
 
     function Seek(Offset: Longint; Origin: Word): Longint; virtual; overload;
     function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; virtual; overload;
 
     function ReadData(Buffer: Pointer; Count: NativeInt): NativeInt; overload;
-    function ReadData(const Buffer: TBytes; Count: NativeInt): NativeInt; overload;
+    function ReadData(Buffer: TBytes; Count: NativeInt): NativeInt; overload;
     function ReadData(var Buffer: Boolean): NativeInt; overload;
     function ReadData(var Buffer: Boolean; Count: NativeInt): NativeInt; overload;
     function ReadData(var Buffer: AnsiChar): NativeInt; overload;
@@ -1018,8 +1018,8 @@ type
     function WriteData(const Buffer: TExtended80Rec): NativeInt; overload;
     function WriteData(const Buffer: TExtended80Rec; Count: NativeInt): NativeInt; overload;
 {$ENDIF}
-    procedure WriteBufferData(Buffer: Integer); overload;
-    procedure WriteBufferData(Buffer: Integer; Count: NativeInt); overload;
+    procedure WriteBufferData(Buffer: Int32); overload;
+    procedure WriteBufferData(Buffer: Int32; Count: NativeInt); overload;
     procedure WriteBufferData(Buffer: Boolean); overload;
     procedure WriteBufferData(Buffer: Boolean; Count: NativeInt); overload;
     procedure WriteBufferData(Buffer: AnsiChar); overload;

+ 4 - 4
rtl/objpas/classes/streams.inc

@@ -30,7 +30,7 @@ begin
   Result := 0;
 end;
 
-function TStream.Read(Buffer: TBytes; Count: Longint): Longint;
+function TStream.Read(var Buffer: TBytes; Count: Longint): Longint;
 begin
   Result:=Read(Buffer,0,Count);
 end;
@@ -203,7 +203,7 @@ end;
    Result:=Read(Buffer^,Count);
  end;
 
- function TStream.ReadData(const Buffer: TBytes; Count: NativeInt): NativeInt;
+ function TStream.ReadData({var} Buffer: TBytes; Count: NativeInt): NativeInt;
  begin
    Result:=Read(Buffer,0,Count);
  end;
@@ -768,12 +768,12 @@ begin
 end;
 {$ENDIF}
 
-procedure TStream.WriteBufferData(Buffer: Integer);
+procedure TStream.WriteBufferData(Buffer: Int32);
 begin
   WriteBuffer(Buffer,SizeOf(Buffer));
 end;
 
-procedure TStream.WriteBufferData(Buffer: Integer; Count: NativeInt);
+procedure TStream.WriteBufferData(Buffer: Int32; Count: NativeInt);
 begin
   WriteMaxSizeData(Buffer,SizeOf(Buffer),Count);
 end;

+ 2 - 6
rtl/openbsd/Makefile

@@ -347,15 +347,13 @@ ifdef RELEASE
 override FPCOPT+=-Ur
 endif
 CPU_UNITS=
-SYSINIT_UNITS=
-LOADERS=prt0 cprt0
+SYSINIT_UNITS=si_prc si_c si_dll si_g
+LOADERS=prt0
 ifeq ($(ARCH),x86_64)
 CPU_UNITS=x86 ports cpu
-SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 ifeq ($(ARCH),i386)
 CPU_UNITS=x86 ports cpu mmx
-SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
@@ -3257,8 +3255,6 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
 	$(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
-cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
-	$(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
 si_prc$(PPUEXT) : si_prc.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_prc.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $<
 si_c$(PPUEXT) : si_c.pp si_intf.inc si_impl.inc $(ARCH)/openbsd_ident.inc $(ARCH)/si_c.inc $(SYSTEMUNIT)$(PPUEXT)

+ 2 - 7
rtl/openbsd/Makefile.fpc

@@ -76,17 +76,15 @@ override FPCOPT+=-Ur
 endif
 
 CPU_UNITS=
-SYSINIT_UNITS=
+SYSINIT_UNITS=si_prc si_c si_dll si_g
 
-LOADERS=prt0 cprt0
+LOADERS=prt0
 
 ifeq ($(ARCH),x86_64)
 CPU_UNITS=x86 ports cpu
-SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 ifeq ($(ARCH),i386)
 CPU_UNITS=x86 ports cpu mmx
-SYSINIT_UNITS=si_prc si_c si_dll si_g
 endif
 
 # Paths
@@ -128,9 +126,6 @@ SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 prt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as
         $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/$(PRT0).as
 
-cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
-        $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
-
 
 #
 # $(SYSINIT_UNITS) Units

+ 0 - 206
rtl/openbsd/i386/cprt0.as

@@ -1,206 +0,0 @@
-	.section ".note.openbsd.ident", "a"
-	.p2align 2
-	.long	8
-	.long	4
-	.long	1
-	.ascii "OpenBSD\0"
-	.long	0
-	.previous
-	.file	"crt0.c"
-gcc2_compiled.:
-.data
-	.align 32
-	.type	 rcsid , @object
-	.size	rcsid , 58
-rcsid:
-	.string	"$OpenBSD: crt0.c,v 1.11 2003/06/27 22:30:38 deraadt Exp $"
-.globl __progname
-.section	.rodata
-.LC0:
-	.string	""
-.data
-	.align 4
-	.type	 __progname , @object
-	.size	__progname , 4
-__progname:
-	.long .LC0
-.global __progname_storage
-	.type __progname_storage, @ object
-	.size  __progname_storage, 256
-
-        .align  4
-___fpucw:
-        .long   0x1332
-
-        .globl  ___fpc_brk_addr         /* heap management */
-        .type   ___fpc_brk_addr,@object
-        .size   ___fpc_brk_addr,4
-___fpc_brk_addr:
-        .long   0
-
-#APP
-	
-	.text
-	.align  4
-	.globl  __start
-	.globl  _start
-_start:
-__start:
-	pushl	%ebx			#ps_strings
-	pushl   %ecx                    # obj
-	pushl   %edx                    # cleanup
-	movl    12(%esp),%eax
-	leal    20(%esp,%eax,4),%ecx
-	leal    16(%esp),%edx
-	pushl   %ecx
-	pushl   %edx
-	pushl   %eax
-	call    ___start
-
-#NO_APP
-.text
-	.align 4
-.globl ___start
-	.type	___start , @function
-___start:
-	pushl %ebp
-	movl %esp,%ebp
-	subl $16,%esp
-	pushl %esi
-	pushl %ebx
-	call fpc_geteipasecx
-	addl $_GLOBAL_OFFSET_TABLE_,%ecx
-	movl %ecx,%edi
-	movl 12(%ebp),%esi
-	movl 16(%ebp),%eax
-	movl environ@GOT(%edi),%ecx
-	movl %eax,(%ecx)
-	movl operatingsystem_parameter_envp@GOT(%edi),%ecx
-	movl %eax,(%ecx)
-	movl (%esi),%ebx
-	testl %ebx,%ebx
-	je .L3
-	addl $-8,%esp
-	pushl $47
-	pushl %ebx
-	call _strrchr
-	movl __progname@GOT(%edi),%ecx
-	movl %eax,(%ecx)
-	addl $16,%esp
-	testl %eax,%eax
-	jne .L4
-	movl %ebx,(%ecx)
-	jmp .L5
-	.p2align 4,,7
-.L4:
-	incl %eax
-	movl %eax,(%ecx)
-.L5:
-	movl __progname_storage@GOT(%edi),%edx
-	jmp .L12
-	.p2align 4,,7
-.L9:
-	movb (%eax),%al
-	movb %al,(%edx)
-	movl __progname@GOT(%edi),%ecx
-	incl (%ecx)
-	incl %edx
-.L12:
-	movl __progname@GOT(%edi),%ecx
-	movl (%ecx),%eax
-	cmpb $0,(%eax)
-	je .L7
-	movl __progname_storage@GOT(%edi),%ecx
-	addl $255,%ecx
-	cmpl %ecx,%edx
-	jb .L9
-.L7:
-	movb $0,(%edx)
-	pushl %eax
-	movl __progname_storage@GOT(%edi),%eax
-	movl __progname@GOT(%edi),%ecx
-	movl %eax,(%ecx)
-	popl %eax
-.L3:
-#	call __init
-	subl $16,%esp
-	pushl %eax
-	movl 8(%ebp),%eax
-	movl operatingsystem_parameter_argc@GOT(%edi),%ecx
-	movl %eax,(%ecx)
-	movl operatingsystem_parameter_argv@GOT(%edi),%ecx
-	movl %esi,(%ecx)
-	popl %eax
-#	pushl environ
-#	pushl %esi
-#	pushl 8(%ebp)
-	movl ___fpucw@GOT(%edi),%ecx
-	finit
-	fwait
-	fldcw (%ecx)
-	xorl  %ebp,%ebp
-	call main
-	pushl %eax
-	call exit@PLT
-        .p2align 2,0x90
-
-.globl _haltproc
-.type _haltproc,@function
-
-_haltproc:
-           call fpc_geteipasebx
-           addl $_GLOBAL_OFFSET_TABLE_,%ebx
-           movl operatingsystem_result@GOT(%ebx),%ebx
-           movzwl (%ebx),%ebx
-           pushl %ebx
-           mov $1,%eax
-           call .Lactualsyscall
-           addl  $4,%esp
-           jmp   _haltproc
-
-.Lactualsyscall:
-         int $0x80
-         jb .LErrorcode
-         xor %ebx,%ebx
-         ret
-.LErrorcode:
-         mov %eax,%ebx
-         mov $-1,%eax
-         ret
-        .p2align 2,0x90
-.Lfe1:
-
-	.size	___start , . - ___start
-	.align 4
-	.type	_strrchr , @function
-_strrchr:
-	pushl %ebp
-	movl %esp,%ebp
-	pushl %ebx
-	movl 8(%ebp),%eax
-	movb 12(%ebp),%bl
-	xorl %ecx,%ecx
-	.p2align 4,,7
-.L14:
-	movb (%eax),%dl
-	cmpb %bl,%dl
-	jne .L17
-	movl %eax,%ecx
-.L17:
-	testb %dl,%dl
-	je .L16
-	incl %eax
-	jmp .L14
-	.p2align 4,,7
-.L16:
-	movl %ecx,%eax
-	popl %ebx
-	leave
-	ret
-	.size	_strrchr , . - _strrchr
-	.comm	environ,4,4
-	.comm	__progname_storage,256,32
-        .comm   operatingsystem_parameter_envp,4,4
-        .comm   operatingsystem_parameter_argc,4,4
-        .comm   operatingsystem_parameter_argv,4,4
-

+ 7 - 6
rtl/openbsd/i386/prt0.as

@@ -42,15 +42,16 @@ ___fpc_brk_addr:
 	.globl  _start
 _start:
 __start:
-	pushl	%ebx			#ps_strings
-	pushl   %ecx                    # obj
-	pushl   %edx                    # cleanup
-	movl    12(%esp),%eax
-	leal    20(%esp,%eax,4),%ecx
-	leal    16(%esp),%edx
+	movl    %esp,%ebp
+	andl    $~15,%esp
+	pushl   %edx
+	movl    0(%ebp),%eax
+	leal    8(%ebp,%eax,4),%ecx
+	leal    4(%ebp),%edx
 	pushl   %ecx
 	pushl   %edx
 	pushl   %eax
+	xorl    %ebp,%ebp
 	call    ___start
 
 #NO_APP

+ 9 - 8
rtl/openbsd/i386/si_c.inc

@@ -19,25 +19,26 @@
 procedure __init; cdecl; external name '__init';
 procedure c_exit(exit_code: cint); cdecl; noreturn; external name 'exit';
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl; forward;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl; forward;
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public name '__start';
   asm
-    pushl   %ebx                    { ps_strings }
-    pushl   %ecx                    { obj }
-    pushl   %edx                    { cleanup }
-    movl    12(%esp),%eax
-    leal    20(%esp,%eax,4),%ecx
-    leal    16(%esp),%edx
+    movl    %esp,%ebp
+    andl    $0xFFFFFFF0,%esp
+    pushl   %edx
+    movl    0(%ebp),%eax
+    leal    8(%ebp,%eax,4),%ecx
+    leal    4(%ebp),%edx
     pushl   %ecx
     pushl   %edx
     pushl   %eax
+    xorl    %ebp,%ebp
     call    _FPC_proc___start
   end;
 
 function _strrchr(str: PChar; character: LongInt): PChar; forward;
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl;
   var
     I: SizeUInt;
   begin

+ 9 - 8
rtl/openbsd/i386/si_g.inc

@@ -26,25 +26,26 @@ procedure _monstartup(lowpc, highpc: u_long); cdecl; external name '_monstartup'
 procedure __init; cdecl; external name '__init';
 procedure c_exit(exit_code: cint); cdecl; noreturn; external name 'exit';
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl; forward;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl; forward;
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public name '__start';
   asm
-    pushl   %ebx                    { ps_strings }
-    pushl   %ecx                    { obj }
-    pushl   %edx                    { cleanup }
-    movl    12(%esp),%eax
-    leal    20(%esp,%eax,4),%ecx
-    leal    16(%esp),%edx
+    movl    %esp,%ebp
+    andl    $0xFFFFFFF0,%esp
+    pushl   %edx
+    movl    0(%ebp),%eax
+    leal    8(%ebp,%eax,4),%ecx
+    leal    4(%ebp),%edx
     pushl   %ecx
     pushl   %edx
     pushl   %eax
+    xorl    %ebp,%ebp
     call    _FPC_proc___start
   end;
 
 function _strrchr(str: PChar; character: LongInt): PChar; forward;
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl;
   var
     I: SizeUInt;
   begin

+ 9 - 8
rtl/openbsd/i386/si_prc.inc

@@ -16,26 +16,27 @@
 
 {$asmmode att}
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl; forward;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl; forward;
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public name '__start';
   asm
-    pushl   %ebx                    { ps_strings }
-    pushl   %ecx                    { obj }
-    pushl   %edx                    { cleanup }
-    movl    12(%esp),%eax
-    leal    20(%esp,%eax,4),%ecx
-    leal    16(%esp),%edx
+    movl    %esp,%ebp
+    andl    $0xFFFFFFF0,%esp
+    pushl   %edx
+    movl    0(%ebp),%eax
+    leal    8(%ebp,%eax,4),%ecx
+    leal    4(%ebp),%edx
     pushl   %ecx
     pushl   %edx
     pushl   %eax
+    xorl    %ebp,%ebp
     call    _FPC_proc___start
   end;
 
 procedure _FPC_proc_haltproc; cdecl; noreturn; forward;
 function _strrchr(str: PChar; character: LongInt): PChar; forward;
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl;
   var
     I: SizeUInt;
   begin

+ 0 - 244
rtl/openbsd/x86_64/cprt0.as

@@ -1,244 +0,0 @@
-	.section ".note.openbsd.ident", "a"
-	.p2align 2
-	.long	8
-	.long	4
-	.long	1
-	.ascii "OpenBSD\0"
-	.long	0
-	.previous
-	.file	"crt0.c"
-	.globl	__progname
-	.section	.rodata
-.LC0:
-	.string	""
-	.data
-	.align 8
-	.type	__progname, @object
-	.size	__progname, 8
-__progname:
-	.quad	.LC0
-#APP
-	 .text				
-	.align	8			
-	.globl	__start			
-	.globl	_start			
-_start:					
-__start:				
-	movq	%rbx,%r9		
-	movq	%rcx,%r8		
-	movq	%rdx,%rcx		
-	movq	(%rsp),%rdi		
-	leaq	16(%rsp,%rdi,8),%rdx	
-	leaq	8(%rsp),%rsi		
-	subq	$8,%rsp			
-	andq	$~15,%rsp		
-	addq	$8,%rsp			
-	jmp	___start		
-
-#NO_APP
-	.text
-	.globl	___start
-	.type	___start, @function
-___start:
-.LFB9:
-	pushq	%rbp
-.LCFI0:
-	movq	%rsp, %rbp
-.LCFI1:
-	subq	$64, %rsp
-.LCFI2:
-	movl	%edi, -20(%rbp)
-	movq	%rsi, -32(%rbp)
-	movq	%rdx, -40(%rbp)
-	movq	%rcx, -48(%rbp)
-	movq	%r8, -56(%rbp)
-	movq	%r9, -64(%rbp)
-	movq	-40(%rbp), %rax
-	movq	%rax, environ(%rip)
-	movq    %rax,operatingsystem_parameter_envp(%rip)
-	movq	-32(%rbp), %rax
-	movq	(%rax), %rax
-	movq	%rax, -8(%rbp)
-	cmpq	$0, -8(%rbp)
-	je	.L2
-	movq	-8(%rbp), %rdi
-	movl	$47, %esi
-	call	_strrchr
-	movq	%rax, __progname(%rip)
-	movq	__progname(%rip), %rax
-	testq	%rax, %rax
-	jne	.L4
-	movq	-8(%rbp), %rax
-	movq	%rax, __progname(%rip)
-	jmp	.L6
-.L4:
-	movq	__progname(%rip), %rax
-	addq	$1, %rax
-	movq	%rax, __progname(%rip)
-.L6:
-	leaq	__progname_storage(%rip), %rax
-	movq	%rax, -16(%rbp)
-	jmp	.L7
-.L8:
-	movq	__progname(%rip), %rcx
-	movzbl	(%rcx), %edx
-	movq	-16(%rbp), %rax
-	movb	%dl, (%rax)
-	addq	$1, -16(%rbp)
-	leaq	1(%rcx), %rax
-	movq	%rax, __progname(%rip)
-.L7:
-	movq	__progname(%rip), %rax
-	movzbl	(%rax), %eax
-	testb	%al, %al
-	je	.L9
-	leaq	__progname_storage+255(%rip), %rax
-	cmpq	%rax, -16(%rbp)
-	jb	.L8
-.L9:
-	leaq	__progname_storage(%rip), %rax
-	movq	%rax, __progname(%rip)
-	movq	-16(%rbp), %rax
-	movb	$0, (%rax)
-.L2:
-	movq	_mcleanup@GOTPCREL(%rip), %rdi
-	call	atexit
-	movq	_etext@GOTPCREL(%rip), %rsi
-	leaq	_eprol(%rip), %rdi
-	call	monstartup@plt
-	movl	$0, %eax
-	call	_init
-	movq	environ(%rip), %rdx
-	movq	-32(%rbp), %rsi
-	movl	-20(%rbp), %edi
-	movq    %rdi,operatingsystem_parameter_argc(%rip)
-	movq    %rsi,operatingsystem_parameter_argv(%rip)
-	movl	$0, %eax
-	call	main
-	# movl	%eax, %edi
-	# call	exit
-	jmp _haltproc
-        .p2align 2,0x90
-
-.globl _haltproc
-.type _haltproc,@function
-
-_haltproc:
-           movq $1,%rax
-           movzwq operatingsystem_result(%rip),%rbx
-           pushq   %rbx
-           call .Lactualsyscall
-           addq  $8,%rsp
-           jmp   _haltproc
-
-.Lactualsyscall:
-         int $0x80
-         jb .LErrorcode
-         xor %rbx,%rbx
-         ret
-.LErrorcode:
-         movq  %rax,%rbx
-         movq  $-1,%rax
-.LFE9:
-	.size	___start, .-___start
-	.type	_strrchr, @function
-_strrchr:
-.LFB10:
-	pushq	%rbp
-.LCFI3:
-	movq	%rsp, %rbp
-.LCFI4:
-	movq	%rdi, -24(%rbp)
-	movb	%sil, -25(%rbp)
-	movq	$0, -8(%rbp)
-.L13:
-	movq	-24(%rbp), %rdx
-	movzbl	(%rdx), %eax
-	cmpb	-25(%rbp), %al
-	jne	.L14
-	movq	-24(%rbp), %rax
-	movq	%rax, -8(%rbp)
-.L14:
-	movq	-24(%rbp), %rdx
-	movzbl	(%rdx), %eax
-	testb	%al, %al
-	jne	.L16
-	movq	-8(%rbp), %rax
-	movq	%rax, -16(%rbp)
-	jmp	.L12
-.L16:
-	addq	$1, -24(%rbp)
-	jmp	.L13
-.L12:
-	movq	-16(%rbp), %rax
-	leave
-	ret
-.LFE10:
-	.size	_strrchr, .-_strrchr
-#APP
-	  .text
-	_eprol:
-#NO_APP
-	.comm	environ,8,8
-	.comm	__progname_storage,256,32
-        .comm   operatingsystem_parameter_envp,8,8
-        .comm   operatingsystem_parameter_argc,8,8
-        .comm   operatingsystem_parameter_argv,8,8
-	.section	.eh_frame,"a",@unwind
-.Lframe1:
-	.long	.LECIE1-.LSCIE1
-.LSCIE1:
-	.long	0x0
-	.byte	0x1
-	.string	"zR"
-	.uleb128 0x1
-	.sleb128 -8
-	.byte	0x10
-	.uleb128 0x1
-	.byte	0x3
-	.byte	0xc
-	.uleb128 0x7
-	.uleb128 0x8
-	.byte	0x90
-	.uleb128 0x1
-	.align 8
-.LECIE1:
-.LSFDE1:
-	.long	.LEFDE1-.LASFDE1
-.LASFDE1:
-	.long	.LASFDE1-.Lframe1
-	.long	.LFB9-.
-	.long	.LFE9-.LFB9
-	.uleb128 0x0
-	.byte	0x4
-	.long	.LCFI0-.LFB9
-	.byte	0xe
-	.uleb128 0x10
-	.byte	0x86
-	.uleb128 0x2
-	.byte	0x4
-	.long	.LCFI1-.LCFI0
-	.byte	0xd
-	.uleb128 0x6
-	.align 8
-.LEFDE1:
-.LSFDE3:
-	.long	.LEFDE3-.LASFDE3
-.LASFDE3:
-	.long	.LASFDE3-.Lframe1
-	.long	.LFB10-.
-	.long	.LFE10-.LFB10
-	.uleb128 0x0
-	.byte	0x4
-	.long	.LCFI3-.LFB10
-	.byte	0xe
-	.uleb128 0x10
-	.byte	0x86
-	.uleb128 0x2
-	.byte	0x4
-	.long	.LCFI4-.LCFI3
-	.byte	0xd
-	.uleb128 0x6
-	.align 8
-.LEFDE3:
-	.ident	"GCC: (GNU) 4.2.1 20070719 "

+ 0 - 2
rtl/openbsd/x86_64/prt0.as

@@ -24,8 +24,6 @@ __progname:
 	.globl	_start			
 _start:					
 __start:				
-	movq	%rbx,%r9		
-	movq	%rcx,%r8		
 	movq	%rdx,%rcx		
 	movq	(%rsp),%rdi		
 	leaq	16(%rsp,%rdi,8),%rdx	

+ 7 - 6
rtl/openbsd/x86_64/si_c.inc

@@ -18,13 +18,12 @@
 
 procedure __init; cdecl; external name '__init';
 procedure c_exit(exit_code: cint); cdecl; noreturn; external name 'exit';
+function _csu_finish(_argv: PPChar; _envp: PPChar; _cleanup: TCdeclProcedure): PPPChar; cdecl; external name '_csu_finish';
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl; forward;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl; forward;
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public name '__start';
   asm
-    movq    %rbx,%r9
-    movq    %rcx,%r8
     movq    %rdx,%rcx
     movq    (%rsp),%rdi
     leaq    16(%rsp,%rdi,8),%rdx
@@ -37,12 +36,14 @@ procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public
 
 function _strrchr(str: PChar; character: LongInt): PChar; forward;
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl;
   var
     I: SizeUInt;
+    environp: PPPChar;
   begin
-    environ:=envp;
-    operatingsystem_parameter_envp:=envp;
+    environp:=_csu_finish(argv, envp, cleanup);
+    environ:=environp^;
+    operatingsystem_parameter_envp:=environ;
     operatingsystem_parameter_argc:=argc;
     operatingsystem_parameter_argv:=argv;
     if argv[0]<>nil then

+ 7 - 6
rtl/openbsd/x86_64/si_g.inc

@@ -25,13 +25,12 @@ function atexit(proc: TCdeclProcedure): cint; cdecl; external name 'atexit';
 procedure _monstartup(lowpc, highpc: u_long); cdecl; external name '_monstartup';
 procedure __init; cdecl; external name '__init';
 procedure c_exit(exit_code: cint); cdecl; noreturn; external name 'exit';
+function _csu_finish(_argv: PPChar; _envp: PPChar; _cleanup: TCdeclProcedure): PPPChar; cdecl; external name '_csu_finish';
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl; forward;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl; forward;
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public name '__start';
   asm
-    movq    %rbx,%r9
-    movq    %rcx,%r8
     movq    %rdx,%rcx
     movq    (%rsp),%rdi
     leaq    16(%rsp,%rdi,8),%rdx
@@ -44,12 +43,14 @@ procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public
 
 function _strrchr(str: PChar; character: LongInt): PChar; forward;
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); cdecl;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); cdecl;
   var
     I: SizeUInt;
+    environp: PPPChar;
   begin
-    environ:=envp;
-    operatingsystem_parameter_envp:=envp;
+    environp:=_csu_finish(argv, envp, cleanup);
+    environ:=environp^;
+    operatingsystem_parameter_envp:=environ;
     operatingsystem_parameter_argc:=argc;
     operatingsystem_parameter_argv:=argv;
     if argv[0]<>nil then

+ 2 - 4
rtl/openbsd/x86_64/si_prc.inc

@@ -16,12 +16,10 @@
 
 {$asmmode gas}
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord); forward;
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure); forward;
 
 procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public name '__start';
   asm
-    movq    %rbx,%r9
-    movq    %rcx,%r8
     movq    %rdx,%rcx
     movq    (%rsp),%rdi
     leaq    16(%rsp,%rdi,8),%rdx
@@ -35,7 +33,7 @@ procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; public
 procedure _FPC_proc_haltproc; cdecl; forward;
 function _strrchr(str: PChar; character: LongInt): PChar; forward;
 
-procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; para1, para2, para3: QWord);
+procedure _FPC_proc___start(argc: LongInt; argv: PPChar; envp: Pointer; cleanup: TCdeclProcedure);
   var
     I: SizeUInt;
   begin

+ 10 - 5
rtl/unix/scripts/check_rtl_types.sh

@@ -171,14 +171,19 @@ OS_SOURCE=`$FPC $FPC_OPTS  -iSO`
 CPU_SOURCE=`$FPC $FPC_OPTS -iSP`
 CPU_TARGET=`$FPC $FPC_OPTS -iTP`
 case $CPU_SOURCE in
-  arm|aarch64) FPC32=ppcarm; FPC64=ppca64;;
-  i386|x86_64) FPC32=ppc386; FPC64=ppcx64;;
-  powerpc|powerpc64) FPC32=ppcppc; FPC64=ppcppc64;;
-  sparc|sparc64) FPC32=ppcsparc; FPC64=ppcsparc64;;
+  aarch64) FPC32=ppcarm; FPC64=ppca64;;
+  arm) FPC32=ppcarm; FPC64=;;
+  x86_64) FPC32=ppc386; FPC64=ppcx64;;
+  i386) FPC32=ppc386; FPC64=;;
+  powerpc64) FPC32=ppcppc; FPC64=ppcppc64;;
+  powerpc) FPC32=ppcppc; FPC64=;;
+  riscv64) FPC32=ppcrv32; FPC64=ppcrv64;;
+  riscv32) FPC32=ppcrv32; FPC64=;;
+  sparc64) FPC32=ppcsparc; FPC64=ppcsparc64;;
+  sparc) FPC32=ppcsparc; FPC64=;;
   m68k) FPC32=ppc68k; FPC64=;;
   mips) FPC32=ppcmips; FPC64=;;
   mipsel) FPC32=ppcmipsel; FPC64=;;
-  riscv32|riscv64) FPC32=ppcrv32; FPC64=ppcrv64;;
 esac
 
 # No i386<->x86_64 cross-compilation on OpeenBSD

+ 20 - 0
tests/test/opt/tdfa19.pp

@@ -0,0 +1,20 @@
+{ %OPT=-Oodfa -vw -Sew }
+{ %norun }
+
+{$mode objfpc}
+
+program project1;
+
+type
+  trange=0..5;
+
+function f(r: trange): longint;
+begin
+  case r of
+    0..5: result:=r;
+  end;
+end;
+
+begin
+  writeln(f(2));
+end.

+ 22 - 0
tests/test/opt/tdfa20.pp

@@ -0,0 +1,22 @@
+{ %OPT=-Oodfa -vw -Sew -vm6060 }
+{ %FAIL }
+
+{$mode objfpc}
+
+program project1;
+
+type
+  trange=0..5;
+
+function f(r: trange): longint;
+begin
+  { must give a warning about unset function result; warning about incomplete
+    case statement is suppressed with -vm6060 }
+  case r of
+    0..4: result:=r;
+  end;
+end;
+
+begin
+  writeln(f(2));
+end.